DG_53_P978.KIDs

KIDS Distribution saved on Jun 21, 2019@14:58:26
Enrollment System Modernization Project - Build 4
**KIDS**:DG*5.3*978^IVM*2.0*180^

**INSTALL NAME**
DG*5.3*978
"BLD",10918,0)
DG*5.3*978^REGISTRATION^0^3190621^y
"BLD",10918,1,0)
^^2^2^3190305^
"BLD",10918,1,1,0)
Please see the DG*5.3*978 patch description for detailed information 
"BLD",10918,1,2,0)
regarding this patch.
"BLD",10918,4,0)
^9.64PA^2^1
"BLD",10918,4,2,0)
2
"BLD",10918,4,2,2,0)
^9.641^2^1
"BLD",10918,4,2,2,2,0)
PATIENT  (File-top level)
"BLD",10918,4,2,2,2,1,0)
^9.6411^1010.1515^6
"BLD",10918,4,2,2,2,1,1010.1511,0)
APPOINTMENT REQUEST DATE
"BLD",10918,4,2,2,2,1,1010.1512,0)
ORIGINAL APPOINTMENT REQUEST
"BLD",10918,4,2,2,2,1,1010.1513,0)
ORIGINAL APPT REQUEST DATE
"BLD",10918,4,2,2,2,1,1010.1514,0)
ORIG APPT REQUEST CHG DT/TM
"BLD",10918,4,2,2,2,1,1010.1515,0)
APPT REQUEST 1010EZ CHG DT/TM
"BLD",10918,4,2,2,2,1,1010.159,0)
APPOINTMENT REQUEST ON 1010EZ
"BLD",10918,4,2,222)
y^n^p^^^^n^^n
"BLD",10918,4,2,224)

"BLD",10918,4,"APDD",2,2)

"BLD",10918,4,"APDD",2,2,1010.1511)

"BLD",10918,4,"APDD",2,2,1010.1512)

"BLD",10918,4,"APDD",2,2,1010.1513)

"BLD",10918,4,"APDD",2,2,1010.1514)

"BLD",10918,4,"APDD",2,2,1010.1515)

"BLD",10918,4,"APDD",2,2,1010.159)

"BLD",10918,4,"B",2,2)

"BLD",10918,6.3)
19
"BLD",10918,"ABPKG")
n
"BLD",10918,"KRN",0)
^9.67PA^779.2^20
"BLD",10918,"KRN",.4,0)
.4
"BLD",10918,"KRN",.401,0)
.401
"BLD",10918,"KRN",.402,0)
.402
"BLD",10918,"KRN",.402,"NM",0)
^9.68A^1^1
"BLD",10918,"KRN",.402,"NM",1,0)
DGEN NEACL    FILE #2^2^0
"BLD",10918,"KRN",.402,"NM","B","DGEN NEACL    FILE #2",1)

"BLD",10918,"KRN",.403,0)
.403
"BLD",10918,"KRN",.5,0)
.5
"BLD",10918,"KRN",.84,0)
.84
"BLD",10918,"KRN",3.6,0)
3.6
"BLD",10918,"KRN",3.8,0)
3.8
"BLD",10918,"KRN",9.2,0)
9.2
"BLD",10918,"KRN",9.8,0)
9.8
"BLD",10918,"KRN",9.8,"NM",0)
^9.68A^5^4
"BLD",10918,"KRN",9.8,"NM",2,0)
DGENACL^^0^B18566549
"BLD",10918,"KRN",9.8,"NM",3,0)
DGENACL1^^0^B63749530
"BLD",10918,"KRN",9.8,"NM",4,0)
DGENUPLA^^0^B96425185
"BLD",10918,"KRN",9.8,"NM",5,0)
DGENPTA1^^0^B30646011
"BLD",10918,"KRN",9.8,"NM","B","DGENACL",2)

"BLD",10918,"KRN",9.8,"NM","B","DGENACL1",3)

"BLD",10918,"KRN",9.8,"NM","B","DGENPTA1",5)

"BLD",10918,"KRN",9.8,"NM","B","DGENUPLA",4)

"BLD",10918,"KRN",19,0)
19
"BLD",10918,"KRN",19,"NM",0)
^9.68A^^
"BLD",10918,"KRN",19.1,0)
19.1
"BLD",10918,"KRN",101,0)
101
"BLD",10918,"KRN",409.61,0)
409.61
"BLD",10918,"KRN",771,0)
771
"BLD",10918,"KRN",779.2,0)
779.2
"BLD",10918,"KRN",870,0)
870
"BLD",10918,"KRN",8989.51,0)
8989.51
"BLD",10918,"KRN",8989.52,0)
8989.52
"BLD",10918,"KRN",8994,0)
8994
"BLD",10918,"KRN","B",.4,.4)

"BLD",10918,"KRN","B",.401,.401)

"BLD",10918,"KRN","B",.402,.402)

"BLD",10918,"KRN","B",.403,.403)

"BLD",10918,"KRN","B",.5,.5)

"BLD",10918,"KRN","B",.84,.84)

"BLD",10918,"KRN","B",3.6,3.6)

"BLD",10918,"KRN","B",3.8,3.8)

"BLD",10918,"KRN","B",9.2,9.2)

"BLD",10918,"KRN","B",9.8,9.8)

"BLD",10918,"KRN","B",19,19)

"BLD",10918,"KRN","B",19.1,19.1)

"BLD",10918,"KRN","B",101,101)

"BLD",10918,"KRN","B",409.61,409.61)

"BLD",10918,"KRN","B",771,771)

"BLD",10918,"KRN","B",779.2,779.2)

"BLD",10918,"KRN","B",870,870)

"BLD",10918,"KRN","B",8989.51,8989.51)

"BLD",10918,"KRN","B",8989.52,8989.52)

"BLD",10918,"KRN","B",8994,8994)

"BLD",10918,"QDEF")
^^^^NO^^^^NO^^YES
"BLD",10918,"QUES",0)
^9.62^^
"BLD",10918,"REQB",0)
^9.611^4^3
"BLD",10918,"REQB",1,0)
DG*5.3*824^1
"BLD",10918,"REQB",3,0)
DG*5.3*842^1
"BLD",10918,"REQB",4,0)
DG*5.3*909^1
"BLD",10918,"REQB","B","DG*5.3*824",1)

"BLD",10918,"REQB","B","DG*5.3*842",3)

"BLD",10918,"REQB","B","DG*5.3*909",4)

"FIA",2)
PATIENT
"FIA",2,0)
^DPT(
"FIA",2,0,0)
2I
"FIA",2,0,1)
y^n^p^^^^n^^n
"FIA",2,0,10)

"FIA",2,0,11)

"FIA",2,0,"RLRO")

"FIA",2,0,"VR")
5.3^DG
"FIA",2,2)
1
"FIA",2,2,1010.1511)

"FIA",2,2,1010.1512)

"FIA",2,2,1010.1513)

"FIA",2,2,1010.1514)

"FIA",2,2,1010.1515)

"FIA",2,2,1010.159)

"IX",2,2,"AEAR",0)
2^AEAR^Contains YES entries^R^^F^IR^I^2^^^^^S
"IX",2,2,"AEAR",.1,0)
^^1^1^3080401^^
"IX",2,2,"AEAR",.1,1,0)
This cross reference contains 'yes' entries
"IX",2,2,"AEAR",1)
S ^DPT("AEAR",X,DA)=""
"IX",2,2,"AEAR",1.4)
S X=X(1)=1
"IX",2,2,"AEAR",2)
K ^DPT("AEAR",X,DA)
"IX",2,2,"AEAR",2.5)
K ^DPT("AEAR")
"IX",2,2,"AEAR",11.1,0)
^.114IA^1^1
"IX",2,2,"AEAR",11.1,1,0)
1^F^2^1010.159^^1^F
"IX",2,2,"AEAR",11.1,1,3)

"KRN",.402,1749,-1)
0^1
"KRN",.402,1749,0)
DGEN NEACL^3190621.1457^^2^^^3190607
"KRN",.402,1749,"DIAB",2,0,2,4)
1010.163;"COMMENT"
"KRN",.402,1749,"DIAB",3,0,2,2)
1010.161;"STATUS"
"KRN",.402,1749,"DR",1,2)
N DGFLAG,DGBD,DGAD,DGBC,DGBS,DGAC,DIERR,ZERR,DFNIEN S DIE("NO^")="";S DFNIEN=DA D APPTCK^DGENACL2 S DGFLAG=$$GET1^DIQ(2,DA,1010.159,"I",,"ZERR");I DGFLAG'=1 S DGFLAG=$$GET1^DIQ(2,DA,1010.159,,,"ZERR") S Y="@90";
"KRN",.402,1749,"DR",1,2,1)
D EN^DDIOL("APPOINTMENT REQUEST ON 1010EZ:"_$$GET1^DIQ(2,DA,1010.159)) D EN^DDIOL("//  (no editing)","","?0");D EN^DDIOL("APPOINTMENT REQUEST DATE:"_$$GET1^DIQ(2,DA,1010.1511)) D EN^DDIOL("//  (no editing)","","?0");
"KRN",.402,1749,"DR",1,2,2)
S DGFLAG=$$GET1^DIQ(2,DA,1010.161,,,"ZERR"),DGBS=$$GET1^DIQ(2,DA,1010.161,"I",,"ZERR");I DGFLAG'="" D EN^DDIOL("STATUS: "_DGFLAG) D EN^DDIOL("//  (last edited: "_$$GET1^DIQ(2,DA,1010.162)_")","","?0");1010.161STATUS~;@80;
"KRN",.402,1749,"DR",1,2,3)
S DGFLAG=$$GET1^DIQ(2,DA,1010.163,,,"ZERR"),DGBC=DGFLAG,DGSTA=$$GET1^DIQ(2,DA,1010.161,"I",,"ZERR"),DGBD=$$GET1^DIQ(2,DA,1010.164,"I",,"ZERR");
"KRN",.402,1749,"DR",1,2,4)
I DGFLAG'="" D EN^DDIOL("COMMENT: "_DGFLAG) D EN^DDIOL("//  (last edited: "_$$GET1^DIQ(2,DA,1010.164)_")","","?0");1010.163COMMENT~;S DGAC=$$GET1^DIQ(2,DA,1010.163,,,"ZERR"),DGAD=$$GET1^DIQ(2,DA,1010.164,"I",,"ZERR");
"KRN",.402,1749,"DR",1,2,5)
I (DGSTA="C")&(DGAC="") S Y="@80";I (DGSTA="C")&(DGBS'=DGSTA)&(DGBC=DGAC) S Y="@80";S Y="@100";@90;N DGSTATUS,DGCAT,DGCUR,DGPREF,DGPFSITE,DGREQ,DGREQDT,DIR,DGEXIT,DGAPPDAT;S DGSTATUS=$$STATUS^DGENA(DA);
"KRN",.402,1749,"DR",1,2,6)
I 'DGSTATUS D EN^DDIOL("Veteran is not enrolled.") S Y="@100";S DGCAT=$$GET1^DIQ(27.15,DGSTATUS,.02,"I");I DGCAT'="E" D EN^DDIOL("Veteran is not enrolled.") S Y="@100";S DGCUR=$$SITE^VASITE;
"KRN",.402,1749,"DR",1,2,7)
S DGPREF=+$$GET1^DIQ(2,DA,27.02,"I",,"ZERR");S DGPFSITE=$$GET1^DIQ(4,DGPREF,99);D EN^DDIOL("PREFERRED FACILITY: "_$$GET1^DIQ(4,DGPREF,.01)_" ("_DGPFSITE_")");
"KRN",.402,1749,"DR",1,2,8)
I $E($P(DGCUR,U,3),1,3)'=$E(DGPFSITE,1,3) D EN^DDIOL("Site is not Patient's Preferred Facility. Preferred Facility must be updated.") S Y="@100";D EN^DDIOL("APPOINTMENT REQUEST ON 1010EZ: "_DGFLAG);@93;
"KRN",.402,1749,"DR",1,2,9)
S DIR("A",1)="Does the New Enrollee want an appt. with a VA doctor/provider";S DIR("A")="at "_$$GET1^DIQ(4,DGPREF,.01)_" ("_DGPFSITE_")?";S DIR(0)="2,1010.159^^";D ^DIR K DIR S DGREQ=Y K Y;I $D(DTOUT)!($D(DUOUT)) S Y="@100";
"KRN",.402,1749,"DR",1,2,10)
I (DGREQ=0) S Y="@99";I DGREQ'=1 S Y="@100";S DGAPPDAT=$$GET1^DIQ(2,DA,1010.1511,"I",,"ZERR");@95;1010.1511///@;S DGEXIT=0;S DIR("A")="Date the Appointment Request Made?";S DIR(0)="2,1010.1511^^";D ^DIR K DIR S DGREQDT=Y K Y;
"KRN",.402,1749,"DR",1,2,11)
I $D(DTOUT)!($D(DUOUT)) S DGEXIT=1;1010.1511///^S X=DGAPPDAT;I DGEXIT S Y="@100";I DGREQDT<1 S Y="@93";I DGREQDT>DT D EN^DDIOL("Date cannot be in the future.") S Y="@95";1010.159///^S X=DGREQ;1010.1511///^S X=DGREQDT;S Y="@100";
"KRN",.402,1749,"DR",1,2,12)
@99;D EN^DDIOL("APPOINTMENT REQUEST ON 1010EZ: "_DGFLAG,,"!!");S DIR(0)="E",DIR("A")="Enter RETURN to continue";D ^DIR K DIR,Y;@100;
"MBREQ")
0
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"PKG",47,-1)
1^1
"PKG",47,0)
REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER 
"PKG",47,20,0)
^9.402P^^
"PKG",47,22,0)
^9.49I^1^1
"PKG",47,22,1,0)
5.3^2930813^2960613
"PKG",47,22,1,"PAH",1,0)
978^3190621
"PKG",47,22,1,"PAH",1,1,0)
^^2^2^3190621
"PKG",47,22,1,"PAH",1,1,1,0)
Please see the DG*5.3*978 patch description for detailed information 
"PKG",47,22,1,"PAH",1,1,2,0)
regarding this patch.
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
YES
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
4
"RTN","DGENACL")
0^2^B18566549
"RTN","DGENACL",1,0)
DGENACL ;ALB/MRY,LBD,JAM - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;6/9/10 2:09pm
"RTN","DGENACL",2,0)
 ;;5.3;Registration;**779,788,824,978**;08/13/93;Build 19
"RTN","DGENACL",3,0)
 ;
"RTN","DGENACL",4,0)
EDIT ;-Entry point - Edit Appointment Request Status and Comment option
"RTN","DGENACL",5,0)
 N DIC,DIE,DA,DR,Y,DFN
"RTN","DGENACL",6,0)
 S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y
"RTN","DGENACL",7,0)
 S DIE=DIC,DA=+Y,DR="[DGEN NEACL]" D ^DIE W !!
"RTN","DGENACL",8,0)
 G EDIT
"RTN","DGENACL",9,0)
Q Q
"RTN","DGENACL",10,0)
 ;
"RTN","DGENACL",11,0)
REPORT(DGRPT) ;-Entry point - Call List/Tracking reports
"RTN","DGENACL",12,0)
 ;
"RTN","DGENACL",13,0)
 ; DGRPT: 1 = Call List: New enrollee appt. request/no appt. assigned.
"RTN","DGENACL",14,0)
 ;        2 = Tracking Report: New enrollee appt. request/by date range
"RTN","DGENACL",15,0)
 ;
"RTN","DGENACL",16,0)
 N DGBEG,DGEND,DTOUT,DUOUT,DIRUT,DGFMT1,DGFMT2,DGERROR,DGPFTF,DGPFTFLG,DGSITE
"RTN","DGENACL",17,0)
 S (DGBEG,DGEND,DGERROR)="",DGSITE=+$P($$SITE^VASITE(),U,3)
"RTN","DGENACL",18,0)
 I $G(DGRPT)'=1&($G(DGRPT)'=2) G Q
"RTN","DGENACL",19,0)
 I DGRPT=1 D FMT1 I $D(DTOUT)!($D(DUOUT)) G Q
"RTN","DGENACL",20,0)
 I DGRPT=2 D FMT2 I $D(DTOUT)!($D(DUOUT)) G Q
"RTN","DGENACL",21,0)
 D PFTF I $D(DTOUT)!($D(DUOUT)) G Q
"RTN","DGENACL",22,0)
 I DGPFTFLG,'$O(DGPFTF("")) G Q
"RTN","DGENACL",23,0)
 N ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZUSR,ZTDTH,POP,X,ERR,V
"RTN","DGENACL",24,0)
 K IOP,%ZIS
"RTN","DGENACL",25,0)
 S %ZIS="Q" D ^%ZIS G:POP EXIT
"RTN","DGENACL",26,0)
 I $D(IO("Q")) D  Q
"RTN","DGENACL",27,0)
 . F V="DGSITE","DGRPT","DGFMT1","DGFMT2","DGBEG","DGEND","DGPFTF(","DGERROR","DGPFTFLG" S ZTSAVE(V)=""
"RTN","DGENACL",28,0)
 . S ZTRTN="BUILD^DGENACL",ZTDESC="NEW ENROLLEE APPT. CALL LIST REPORT",ZTDTH=$H
"RTN","DGENACL",29,0)
 . D ^%ZTLOAD
"RTN","DGENACL",30,0)
 . D ^%ZISC,HOME^%ZIS
"RTN","DGENACL",31,0)
 . W !,$S($D(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
"RTN","DGENACL",32,0)
 D BUILD
"RTN","DGENACL",33,0)
EXIT D ^%ZISC,HOME^%ZIS
"RTN","DGENACL",34,0)
 Q
"RTN","DGENACL",35,0)
 ;
"RTN","DGENACL",36,0)
BUILD ;-Build temp global
"RTN","DGENACL",37,0)
 K ^TMP($J,"DGEN NEACL")
"RTN","DGENACL",38,0)
 N DFNIEN,DGDT,DGEDT
"RTN","DGENACL",39,0)
 I DGRPT=1 S DFNIEN=0 F  S DFNIEN=$O(^DPT("AEAR",1,DFNIEN)) Q:'DFNIEN  D  Q:+DGERROR
"RTN","DGENACL",40,0)
 . I $$GET1^DIQ(2,DFNIEN,1010.159,"I") D EXTRACT
"RTN","DGENACL",41,0)
 I DGRPT=2 D
"RTN","DGENACL",42,0)
 . S DGDT=DGBEG-.01,DGEDT=DGEND_.999
"RTN","DGENACL",43,0)
 . F  S DGDT=$O(^DPT("AEACL",DGDT)) Q:'DGDT!(DGDT>DGEDT)  D  Q:+DGERROR
"RTN","DGENACL",44,0)
 .. S DFNIEN=0 F  S DFNIEN=$O(^DPT("AEACL",DGDT,DFNIEN)) Q:'DFNIEN  D  Q:+DGERROR
"RTN","DGENACL",45,0)
 ... I $$GET1^DIQ(2,DFNIEN,1010.159,"I") D EXTRACT
"RTN","DGENACL",46,0)
 D PRINT^DGENACL1
"RTN","DGENACL",47,0)
 Q
"RTN","DGENACL",48,0)
 ;
"RTN","DGENACL",49,0)
EXTRACT ;
"RTN","DGENACL",50,0)
 D EXTRACT^DGENACL2
"RTN","DGENACL",51,0)
 Q
"RTN","DGENACL",52,0)
 ;
"RTN","DGENACL",53,0)
DATE N X1,X2
"RTN","DGENACL",54,0)
 S DIR(0)="DAO^,"_DT_",::EX"
"RTN","DGENACL",55,0)
 S X1=DT,X2=-7 D C^%DTC
"RTN","DGENACL",56,0)
 S Y=X D DD^%DT
"RTN","DGENACL",57,0)
 ; jam DG*5.3*978 - modified prompt - remove "ON 1010EZ" from "APPT. REQUEST START DATE"
"RTN","DGENACL",58,0)
 S DIR("A")="APPOINTMENT REQUEST START DATE: "
"RTN","DGENACL",59,0)
 S DIR("B")=Y
"RTN","DGENACL",60,0)
 S DIR("?")="Enter a date that an enrollee was asked question."
"RTN","DGENACL",61,0)
 D ^DIR K DIR
"RTN","DGENACL",62,0)
 I $D(DIRUT) S DTOUT=1
"RTN","DGENACL",63,0)
 I $D(DTOUT)!($D(DUOUT)) Q
"RTN","DGENACL",64,0)
 S DGBEG=Y
"RTN","DGENACL",65,0)
 S DIR(0)="DAO^"_DGBEG_","_DT_"::EX"
"RTN","DGENACL",66,0)
 S Y=DT D DD^%DT S DGDT=Y
"RTN","DGENACL",67,0)
 S DIR("B")=DGDT
"RTN","DGENACL",68,0)
 ; jam DG*5.3*978 - modified prompt - remove "ON 1010EZ" from "APPT. REQUEST END DATE"
"RTN","DGENACL",69,0)
 S DIR("A")="APPOINTMENT REQUEST END DATE: "
"RTN","DGENACL",70,0)
 S DIR("?")="Enter a date that an enrollee was asked question."
"RTN","DGENACL",71,0)
 D ^DIR K DIR
"RTN","DGENACL",72,0)
 I $D(DIRUT) S DTOUT=1
"RTN","DGENACL",73,0)
 I $D(DTOUT)!($D(DUOUT)) Q
"RTN","DGENACL",74,0)
 S DGEND=Y
"RTN","DGENACL",75,0)
 I $G(DGBEG)']""!($G(DGEND)']"") W !!,"DATE RANGE NOT SET.  EXITING"  S DUOUT=1
"RTN","DGENACL",76,0)
 Q
"RTN","DGENACL",77,0)
FMT1 ;Call List D/S
"RTN","DGENACL",78,0)
 N DIR
"RTN","DGENACL",79,0)
 K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SHORT"
"RTN","DGENACL",80,0)
 S DIR("?",1)="SHORT format lists enrollee appointment requests w/o an appointment."
"RTN","DGENACL",81,0)
 S DIR("?")="DETAILED format, in addition, lists patient lookup information."
"RTN","DGENACL",82,0)
 S DIR("B")="SHORT" D ^DIR K DIR
"RTN","DGENACL",83,0)
 I $D(DTOUT)!($D(DUOUT)) Q
"RTN","DGENACL",84,0)
 S DGFMT1=Y
"RTN","DGENACL",85,0)
 Q
"RTN","DGENACL",86,0)
FMT2 ;Tracking Report D/S
"RTN","DGENACL",87,0)
 N DIR
"RTN","DGENACL",88,0)
 K DIR S DIR("A")="Select report format",DIR(0)="S^D:DETAILED;S:SUMMARY"
"RTN","DGENACL",89,0)
 S DIR("?",1)="SUMMARY format lists totals of enrollee appointment requests."
"RTN","DGENACL",90,0)
 S DIR("?")="DETAILED format, lists individual enrollee appointment requests."
"RTN","DGENACL",91,0)
 S DIR("B")="SUMMARY" D ^DIR K DIR
"RTN","DGENACL",92,0)
 I $D(DTOUT)!($D(DUOUT)) Q
"RTN","DGENACL",93,0)
 S DGFMT2=Y
"RTN","DGENACL",94,0)
 D DATE
"RTN","DGENACL",95,0)
 Q
"RTN","DGENACL",96,0)
PFTF ;Ask Preferred Facility?
"RTN","DGENACL",97,0)
 S DGPFTFLG=0
"RTN","DGENACL",98,0)
 S DIR("A")="Select individual Preferred Facilities",DIR(0)="Y",DIR("B")="NO"
"RTN","DGENACL",99,0)
 D ^DIR K DIR
"RTN","DGENACL",100,0)
 I $D(DTOUT)!($D(DUOUT)) Q
"RTN","DGENACL",101,0)
 I Y=1 S DGPFTFLG=1
"RTN","DGENACL",102,0)
 I DGPFTFLG D
"RTN","DGENACL",103,0)
 . K DGPFTF
"RTN","DGENACL",104,0)
 . S DIR("A")="Preferred Facility",DIR(0)="PO^4:EMZ",DIR("S")="I $$PFTF^DGREGDD(Y),(+DGSITE=+$$GET1^DIQ(4,Y,99))"
"RTN","DGENACL",105,0)
 . F  D ^DIR Q:(+Y<0)!($D(DTOUT))!($D(DUOUT))  S DGPFTF(+Y)=""
"RTN","DGENACL",106,0)
 Q
"RTN","DGENACL",107,0)
BCKJOB(DGRPT) ;Queued entry point
"RTN","DGENACL",108,0)
 N DGERROR,DGPFTFLG,DGFMT1,DGSITE
"RTN","DGENACL",109,0)
 S DGRPT=$G(DGRPT) I DGRPT'=1 Q
"RTN","DGENACL",110,0)
 S DGFMT1="D"
"RTN","DGENACL",111,0)
 S (DGERROR,DGPFTFLG)="",DGSITE=+$P($$SITE^VASITE(),U,3)
"RTN","DGENACL",112,0)
 D BUILD
"RTN","DGENACL",113,0)
 Q
"RTN","DGENACL",114,0)
 ;
"RTN","DGENACL1")
0^3^B63749530
"RTN","DGENACL1",1,0)
DGENACL1 ;ALB/MRY,JAM - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;02/15/2008
"RTN","DGENACL1",2,0)
 ;;5.3;Registration;**779,788,978**;08/13/93;Build 19
"RTN","DGENACL1",3,0)
 ;
"RTN","DGENACL1",4,0)
PRINT N DGLN,PAGE,QUIT,DGTOTAL
"RTN","DGENACL1",5,0)
 S QUIT=""
"RTN","DGENACL1",6,0)
 U IO
"RTN","DGENACL1",7,0)
 I $E(IOST,1,2)="C-" D EN^DDIOL("","","@IOF")
"RTN","DGENACL1",8,0)
 S DGLN=0
"RTN","DGENACL1",9,0)
 S PAGE=1
"RTN","DGENACL1",10,0)
 D HEADER:'DGPFTFLG
"RTN","DGENACL1",11,0)
 D DATA
"RTN","DGENACL1",12,0)
 I DGLN=0 D
"RTN","DGENACL1",13,0)
 . D EN^DDIOL("No data to report.","","!!!?30")
"RTN","DGENACL1",14,0)
 . I $E(IOST,1,2)="C-" D PAUSE
"RTN","DGENACL1",15,0)
 I ('DGPFTFLG),(DGLN>0),('QUIT) D SUMARY
"RTN","DGENACL1",16,0)
 Q
"RTN","DGENACL1",17,0)
 ;
"RTN","DGENACL1",18,0)
HEADER ;
"RTN","DGENACL1",19,0)
 N DG1,DG2,Y
"RTN","DGENACL1",20,0)
 I DGRPT=1 D
"RTN","DGENACL1",21,0)
 . D EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST CALL LIST","","!?15")
"RTN","DGENACL1",22,0)
 . S Y=DT D DD^%DT D EN^DDIOL("Date: "_Y,"","?60")
"RTN","DGENACL1",23,0)
 . D EN^DDIOL("Page: "_PAGE,"","!?60")
"RTN","DGENACL1",24,0)
 . D:DGPFTFLG EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!") D EN^DDIOL("","","!!")
"RTN","DGENACL1",25,0)
 . I ($G(DGFMT1)="S") D
"RTN","DGENACL1",26,0)
 . . ; jam DG*5.3*978 - modified column header - remove "1010EZ" from "APPT. REQUEST DATE" column
"RTN","DGENACL1",27,0)
 . . D EN^DDIOL("APPT.","","?30"),EN^DDIOL("REQ","","?45"),EN^DDIOL("RESIDENCE","","?52"),EN^DDIOL("CELLULAR","","?67")
"RTN","DGENACL1",28,0)
 . . D EN^DDIOL("NAME(SSN)"),EN^DDIOL("REQUEST DATE","","?30"),EN^DDIOL("STA","","?45"),EN^DDIOL("PHONE","","?54"),EN^DDIOL("PHONE","","?68")
"RTN","DGENACL1",29,0)
 . . D EN^DDIOL("","","!")
"RTN","DGENACL1",30,0)
 I DGRPT=2 D
"RTN","DGENACL1",31,0)
 . S Y=DGBEG D DD^%DT S DG1=Y
"RTN","DGENACL1",32,0)
 . S Y=DGEND D DD^%DT S DG2=Y
"RTN","DGENACL1",33,0)
 . D EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST TRACKING REPORT","","!?10")
"RTN","DGENACL1",34,0)
 . S Y=DT D DD^%DT D EN^DDIOL("Date: "_Y,"","?60")
"RTN","DGENACL1",35,0)
 . D EN^DDIOL(DG1_" TO "_DG2,"","!?20"),EN^DDIOL("Page: "_PAGE,"","?60")
"RTN","DGENACL1",36,0)
 . D:DGPFTFLG EN^DDIOL("PREFERRED FACILITY: "_DGPFTF,"","!!")
"RTN","DGENACL1",37,0)
 . I ($G(DGFMT2)="D") D
"RTN","DGENACL1",38,0)
 . . ; jam DG*5.3*978 - modified column headers text - "APPT. REQUEST" and "SCHEDULED APPT. DATE" column
"RTN","DGENACL1",39,0)
 . . ; added column ORIGINAL APPT. REQUEST 
"RTN","DGENACL1",40,0)
 . . D EN^DDIOL("ORIGINAL","","!!?47"),EN^DDIOL("SCHEDULED","","?57")
"RTN","DGENACL1",41,0)
 . . D EN^DDIOL("APPT.","","!?37"),EN^DDIOL("APPT.","","?47"),EN^DDIOL("APPT.","","?57"),EN^DDIOL("#","","?67"),EN^DDIOL("REQ","","?72")
"RTN","DGENACL1",42,0)
 . . D EN^DDIOL("NAME"),EN^DDIOL("EP/CV","","?31"),EN^DDIOL("REQUEST","","?37"),EN^DDIOL("REQUEST","","?47"),EN^DDIOL("DATE","","?57"),EN^DDIOL("DAYS","","?67"),EN^DDIOL("STA","","?72")
"RTN","DGENACL1",43,0)
 . . D EN^DDIOL("============================"),EN^DDIOL("=====","","?31"),EN^DDIOL("=========","","?37"),EN^DDIOL("=========","","?47"),EN^DDIOL("=========","","?57"),EN^DDIOL("====","","?67"),EN^DDIOL("===","","?72")
"RTN","DGENACL1",44,0)
 . . ;D EN^DDIOL("APPT.","","!!?37"),EN^DDIOL("SCHEDULED","","?54"),EN^DDIOL("#","","?71"),EN^DDIOL("REQ","","?76")
"RTN","DGENACL1",45,0)
 . . ;D EN^DDIOL("NAME"),EN^DDIOL("EP/CV","","?31"),EN^DDIOL("REQUEST DATE","","?37"),EN^DDIOL("APPOINTMENT DATE","","?51"),EN^DDIOL("DAYS","","?70"),EN^DDIOL("STA","","?76")
"RTN","DGENACL1",46,0)
 . . ;D EN^DDIOL("============================"),EN^DDIOL("=====","","?31"),EN^DDIOL("============","","?37"),EN^DDIOL("==================","","?51"),EN^DDIOL("====","","?70"),EN^DDIOL("===","","?76")
"RTN","DGENACL1",47,0)
 I +DGERROR D  Q
"RTN","DGENACL1",48,0)
 . D EN^DDIOL($P(DGERROR,"^",2),"","!!!")
"RTN","DGENACL1",49,0)
 . I $E(IOST,1,2)="C-" D PAUSE
"RTN","DGENACL1",50,0)
 S PAGE=PAGE+1
"RTN","DGENACL1",51,0)
 Q
"RTN","DGENACL1",52,0)
DATA ;
"RTN","DGENACL1",53,0)
 N DFN,DGNAM,DGSSN,DGI,DATAEP,DGFLG,DGRDTI,DGDAYS,DFNIEN,SDADTI,SDADT,DGDAYS,DGENPRI,DGENCVEL,DATA3,DGSTA
"RTN","DGENACL1",54,0)
 F DGI="C","E","F","I","NULL" S DGTOTAL(DGI)=0
"RTN","DGENACL1",55,0)
 S DGPFTF=""
"RTN","DGENACL1",56,0)
 F  S DGPFTF=$O(^TMP($J,"DGEN NEACL",DGPFTF)) Q:(DGPFTF="")  D  Q:QUIT
"RTN","DGENACL1",57,0)
 . I DGPFTFLG F DGI="C","E","F","I","NULL" S DGTOTAL(DGI)=0
"RTN","DGENACL1",58,0)
 . D TOP:((DGPFTFLG)&(PAGE>1)) D HEADER:((DGPFTFLG)&(PAGE=1))
"RTN","DGENACL1",59,0)
 . S DGI=0
"RTN","DGENACL1",60,0)
 . F  S DGI=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI)) Q:(DGI="")  D  Q:QUIT
"RTN","DGENACL1",61,0)
 .. S DGRDTI=0 F  S DGRDTI=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI)) Q:'DGRDTI  D  Q:QUIT
"RTN","DGENACL1",62,0)
 ... S DGNAM="" F  S DGNAM=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM)) Q:DGNAM=""  D  Q:QUIT
"RTN","DGENACL1",63,0)
 .... S DFNIEN="" F  S DFNIEN=$O(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN)) Q:DFNIEN=""  D  Q:QUIT
"RTN","DGENACL1",64,0)
 ..... S SDADTI=$G(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN))
"RTN","DGENACL1",65,0)
 ..... S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I") I DGSTA="" S DGSTA="NULL"
"RTN","DGENACL1",66,0)
 ..... I DGSTA="C" S SDADTI=$$GET1^DIQ(2,DFNIEN,1010.162,"I")
"RTN","DGENACL1",67,0)
 ..... S DGDAYS=$$DAYS(SDADTI,DGRDTI) S Y=SDADTI X ^DD("DD") S SDADT=Y
"RTN","DGENACL1",68,0)
 ..... S DGFLG=0 I 'SDADTI S DGFLG=1
"RTN","DGENACL1",69,0)
 ..... S DATAEP=$G(^TMP($J,"DGEN NEACL",DGPFTF,DGI,DGRDTI,DGNAM,DFNIEN,"PRIORITY"))
"RTN","DGENACL1",70,0)
 ..... S DGENPRI=$P(DATAEP,"^",3),DGENCVEL=$P(DATAEP,"^",4)
"RTN","DGENACL1",71,0)
 ..... S DATA3="/" S:+DGENPRI $P(DATA3,"/")=$E("  ",$L(+DGENPRI)+1,2)_+DGENPRI S:DGENCVEL $P(DATA3,"/",2)="EL" I DATA3="/" S DATA3=""
"RTN","DGENACL1",72,0)
 ..... S DGTOTAL(DGSTA)=DGTOTAL(DGSTA)+1
"RTN","DGENACL1",73,0)
 ..... D ADD I '(QUIT) D LINE
"RTN","DGENACL1",74,0)
 . I DGPFTFLG D SUMARY I $E(IOST,1,2)="C-" D PAUSE
"RTN","DGENACL1",75,0)
 Q
"RTN","DGENACL1",76,0)
PAUSE ;
"RTN","DGENACL1",77,0)
 N DIR,DIRUT,X,Y
"RTN","DGENACL1",78,0)
 F  Q:$Y>(IOSL-3)  W !
"RTN","DGENACL1",79,0)
 S DIR(0)="E"
"RTN","DGENACL1",80,0)
 D ^DIR
"RTN","DGENACL1",81,0)
 I ('(+Y))!($D(DIRUT)) S QUIT=1
"RTN","DGENACL1",82,0)
 Q
"RTN","DGENACL1",83,0)
TOP ;
"RTN","DGENACL1",84,0)
 D EN^DDIOL("","","@IOF")
"RTN","DGENACL1",85,0)
 D HEADER
"RTN","DGENACL1",86,0)
 Q
"RTN","DGENACL1",87,0)
ADD ;
"RTN","DGENACL1",88,0)
 I $E(IOST,1,2)="C-",($Y>(IOSL-3)) D
"RTN","DGENACL1",89,0)
 . D PAUSE
"RTN","DGENACL1",90,0)
 . Q:QUIT
"RTN","DGENACL1",91,0)
 . D TOP
"RTN","DGENACL1",92,0)
 I $E(IOST,1,2)'="C-",($Y>(IOSL-3)) D TOP
"RTN","DGENACL1",93,0)
 Q
"RTN","DGENACL1",94,0)
LINE ;add a line to the report
"RTN","DGENACL1",95,0)
 N DGNAMX,DPTDFN,DGCMT
"RTN","DGENACL1",96,0)
 I DGRPT=2 S DGNAMX=$P(DGNAM,",")
"RTN","DGENACL1",97,0)
 E  S DGNAMX=DGNAM
"RTN","DGENACL1",98,0)
 S DGNAMX=DGNAMX_"("_$E($$GET1^DIQ(2,DFNIEN,.09),6,9)_")"
"RTN","DGENACL1",99,0)
 I DGRPT=1,($G(DGFMT1)="D") D
"RTN","DGENACL1",100,0)
 . D EN^DDIOL(DGNAMX,"","!") D ADD Q:QUIT
"RTN","DGENACL1",101,0)
 . S (Y,DPTDFN)=DFNIEN
"RTN","DGENACL1",102,0)
 . I $$TESTPAT^VADPT(+Y) D EN^DDIOL("WARNING : You have selected a test patient."),ADD Q:QUIT
"RTN","DGENACL1",103,0)
 . I $$BADADR^DGUTL3(+Y) D EN^DDIOL("WARNING : ** This patient has been flagged with a Bad Address Indicator."),ADD Q:QUIT
"RTN","DGENACL1",104,0)
 . I $D(^DPT("AXFFP",1,+Y)) S DGCLIST=1 D FFP^DPTLK5 K DGCLIST D ADD Q:QUIT
"RTN","DGENACL1",105,0)
 . D ENR^DPTLK,ADD Q:QUIT
"RTN","DGENACL1",106,0)
 . D CV^DPTLK,ADD Q:QUIT
"RTN","DGENACL1",107,0)
 . ; jam DG*5.3*978 - modified field label - remove "1010EZ" from "APPT. REQUEST DATE" 
"RTN","DGENACL1",108,0)
 . D EN^DDIOL("APPT. REQUEST DATE: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?28") D ADD Q:QUIT
"RTN","DGENACL1",109,0)
 . ; jam DG*5.3*978 - add Original Appt. Request Date field to the report - display the field only if 1010.1512 is 1 (YES)
"RTN","DGENACL1",110,0)
 . D EN^DDIOL("ORIGINAL APPT. REQUEST DATE: ") D:$$GET1^DIQ(2,DFNIEN,1010.1512,"I")=1 EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1513),"","?30") D ADD Q:QUIT
"RTN","DGENACL1",111,0)
 . D EN^DDIOL("REQUEST STATUS: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161),"","?18") D ADD Q:QUIT
"RTN","DGENACL1",112,0)
 . D EN^DDIOL("COMMENT: "_$$GET1^DIQ(2,DFNIEN,1010.163)) D ADD Q:QUIT
"RTN","DGENACL1",113,0)
 . D EN^DDIOL("PHONE [RESIDENCE]: "_$$GET1^DIQ(2,DFNIEN,.131))
"RTN","DGENACL1",114,0)
 . D EN^DDIOL("PHONE [CELLULAR]: "_$$GET1^DIQ(2,DFNIEN,.134),"","?44") D ADD Q:QUIT
"RTN","DGENACL1",115,0)
 . D EN^DDIOL("PREFERRED FACILITY: "_DGPFTF) D ADD Q:QUIT
"RTN","DGENACL1",116,0)
 . ;D EN^DDIOL("PREFERRED FACILITY: "_$$GET1^DIQ(2,DFNIEN,27.02)) D ADD Q:QUIT
"RTN","DGENACL1",117,0)
 . D EN^DDIOL("---------------------------------------------------------------","","!?4") D ADD Q:QUIT
"RTN","DGENACL1",118,0)
 I DGRPT=1,($G(DGFMT1)="S") D  Q:QUIT
"RTN","DGENACL1",119,0)
 . D EN^DDIOL(DGNAMX) I $L(DGNAMX)>29 D EN^DDIOL("","","!") D ADD Q:QUIT
"RTN","DGENACL1",120,0)
 . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?30")
"RTN","DGENACL1",121,0)
 . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?46")
"RTN","DGENACL1",122,0)
 . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,.131),"","?51")
"RTN","DGENACL1",123,0)
 . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,.134),"","?66")
"RTN","DGENACL1",124,0)
 . D ADD Q:QUIT
"RTN","DGENACL1",125,0)
 I DGRPT=2,($G(DGFMT2)="D") D
"RTN","DGENACL1",126,0)
 . D EN^DDIOL(DGNAMX) I $L(DGNAMX)>29 D EN^DDIOL("","","!") D ADD Q:QUIT
"RTN","DGENACL1",127,0)
 . ; jam DG*5.3*978 added new column ORIGINAL APPT REQUEST DATE field 1010.1513
"RTN","DGENACL1",128,0)
 . ; this requires changes for the date fields to print out in mm/dd/yy format
"RTN","DGENACL1",129,0)
 . ;D EN^DDIOL(DATA3,"","?31"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?37"),EN^DDIOL(SDADT,"","?51"),EN^DDIOL($J(DGDAYS,3)_$S(DGFLG:"*",1:""),"","?71"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?77") D ADD Q:QUIT
"RTN","DGENACL1",130,0)
 . D EN^DDIOL(DATA3,"","?31"),EN^DDIOL($$FMTE^XLFDT($$GET1^DIQ(2,DFNIEN,1010.1511,"I"),"2DZ"),"","?37")
"RTN","DGENACL1",131,0)
 . ; DG*5.3*978 only display the field if ORIGINAL APPT REQUEST (field 1010.1512) is 1 (YES) 
"RTN","DGENACL1",132,0)
 . I $$GET1^DIQ(2,DFNIEN,1010.1512,"I")=1 D EN^DDIOL($$FMTE^XLFDT($$GET1^DIQ(2,DFNIEN,1010.1513,"I"),"2DZ"),"","?47")
"RTN","DGENACL1",133,0)
 . D EN^DDIOL($$FMTE^XLFDT(SDADTI,"2DZ"),"","?57"),EN^DDIOL($J(DGDAYS,3)_$S(DGFLG:"*",1:""),"","?67"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?73") D ADD Q:QUIT
"RTN","DGENACL1",134,0)
 . S DGCMT=$$GET1^DIQ(2,DFNIEN,1010.163) I $G(DGCMT)'="" D EN^DDIOL("COMMENT: "_DGCMT,"","!?3") D ADD Q:QUIT
"RTN","DGENACL1",135,0)
 S DGLN=1
"RTN","DGENACL1",136,0)
 Q
"RTN","DGENACL1",137,0)
 ;
"RTN","DGENACL1",138,0)
SUMARY ;display totals
"RTN","DGENACL1",139,0)
 ;K DGFMT1 S DGFMT2="S"
"RTN","DGENACL1",140,0)
 D ADD2 Q:QUIT
"RTN","DGENACL1",141,0)
 D EN^DDIOL("SUMMARY","","!!!")
"RTN","DGENACL1",142,0)
 D EN^DDIOL("==============================================================================")
"RTN","DGENACL1",143,0)
 S DGI="" F  S DGI=$O(DGTOTAL(DGI)) Q:DGI=""  D
"RTN","DGENACL1",144,0)
 . I (DGRPT=1)&((DGI="C")!(DGI="F")) Q
"RTN","DGENACL1",145,0)
 . D EN^DDIOL("Total number of veteran's "_$S(DGI="NULL":"",1:"with ")_$S(DGI="C":"CANCELLED",DGI="E":"EWL",DGI="F":"FILLED",DGI="I":"CONTACTED - IN PROCESS",1:"PENDING ACTION")_$S(DGI="NULL":"",1:" request status"))
"RTN","DGENACL1",146,0)
 . D EN^DDIOL($J(DGTOTAL(DGI),4),"","?73")
"RTN","DGENACL1",147,0)
 Q
"RTN","DGENACL1",148,0)
 ;
"RTN","DGENACL1",149,0)
ADD2 ;
"RTN","DGENACL1",150,0)
 I $E(IOST,1,2)="C-",($Y>(IOSL-8)) D
"RTN","DGENACL1",151,0)
 . D PAUSE
"RTN","DGENACL1",152,0)
 . Q:QUIT
"RTN","DGENACL1",153,0)
 . D TOP
"RTN","DGENACL1",154,0)
 I $E(IOST,1,2)'="C-",($Y>(IOSL-8)) D TOP
"RTN","DGENACL1",155,0)
 Q
"RTN","DGENACL1",156,0)
DAYS(X1,X2) ;Compute # of days
"RTN","DGENACL1",157,0)
 S X1=$G(X1),X2=$G(X2)
"RTN","DGENACL1",158,0)
 I X1="" S X1=DT
"RTN","DGENACL1",159,0)
 D ^%DTC
"RTN","DGENACL1",160,0)
 Q X
"RTN","DGENACL1",161,0)
Q Q
"RTN","DGENPTA1")
0^5^B30646011
"RTN","DGENPTA1",1,0)
DGENPTA1 ;ALB/CJM,EG,CKN,ERC,TDM,PWC,JAM - Patient API - File Data ;5/24/11 4:54pm
"RTN","DGENPTA1",2,0)
 ;;5.3;Registration;**121,147,314,677,659,653,688,810,754,838,841,842,978**;Aug 13,1993;Build 19
"RTN","DGENPTA1",3,0)
 ;
"RTN","DGENPTA1",4,0)
LOCK(DFN) ;
"RTN","DGENPTA1",5,0)
 ;Description: Given an internal entry number of a PATIENT  record, this
"RTN","DGENPTA1",6,0)
 ;   function will lock the record. It should be used when updating the
"RTN","DGENPTA1",7,0)
 ;   record.
"RTN","DGENPTA1",8,0)
 ;Input:
"RTN","DGENPTA1",9,0)
 ;  DFN - Patient IEN
"RTN","DGENPTA1",10,0)
 ;Output:
"RTN","DGENPTA1",11,0)
 ;  Function Value - Returns 1 if the lock was successful, 0 otherwise
"RTN","DGENPTA1",12,0)
 ;
"RTN","DGENPTA1",13,0)
 I $G(DFN) L +^DPT(DFN):2
"RTN","DGENPTA1",14,0)
 Q $T
"RTN","DGENPTA1",15,0)
UNLOCK(DFN) ;
"RTN","DGENPTA1",16,0)
 ;Description: Given an internal entry number of a record in the PATIENT
"RTN","DGENPTA1",17,0)
 ;   file, this function will unlock the record that was previously
"RTN","DGENPTA1",18,0)
 ;   locked by LOCK PATIENT RECORD.  
"RTN","DGENPTA1",19,0)
 ;Input:
"RTN","DGENPTA1",20,0)
 ;   DFN - Patient IEN
"RTN","DGENPTA1",21,0)
 ;Output: None
"RTN","DGENPTA1",22,0)
 ;
"RTN","DGENPTA1",23,0)
 I $G(DFN) L -^DPT(DFN)
"RTN","DGENPTA1",24,0)
 Q
"RTN","DGENPTA1",25,0)
 ;
"RTN","DGENPTA1",26,0)
STOREPRE(DFN,DGPREFAC) ;
"RTN","DGENPTA1",27,0)
 ;Description: Used to store the patient's preferred facility in the
"RTN","DGENPTA1",28,0)
 ;   patient record.
"RTN","DGENPTA1",29,0)
 ;Input:
"RTN","DGENPTA1",30,0)
 ;  DFN - Patient IEN
"RTN","DGENPTA1",31,0)
 ;  DGPREFAC - pointer to the record in the INSTITUTION file.
"RTN","DGENPTA1",32,0)
 ;Output:
"RTN","DGENPTA1",33,0)
 ;  Function Value - Returns 1 on success, 0 on failure.
"RTN","DGENPTA1",34,0)
 ;
"RTN","DGENPTA1",35,0)
 N SUCCESS,DATA
"RTN","DGENPTA1",36,0)
 S SUCCESS=1
"RTN","DGENPTA1",37,0)
 D  ;drops out if invalid condition found
"RTN","DGENPTA1",38,0)
 . I $G(DFN),$D(^DPT(DFN,0))
"RTN","DGENPTA1",39,0)
 . E  S SUCCESS=0 Q
"RTN","DGENPTA1",40,0)
 . I ($G(DGPREFAC)'=""),'$G(DGPREFAC) S SUCCESS=0 Q
"RTN","DGENPTA1",41,0)
 . I $G(DGPREFAC),'$D(^DIC(4,DGPREFAC,0)) S SUCCESS=0 Q
"RTN","DGENPTA1",42,0)
 . S DATA(27.02)=DGPREFAC
"RTN","DGENPTA1",43,0)
 . S DATA(27.03)="V"     ; DG*5.3*838
"RTN","DGENPTA1",44,0)
 . S SUCCESS=$$UPD^DGENDBS(2,DFN,.DATA)
"RTN","DGENPTA1",45,0)
 Q SUCCESS
"RTN","DGENPTA1",46,0)
 ;
"RTN","DGENPTA1",47,0)
CHECK(DGPAT,ERROR) ;
"RTN","DGENPTA1",48,0)
 ;Description: Does validation checks on the patient contained in the
"RTN","DGENPTA1",49,0)
 ;DGPAT array.
"RTN","DGENPTA1",50,0)
 ;
"RTN","DGENPTA1",51,0)
 ;Input:
"RTN","DGENPTA1",52,0)
 ;  DGPAT - this local array contains patient data
"RTN","DGENPTA1",53,0)
 ;Output:
"RTN","DGENPTA1",54,0)
 ;  Function Value - returns 1 if all validation checks passed, 0 otherwise
"RTN","DGENPTA1",55,0)
 ;  ERROR - if validation checks fail, an error message is returned (pass by reference)
"RTN","DGENPTA1",56,0)
 ;
"RTN","DGENPTA1",57,0)
 ;
"RTN","DGENPTA1",58,0)
 N SUCCESS,FIELD
"RTN","DGENPTA1",59,0)
 S SUCCESS=1
"RTN","DGENPTA1",60,0)
 S ERROR=""
"RTN","DGENPTA1",61,0)
 ;
"RTN","DGENPTA1",62,0)
 ;check field values
"RTN","DGENPTA1",63,0)
 ;
"RTN","DGENPTA1",64,0)
 ;some of the field's input transforms require DA or DUZ to be defined, so do not do this
"RTN","DGENPTA1",65,0)
 ;F  S SUB=$O(DGPAT(SUB)) Q:SUB=""  D:(DGPAT(SUB)'="")  Q:'SUCCESS
"RTN","DGENPTA1",66,0)
 ;.S FIELD=$$FIELD(SUB)
"RTN","DGENPTA1",67,0)
 ;.I '$$TESTVAL^DGENDBS(2,FIELD,DGPAT(SUB)) D
"RTN","DGENPTA1",68,0)
 ;..S SUCCESS=0
"RTN","DGENPTA1",69,0)
 ;..S ERROR="BAD FIELD VALUE, PATIENT FILE FIELD = "_$$GET1^DID(2,FIELD,,"LABEL")
"RTN","DGENPTA1",70,0)
 ;
"RTN","DGENPTA1",71,0)
 ;instead, check field values without referencing DD
"RTN","DGENPTA1",72,0)
 I DGPAT("INELDEC")'="",($L(DGPAT("INELDEC"))>75)!($L(DGPAT("INELDEC"))<3) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE VARO DECISION" G QCHECK
"RTN","DGENPTA1",73,0)
 ;
"RTN","DGENPTA1",74,0)
 I DGPAT("INELREA")'="",($L(DGPAT("INELREA"))>40) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE REASON" G QCHECK
"RTN","DGENPTA1",75,0)
 ;
"RTN","DGENPTA1",76,0)
 I DGPAT("VETERAN")="" S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD = VETERAN (Y/N)?" G QCHECK
"RTN","DGENPTA1",77,0)
 ;
"RTN","DGENPTA1",78,0)
 I DGPAT("DEATH"),(DGPAT("DEATH")>DT) S SUCCESS=0,ERROR="DATE OF DEATH CAN NOT BE A FUTURE DATE" G QCHECK
"RTN","DGENPTA1",79,0)
 ;
"RTN","DGENPTA1",80,0)
 I DGPAT("INELDATE"),(DGPAT("INELREA")="") S SUCCESS=0,ERROR="INELIGIBLE REASON UNSPECIFIED FOR INELIGIBLE PATIENT" G QCHECK
"RTN","DGENPTA1",81,0)
 ;
"RTN","DGENPTA1",82,0)
QCHECK ;
"RTN","DGENPTA1",83,0)
 Q SUCCESS
"RTN","DGENPTA1",84,0)
 ;
"RTN","DGENPTA1",85,0)
STORE(DGPAT,ERROR,NOCHECK) ;
"RTN","DGENPTA1",86,0)
 ;Description: Files data in the patient record.  It requires a lock
"RTN","DGENPTA1",87,0)
 ;on the Patient record, adn releases the lock when done.
"RTN","DGENPTA1",88,0)
 ;
"RTN","DGENPTA1",89,0)
 ;Input:
"RTN","DGENPTA1",90,0)
 ;  DGPAT- the patient array, passed by reference
"RTN","DGENPTA1",91,0)
 ;  NOCHECK - a flag, if set to 1 it means consistency checks were done aready, so skip
"RTN","DGENPTA1",92,0)
 ;
"RTN","DGENPTA1",93,0)
 ;Output:
"RTN","DGENPTA1",94,0)
 ;  Function Value - returns 1 if successful, otherwise 0
"RTN","DGENPTA1",95,0)
 ;  ERROR - on failure, an error message is returned (optional, pass by reference)
"RTN","DGENPTA1",96,0)
 ;
"RTN","DGENPTA1",97,0)
 S ERROR=""
"RTN","DGENPTA1",98,0)
 I '$D(DGPAT) S ERROR="PATIENT NOT FOUND" Q 0
"RTN","DGENPTA1",99,0)
 I '$$LOCK(DGPAT("DFN")) S ERROR="UNABLE TO LOCK THE PATIENT RECORD" Q 0
"RTN","DGENPTA1",100,0)
 I $G(NOCHECK)'=1 Q:'$$CHECK(.DGPAT,.ERROR) 0
"RTN","DGENPTA1",101,0)
 ;
"RTN","DGENPTA1",102,0)
 N DATA,SUB,FIELD,SUCCESS
"RTN","DGENPTA1",103,0)
 S SUB=""
"RTN","DGENPTA1",104,0)
 ;
"RTN","DGENPTA1",105,0)
 F  S SUB=$O(DGPAT(SUB)) Q:(SUB="")  I (SUB'="DEATH")&(SUB'="SSN") S FIELD=$$FIELD(SUB) I FIELD S DATA(FIELD)=$G(DGPAT(SUB))
"RTN","DGENPTA1",106,0)
 S SUCCESS=$$UPD^DGENDBS(2,DGPAT("DFN"),.DATA)
"RTN","DGENPTA1",107,0)
 I 'SUCCESS S ERROR="FILEMAN UNABLE TO UPDATE PATIENT RECORD"
"RTN","DGENPTA1",108,0)
 ; jam; dg*5.3*978 - 1010.1514 and 1010.1515 fields added to the ZIO segment (seq 7 and 10) - ORIG APPT REQUEST CHG DT/TM and APPT REQUEST ON 1010EZ CHG DT/TM
"RTN","DGENPTA1",109,0)
 ;   these are timestamps that may have been triggered by VistA filing the other 1010.* fields above.
"RTN","DGENPTA1",110,0)
 ;   So we set those values from the HL7 into the database now - after those others have been filed
"RTN","DGENPTA1",111,0)
 I SUCCESS,$D(DGPAT("APPREQTS")) D
"RTN","DGENPTA1",112,0)
 . N DATA,DGENDA
"RTN","DGENPTA1",113,0)
 . S DGENDA=DGPAT("DFN")
"RTN","DGENPTA1",114,0)
 . S DATA(1010.1515)=DGPAT("APPREQTS")
"RTN","DGENPTA1",115,0)
 . S SUCCESS=$$UPD^DGENDBS(2,.DGENDA,.DATA)
"RTN","DGENPTA1",116,0)
 . K DATA,DGENDA
"RTN","DGENPTA1",117,0)
 I SUCCESS,$D(DGPAT("ORIGAPPREQTS")) D
"RTN","DGENPTA1",118,0)
 . N DATA,DGENDA
"RTN","DGENPTA1",119,0)
 . S DGENDA=DGPAT("DFN")
"RTN","DGENPTA1",120,0)
 . S DATA(1010.1514)=DGPAT("ORIGAPPREQTS")
"RTN","DGENPTA1",121,0)
 . S SUCCESS=$$UPD^DGENDBS(2,.DGENDA,.DATA)
"RTN","DGENPTA1",122,0)
 . K DATA,DGENDA
"RTN","DGENPTA1",123,0)
 ;
"RTN","DGENPTA1",124,0)
 ; Call Purple Heart API to file PH data in file 2
"RTN","DGENPTA1",125,0)
 I SUCCESS,$D(DGPAT("PHI")) D EDITPH^DGRPLE($G(DGPAT("PHI")),$G(DGPAT("PHST")),$G(DGPAT("PHRR")),DGPAT("DFN"))
"RTN","DGENPTA1",126,0)
 ; Call POW API to file POW data in file 2 - DG*5.3*653
"RTN","DGENPTA1",127,0)
 ;I SUCCESS,$D(DGPAT("POWI")) D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
"RTN","DGENPTA1",128,0)
 I SUCCESS D
"RTN","DGENPTA1",129,0)
 . I '$D(DGPAT("POWI")) D  Q
"RTN","DGENPTA1",130,0)
 . . N DATA,ERROR,DGENDA
"RTN","DGENPTA1",131,0)
 . . S DGENDA=DGPAT("DFN")
"RTN","DGENPTA1",132,0)
 . . S (DATA(.525),DATA(.526),DATA(.527),DATA(.528),DATA(.529))="@"
"RTN","DGENPTA1",133,0)
 . . I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D
"RTN","DGENPTA1",134,0)
 . . . D ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1)
"RTN","DGENPTA1",135,0)
 . . K DATA,ERROR,DGENDA
"RTN","DGENPTA1",136,0)
 . D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN"))
"RTN","DGENPTA1",137,0)
 D UNLOCK(DGPAT("DFN"))
"RTN","DGENPTA1",138,0)
 Q SUCCESS
"RTN","DGENPTA1",139,0)
 ;
"RTN","DGENPTA1",140,0)
FIELD(SUB) ;
"RTN","DGENPTA1",141,0)
 ;Description: Returns the field number of a subscript for the PATIENT object.
"RTN","DGENPTA1",142,0)
 ;
"RTN","DGENPTA1",143,0)
 N FNUM
"RTN","DGENPTA1",144,0)
 S FNUM=$S(SUB="DEATH":.351,SUB="PATYPE":391,SUB="VETERAN":1901,SUB="NAME":.01,SUB="DOB":.03,SUB="SEX":.02,SUB="SSN":.09,SUB="PREFAC":27.02,SUB="AG/ALLY":.309,1:"")
"RTN","DGENPTA1",145,0)
 S:'FNUM FNUM=$S(SUB="INELDATE":.152,SUB="INELREA":.307,SUB="INELDEC":.1656,SUB="PID":.363,SUB="EMGRES":.181,1:"")
"RTN","DGENPTA1",146,0)
 I FNUM="" S FNUM=$S(SUB="IR":.32103,SUB="RADEXPM":.3212,SUB="APPREQ":1010.159,SUB="APPREQDT":1010.1511,SUB="SPININJ":57.4,SUB="PFSRC":27.03,1:"")
"RTN","DGENPTA1",147,0)
 ; jam; DG*5.3*978 - these fields added to the ZIO segment (seq 8 and 9) - ORIGINAL APPOINTMENT REQUEST and ORIG APPT REQUEST DATE
"RTN","DGENPTA1",148,0)
 I FNUM="" S FNUM=$S(SUB="ORIGAPPREQ":1010.1512,SUB="ORIGAPPREQDT":1010.1513,1:"")
"RTN","DGENPTA1",149,0)
 I FNUM="" S FNUM=$S(SUB="MOH":.541,SUB="DENTC2IN":.3858,SUB="DENTC2DT":.3859,1:"")
"RTN","DGENPTA1",150,0)
 I FNUM="" S FNUM=$S(SUB="PENAEFDT":.3851,SUB="PENAREAS":.3852,SUB="PENTRMDT":.3853,1:"")
"RTN","DGENPTA1",151,0)
 I FNUM="" S FNUM=$S(SUB="PENTRMR1":.3854,SUB="PENTRMR2":.3855,SUB="PENTRMR3":.3856,SUB="PENTRMR4":.3857,SUB="PILOCK":.386,SUB="PALOCK":.3861,1:"")
"RTN","DGENPTA1",152,0)
 Q FNUM
"RTN","DGENUPLA")
0^4^B96425185
"RTN","DGENUPLA",1,0)
DGENUPLA ;ALB/CKN,TDM,PJR,RGL,EG,TMK,CKN,TDM,JAM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;23 Feb 2017  11:30 AM
"RTN","DGENUPLA",2,0)
 ;;5.3;REGISTRATION;**397,379,497,451,564,672,659,583,653,688,754,909,978**;Aug 13,1993;Build 19
"RTN","DGENUPLA",3,0)
 ;
"RTN","DGENUPLA",4,0)
 ;***************************************************************
"RTN","DGENUPLA",5,0)
 ; This routine was created because DGENUPL2 had reached it's
"RTN","DGENUPLA",6,0)
 ; maximum size, therefore no new code could not be added.  All
"RTN","DGENUPLA",7,0)
 ; code that existed in the ZEL and OBX tags of DGENUPL2 has
"RTN","DGENUPLA",8,0)
 ; been moved to the ZEL,ZPD and OBX tags of DGENUPLA.  A line of code
"RTN","DGENUPLA",9,0)
 ; was placed in ZEL^DGENUPL2 to call ZEL^DGENUPLA.  A line of
"RTN","DGENUPLA",10,0)
 ; code was placed in OBX^DGENUPL2 to call OBX^DGENUPLA.
"RTN","DGENUPLA",11,0)
 ; Any routine that calls ZEL,ZPD or OBX^DGENUPL2 will not
"RTN","DGENUPLA",12,0)
 ; be affected by this change.
"RTN","DGENUPLA",13,0)
 ;***************************************************************
"RTN","DGENUPLA",14,0)
 ;
"RTN","DGENUPLA",15,0)
 ;***************************************************************
"RTN","DGENUPLA",16,0)
 ;The following procedures parse particular segment types.
"RTN","DGENUPLA",17,0)
 ;Input:SEG(),MSGID
"RTN","DGENUPLA",18,0)
 ;Output:DGPAT(),DGELG(),DGENR(),DGNTR(),DGMST(),ERROR
"RTN","DGENUPLA",19,0)
 ;***************************************************************
"RTN","DGENUPLA",20,0)
 ;
"RTN","DGENUPLA",21,0)
 ;
"RTN","DGENUPLA",22,0)
ZEL(COUNT) ;
"RTN","DGENUPLA",23,0)
 N CODE,SEQ
"RTN","DGENUPLA",24,0)
 S CODE=$$CONVERT^DGENUPL1(SEG(2),"ELIGIBILITY",.ERROR)
"RTN","DGENUPLA",25,0)
 I ERROR D  Q
"RTN","DGENUPLA",26,0)
 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ELIGIBILITY CODE "_SEG(2)_" NOT FOUND IN ELIGIBILTIY CODE FILE",.ERRCOUNT)
"RTN","DGENUPLA",27,0)
 I COUNT=1 D
"RTN","DGENUPLA",28,0)
 .S DGELG("ELIG","CODE")=CODE
"RTN","DGENUPLA",29,0)
 .S DGELG("DISRET")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
"RTN","DGENUPLA",30,0)
 .I ERROR D  Q
"RTN","DGENUPLA",31,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 5",.ERRCOUNT)
"RTN","DGENUPLA",32,0)
 .S DGELG("CLAIMNUM")=$$CONVERT^DGENUPL1(SEG(6))
"RTN","DGENUPLA",33,0)
 .S DGELG("CLAIMLOC")=$$SITECNV(SEG(7))
"RTN","DGENUPLA",34,0)
 .;
"RTN","DGENUPLA",35,0)
 .S DGPAT("VETERAN")=$$CONVERT^DGENUPL1(SEG(8),"Y/N",.ERROR)
"RTN","DGENUPLA",36,0)
 .I ERROR D  Q
"RTN","DGENUPLA",37,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 8",.ERRCOUNT)
"RTN","DGENUPLA",38,0)
 .S DGELG("ELIGSTA")=$$CONVERT^DGENUPL1(SEG(10))
"RTN","DGENUPLA",39,0)
 .S DGELG("ELIGSTADATE")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
"RTN","DGENUPLA",40,0)
 .I ERROR D  Q
"RTN","DGENUPLA",41,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 11",.ERRCOUNT)
"RTN","DGENUPLA",42,0)
 .S DGELG("ELIGVERIF")=$$CONVERT^DGENUPL1(SEG(13))
"RTN","DGENUPLA",43,0)
 .S DGELG("A&A")=$$CONVERT^DGENUPL1(SEG(14),"Y/N",.ERROR)
"RTN","DGENUPLA",44,0)
 .I ERROR D  Q
"RTN","DGENUPLA",45,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 14",.ERRCOUNT)
"RTN","DGENUPLA",46,0)
 .S DGELG("HB")=$$CONVERT^DGENUPL1(SEG(15),"Y/N",.ERROR)
"RTN","DGENUPLA",47,0)
 .I ERROR D  Q
"RTN","DGENUPLA",48,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 15",.ERRCOUNT)
"RTN","DGENUPLA",49,0)
 .S DGELG("VAPEN")=$$CONVERT^DGENUPL1(SEG(16),"Y/N",.ERROR)
"RTN","DGENUPLA",50,0)
 .I ERROR D  Q
"RTN","DGENUPLA",51,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 16",.ERRCOUNT)
"RTN","DGENUPLA",52,0)
 .S DGELG("VADISAB")=$$CONVERT^DGENUPL1(SEG(17),"Y/N",.ERROR)
"RTN","DGENUPLA",53,0)
 .I ERROR D  Q
"RTN","DGENUPLA",54,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 17",.ERRCOUNT)
"RTN","DGENUPLA",55,0)
 .S DGELG("AO")=$$CONVERT^DGENUPL1(SEG(18),"Y/N",.ERROR)
"RTN","DGENUPLA",56,0)
 .N AOERR S AOERR=ERROR            ;  See SEG(29) below.
"RTN","DGENUPLA",57,0)
 .I ERROR D  Q
"RTN","DGENUPLA",58,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 18",.ERRCOUNT)
"RTN","DGENUPLA",59,0)
 .S (DGPAT("IR"),DGELG("IR"))=$$CONVERT^DGENUPL1(SEG(19),"Y/N",.ERROR)
"RTN","DGENUPLA",60,0)
 .I ERROR D  Q
"RTN","DGENUPLA",61,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 19",.ERRCOUNT)
"RTN","DGENUPLA",62,0)
 .S DGELG("EC")=$$CONVERT^DGENUPL1(SEG(20),"Y/N",.ERROR)
"RTN","DGENUPLA",63,0)
 .I ERROR D  Q
"RTN","DGENUPLA",64,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 20",.ERRCOUNT)
"RTN","DGENUPLA",65,0)
 .S (DGPAT("RADEXPM"),DGELG("RADEXPM"))=$$CONVERT^DGENUPL1($G(SEG(22)))
"RTN","DGENUPLA",66,0)
 .S ERROR=$S(DGELG("RADEXPM")="":0,",2,3,4,5,6,7,"[(","_DGELG("RADEXPM")_","):0,DGELG("RADEXPM")="@":0,1:1)
"RTN","DGENUPLA",67,0)
 .I ERROR D  Q
"RTN","DGENUPLA",68,0)
 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 22",.ERRCOUNT)
"RTN","DGENUPLA",69,0)
 .;
"RTN","DGENUPLA",70,0)
 .S DGELG("VACKAMT")=$$CONVERT^DGENUPL1(SEG(21))
"RTN","DGENUPLA",71,0)
 .;
"RTN","DGENUPLA",72,0)
 .;Parse MST data into DGMST array from sequences 23, 24, 25 of ZEL segment
"RTN","DGENUPLA",73,0)
 . F SEQ=23,24,25 S:SEG(SEQ)=HLQ SEG(SEQ)=""
"RTN","DGENUPLA",74,0)
 . S DGMST("MSTSTAT")=$$CONVERT^DGENUPL1(SEG(23))
"RTN","DGENUPLA",75,0)
 . S DGMST("MSTDT")=$$CONVERT^DGENUPL1(SEG(24),"TS",.ERROR)
"RTN","DGENUPLA",76,0)
 . I ERROR D  Q
"RTN","DGENUPLA",77,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 24",.ERRCOUNT)
"RTN","DGENUPLA",78,0)
 . S DGMST("MSTST")=$$CONVERT^DGENUPL1(SEG(25),"INSTITUTION",.ERROR)
"RTN","DGENUPLA",79,0)
 . I ERROR D  Q
"RTN","DGENUPLA",80,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 25",.ERRCOUNT)
"RTN","DGENUPLA",81,0)
 .;
"RTN","DGENUPLA",82,0)
 . S DGELG("AOEXPLOC")=$$CONVERT^DGENUPL1(SEG(29))
"RTN","DGENUPLA",83,0)
 .; Logic enhanced during SQA of patch 451.  AOERR from SEG(18) above.
"RTN","DGENUPLA",84,0)
 . I 'AOERR,DGELG("AO")'="Y",DGELG("AOEXPLOC")="" S DGELG("AOEXPLOC")="@"
"RTN","DGENUPLA",85,0)
 . S DGELG("UEYEAR")=$$CONVERT^DGENUPL1(SEG(34),"DATE",.ERROR)
"RTN","DGENUPLA",86,0)
 . I ERROR D  Q
"RTN","DGENUPLA",87,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 34",.ERRCOUNT)
"RTN","DGENUPLA",88,0)
 . S DGELG("UESITE")=$$CONVERT^DGENUPL1(SEG(35),"INSTITUTION",.ERROR)
"RTN","DGENUPLA",89,0)
 . I ERROR D  Q
"RTN","DGENUPLA",90,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 35",.ERRCOUNT)
"RTN","DGENUPLA",91,0)
 . S DGELG("CVELEDT")=$$CONVERT^DGENUPL1(SEG(38),"DATE",.ERROR)
"RTN","DGENUPLA",92,0)
 . I ERROR D  Q
"RTN","DGENUPLA",93,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 38",.ERRCOUNT)
"RTN","DGENUPLA",94,0)
 . I $G(DGELG("DISLOD"))="" S DGELG("DISLOD")=$$CONVERT^DGENUPL1(SEG(39),"1/0",.ERROR) ;Discharge due to Disability - DG*5.3*653
"RTN","DGENUPLA",95,0)
 . I ERROR D  Q
"RTN","DGENUPLA",96,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 39",.ERRCOUNT)
"RTN","DGENUPLA",97,0)
 . S DGELG("SHAD")=$$CONVERT^DGENUPL1(SEG(40),"1/0",.ERROR) ;Proj 112/SHAD - DG*5.3*653
"RTN","DGENUPLA",98,0)
 . I ERROR D  Q
"RTN","DGENUPLA",99,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 40 - SHAD Indicator",.ERRCOUNT)
"RTN","DGENUPLA",100,0)
 .; Camp Lejeune data checking added - DG*5.3*909
"RTN","DGENUPLA",101,0)
 . S DGELG("CLE")=$$CONVERT^DGENUPL1(SEG(41),"Y/N",.ERROR)
"RTN","DGENUPLA",102,0)
 . I ERROR D  Q
"RTN","DGENUPLA",103,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 41",.ERRCOUNT)
"RTN","DGENUPLA",104,0)
 . S DGELG("CLEDT")=$$CONVERT^DGENUPL1(SEG(42),"DATE",.ERROR)
"RTN","DGENUPLA",105,0)
 . I ERROR D  Q
"RTN","DGENUPLA",106,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 42",.ERRCOUNT)
"RTN","DGENUPLA",107,0)
 . S DGELG("CLEST")=$$CONVERT^DGENUPL1(SEG(43))
"RTN","DGENUPLA",108,0)
 . S DGELG("CLESOR")=$$CONVERT^DGENUPL1(SEG(44))
"RTN","DGENUPLA",109,0)
 ;
"RTN","DGENUPLA",110,0)
 I COUNT>1 D
"RTN","DGENUPLA",111,0)
 .S DGELG("ELIG","CODE",CODE)=""
"RTN","DGENUPLA",112,0)
 Q
"RTN","DGENUPLA",113,0)
 ;
"RTN","DGENUPLA",114,0)
OBX ;
"RTN","DGENUPLA",115,0)
 N OBXPCE,OBXVAL,OBXTBL,I,CS,SS,RS
"RTN","DGENUPLA",116,0)
 I $G(HLECH)'="~|\&" N HLECH S HLECH="~|\&"
"RTN","DGENUPLA",117,0)
 I $G(HLFS)="" N HLFS S HLFS="^"
"RTN","DGENUPLA",118,0)
 S CS=$E(HLECH,1),SS=$E(HLECH,4),RS=$E(HLECH,2)
"RTN","DGENUPLA",119,0)
 I $G(SEG(3))=("38.1"_$E(HLECH)_"SECURITY LOG") D
"RTN","DGENUPLA",120,0)
 . N LEVEL
"RTN","DGENUPLA",121,0)
 . S LEVEL=$P(SEG(5),$E(HLECH))
"RTN","DGENUPLA",122,0)
 . S DGSEC("LEVEL")=$$CONVERT^DGENUPL1(LEVEL,"1/0",.ERROR)
"RTN","DGENUPLA",123,0)
 . I ERROR D  Q
"RTN","DGENUPLA",124,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 5",.ERRCOUNT)
"RTN","DGENUPLA",125,0)
 . S DGSEC("DATETIME")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
"RTN","DGENUPLA",126,0)
 . I ERROR D  Q
"RTN","DGENUPLA",127,0)
 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 14, Patient Sensitivity Date/Time",.ERRCOUNT) ;DG*5.3*653
"RTN","DGENUPLA",128,0)
 . S DGSEC("SOURCE")=$$CONVERT^DGENUPL1(SEG(16))
"RTN","DGENUPLA",129,0)
 ;
"RTN","DGENUPLA",130,0)
 I $G(SEG(3))=("VISTA"_CS_"28.11") D
"RTN","DGENUPLA",131,0)
 . S OBXTBL(1)="NTR^Y",OBXTBL(2)="AVI^Y",OBXTBL(3)="SUB^Y"
"RTN","DGENUPLA",132,0)
 . S OBXTBL(4)="HNC^Y",OBXTBL(5)="NTR^N",OBXTBL(6)="AVI^N"
"RTN","DGENUPLA",133,0)
 . S OBXTBL(7)="SUB^N",OBXTBL(8)="HNC^N",OBXTBL(9)="NTR^U"
"RTN","DGENUPLA",134,0)
 . F I=1:1:$L($G(SEG(5)),RS) D
"RTN","DGENUPLA",135,0)
 . . S OBXPCE=$P($G(SEG(5)),RS,I),OBXVAL=$P($G(OBXPCE),CS)
"RTN","DGENUPLA",136,0)
 . . S DGNTR($P($G(OBXTBL(OBXVAL)),"^"))=$P($G(OBXTBL(OBXVAL)),"^",2)
"RTN","DGENUPLA",137,0)
 . I $G(SEG(12))'="" S DGNTR("HDT")=$$CONVERT^DGENUPL1(SEG(12),"TS",.ERROR)
"RTN","DGENUPLA",138,0)
 . S DGNTR("VDT")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
"RTN","DGENUPLA",139,0)
 . S DGNTR("VSIT")=$$CONVERT^DGENUPL1(SEG(15),"INSTITUTION",.ERROR)
"RTN","DGENUPLA",140,0)
 . S DGNTR("HSIT")=$P($P($G(SEG(16)),CS,14),SS,2)
"RTN","DGENUPLA",141,0)
 . I DGNTR("HSIT")'="" S DGNTR("HSIT")=$$CONVERT^DGENUPL1($G(DGNTR("HSIT")),"INSTITUTION",.ERROR)
"RTN","DGENUPLA",142,0)
 . S DGNTR("VER")=$$CONVERT^DGENUPL1($P($G(SEG(17)),CS))
"RTN","DGENUPLA",143,0)
 Q
"RTN","DGENUPLA",144,0)
 ;
"RTN","DGENUPLA",145,0)
ZIO ;New segment - DG*5.3*653
"RTN","DGENUPLA",146,0)
 S DGPAT("APPREQ")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
"RTN","DGENUPLA",147,0)
 I ERROR D  Q
"RTN","DGENUPLA",148,0)
 . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 5, APPOINTMENT REQUEST ON 1010EZ",.ERRCOUNT)
"RTN","DGENUPLA",149,0)
 S DGPAT("APPREQDT")=$$CONVERT^DGENUPL1(SEG(6),"DATE",.ERROR)
"RTN","DGENUPLA",150,0)
 I ERROR D  Q
"RTN","DGENUPLA",151,0)
 . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST DATE",.ERRCOUNT)
"RTN","DGENUPLA",152,0)
 ; jam; DG*5.3*978 - segments 7-10 added
"RTN","DGENUPLA",153,0)
 S DGPAT("APPREQTS")=$$CONVERT^DGENUPL1(SEG(7),"TS",.ERROR)
"RTN","DGENUPLA",154,0)
 I ERROR D  Q
"RTN","DGENUPLA",155,0)
 . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 7, APPOINTMENT REQUEST ON 1010EZ CHG DATE/TIME",.ERRCOUNT)
"RTN","DGENUPLA",156,0)
 S DGPAT("ORIGAPPREQ")=$$CONVERT^DGENUPL1(SEG(8),"1/0",.ERROR)
"RTN","DGENUPLA",157,0)
 I ERROR D  Q
"RTN","DGENUPLA",158,0)
 . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 8, ORIGINAL APPOINTMENT REQUEST",.ERRCOUNT)
"RTN","DGENUPLA",159,0)
 S DGPAT("ORIGAPPREQDT")=$$CONVERT^DGENUPL1(SEG(9),"DATE",.ERROR)
"RTN","DGENUPLA",160,0)
 I ERROR D  Q
"RTN","DGENUPLA",161,0)
 . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 9, ORIGINAL APPOINTMENT REQUEST DATE",.ERRCOUNT)
"RTN","DGENUPLA",162,0)
 S DGPAT("ORIGAPPREQTS")=$$CONVERT^DGENUPL1(SEG(10),"TS",.ERROR)
"RTN","DGENUPLA",163,0)
 I ERROR D  Q
"RTN","DGENUPLA",164,0)
 . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 10, ORIGINAL APPOINTMENT REQUEST CHG DT/TIME",.ERRCOUNT)
"RTN","DGENUPLA",165,0)
 ; jam; DG*5.3*978 - begin various validations that are done to detemine whether certain fields should be filed or dropped or an error sent back
"RTN","DGENUPLA",166,0)
 ; If not deleting ORIGINAL APPT REQUEST, Do not store Original Appt Request fields (1010.1512, 1010.1513, 1010.1514) if current value of field 1010.1512 in Vista is not blank
"RTN","DGENUPLA",167,0)
 I DGPAT("ORIGAPPREQ")'="@" D
"RTN","DGENUPLA",168,0)
 . I $$GET1^DIQ(2,DFN,1010.1512,"I")'="" K DGPAT("ORIGAPPREQ"),DGPAT("ORIGAPPREQDT"),DGPAT("ORIGAPPREQTS")
"RTN","DGENUPLA",169,0)
 ;
"RTN","DGENUPLA",170,0)
 ;These are the rules for the other 1010 fields (1010.159, 1010.1511 and 1010.1515):
"RTN","DGENUPLA",171,0)
 ;
"RTN","DGENUPLA",172,0)
 ;Value of           Value of 1010.159    Compare 1010.1515 
"RTN","DGENUPLA",173,0)
 ;1010EZ field         1010EZ field       with Z11 "APPREQTS"  
"RTN","DGENUPLA",174,0)
 ;Incoming Z11          in Vista DB       Which is more recent?      Resulting Process
"RTN","DGENUPLA",175,0)
 ;------------------------------------------------------------------------------------------------------------------------
"RTN","DGENUPLA",176,0)
 ;1. YES/NO              YES/NO                 Vista                Ignore the ZIO 1010 fields - no error is sent, process the Z11
"RTN","DGENUPLA",177,0)
 ;2. NO                  YES                    Z11                  Reject the Z11 - send error back
"RTN","DGENUPLA",178,0)
 ;3. All other cases     ---                    ---                  File the fields
"RTN","DGENUPLA",179,0)
 ;
"RTN","DGENUPLA",180,0)
 ; Case 1: If the incoming Z11 appt request date/time change is not "@" and is older that the Vista date/time change, 
"RTN","DGENUPLA",181,0)
 ;  don't file the fields - we don't throw an error for these cases.
"RTN","DGENUPLA",182,0)
 I DGPAT("APPREQTS")'="@",DGPAT("APPREQTS")<$$GET1^DIQ(2,DFN,1010.1515,"I") K DGPAT("APPREQTS"),DGPAT("APPREQ"),DGPAT("APPREQDT") Q
"RTN","DGENUPLA",183,0)
 ; Case 2 - If not deleting Appt. Request, changing a YES in Vista to a NO is not allowed and an error is generated
"RTN","DGENUPLA",184,0)
 I DGPAT("APPREQ")'="@",(DGPAT("APPREQ")=0)&($$GET1^DIQ(2,DFN,1010.159,"I")=1) D  Q
"RTN","DGENUPLA",185,0)
 .S ERROR=1
"RTN","DGENUPLA",186,0)
 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST ON 1010EZ - VISTA VALUE IS YES",.ERRCOUNT)
"RTN","DGENUPLA",187,0)
 ; 
"RTN","DGENUPLA",188,0)
 ; last check - field 1010.1511 APPOINTMENT REQUEST DATE must not be a future date
"RTN","DGENUPLA",189,0)
 I DGPAT("APPREQDT")>DT D  Q
"RTN","DGENUPLA",190,0)
 .S ERROR=1
"RTN","DGENUPLA",191,0)
 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 7, APPOINTMENT REQUEST DATE - FUTURE DATE",.ERRCOUNT)
"RTN","DGENUPLA",192,0)
 ; jam; DG*5.3*978 - end of validations - data can be filed.
"RTN","DGENUPLA",193,0)
 Q
"RTN","DGENUPLA",194,0)
 ;
"RTN","DGENUPLA",195,0)
ZPD ;
"RTN","DGENUPLA",196,0)
 S DGELG("RATEINC")=$$CONVERT^DGENUPL1(SEG(8))
"RTN","DGENUPLA",197,0)
 S DGPAT("DEATH")=$$CONVERT^DGENUPL1(SEG(9),"TS",.ERROR)
"RTN","DGENUPLA",198,0)
 I ERROR D  Q
"RTN","DGENUPLA",199,0)
 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 9",.ERRCOUNT)
"RTN","DGENUPLA",200,0)
 S DGELG("MEDICAID")=$$CONVERT^DGENUPL1(SEG(12))
"RTN","DGENUPLA",201,0)
 S DGELG("MEDASKDT")=$$CONVERT^DGENUPL1(SEG(13),"TS",.ERROR)
"RTN","DGENUPLA",202,0)
 I ERROR D  Q
"RTN","DGENUPLA",203,0)
 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 13",.ERRCOUNT)
"RTN","DGENUPLA",204,0)
 S DGELG("POW")=$$CONVERT^DGENUPL1(SEG(17))
"RTN","DGENUPLA",205,0)
 S DGPAT("SPININJ")=$$CONVERT^DGENUPL1(SEG(30))
"RTN","DGENUPLA",206,0)
 S ERROR=$S(DGPAT("SPININJ")="":0,",1,2,3,4,X,"[(","_DGPAT("SPININJ")_","):0,DGPAT("SPININJ")="@":0,1:1)
"RTN","DGENUPLA",207,0)
 I ERROR D  Q
"RTN","DGENUPLA",208,0)
 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 30",.ERRCOUNT)
"RTN","DGENUPLA",209,0)
 ;DG*5.3*688
"RTN","DGENUPLA",210,0)
 S DGPAT("AG/ALLY")=$$CONVERT^DGENUPL1(SEG(35),"AGENCY",.ERROR)
"RTN","DGENUPLA",211,0)
 I ERROR D
"RTN","DGENUPLA",212,0)
 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 35",.ERRCOUNT)
"RTN","DGENUPLA",213,0)
 S DGPAT("EMGRES")=$$CONVERT^DGENUPL1(SEG(40)) ;DG*5.3*677
"RTN","DGENUPLA",214,0)
 Q
"RTN","DGENUPLA",215,0)
 ;
"RTN","DGENUPLA",216,0)
SITECNV(STRING) ; Convert claim folder loc (site # or site # and name) to
"RTN","DGENUPLA",217,0)
 ; pointer to file 4
"RTN","DGENUPLA",218,0)
 N SITE
"RTN","DGENUPLA",219,0)
 S SITE=""
"RTN","DGENUPLA",220,0)
 I STRING'="" D
"RTN","DGENUPLA",221,0)
 . N SUB,START,END
"RTN","DGENUPLA",222,0)
 . ; Find site ien if only site # is returned
"RTN","DGENUPLA",223,0)
 . I $O(^DIC(4,"D",STRING,0)) S SITE=$O(^DIC(4,"D",STRING,0)) Q
"RTN","DGENUPLA",224,0)
 . ; Check if name is concatenated onto site # to find site ien
"RTN","DGENUPLA",225,0)
 . S SUB=""
"RTN","DGENUPLA",226,0)
 . F  S SUB=$O(^DIC(4,"D",SUB)) Q:SUB=""  I $E(SUB,1,3)=$E(STRING,1,3),$$CHK(SUB,STRING) S SITE=$O(^DIC(4,"D",SUB,0)) Q
"RTN","DGENUPLA",227,0)
 ; SITE is the pointer to file 4 or null for site not found
"RTN","DGENUPLA",228,0)
 Q SITE
"RTN","DGENUPLA",229,0)
 ;
"RTN","DGENUPLA",230,0)
CHK(SUB,STRING) ;
"RTN","DGENUPLA",231,0)
 N IEN,X,STN,RET
"RTN","DGENUPLA",232,0)
 I SUB=STRING Q 1
"RTN","DGENUPLA",233,0)
 S RET=0
"RTN","DGENUPLA",234,0)
 S IEN=+$O(^DIC(4,"D",SUB,""))
"RTN","DGENUPLA",235,0)
 I IEN D
"RTN","DGENUPLA",236,0)
 . S X=$P($G(^DIC(4,IEN,0)),U),STN=$P($G(^(99)),U)
"RTN","DGENUPLA",237,0)
 . ; assume institution file names will be the same on HEC and VistA
"RTN","DGENUPLA",238,0)
 . I STN=SUB,X'="",$E($P(STRING,SUB,2,999),1,40)=X S RET=1
"RTN","DGENUPLA",239,0)
 Q RET
"RTN","DGENUPLA",240,0)
 ;
"VER")
8.0^22.2
"^DD",2,2,1010.1511,0)
APPOINTMENT REQUEST DATE^Da^^1010.15;11^S %DT="EX" D ^%DT S X=Y K:Y<1 X
"^DD",2,2,1010.1511,1,0)
^.1
"^DD",2,2,1010.1511,1,1,0)
2^AENR10101511^MUMPS
"^DD",2,2,1010.1511,1,1,1)
D EVENT^IVMPLOG(DA)
"^DD",2,2,1010.1511,1,1,2)
D EVENT^IVMPLOG(DA)
"^DD",2,2,1010.1511,1,1,3)
 DO NOT DELETE
"^DD",2,2,1010.1511,1,1,"%D",0)
^.101^2^2^3050913^^^^
"^DD",2,2,1010.1511,1,1,"%D",1,0)
This cross-reference is used to notify HEC of changes that may affect
"^DD",2,2,1010.1511,1,1,"%D",2,0)
enrollment.
"^DD",2,2,1010.1511,1,1,"DT")
3050913
"^DD",2,2,1010.1511,1,2,0)
2^AEACL
"^DD",2,2,1010.1511,1,2,1)
S ^DPT("AEACL",$E(X,1,30),DA)=""
"^DD",2,2,1010.1511,1,2,2)
K ^DPT("AEACL",$E(X,1,30),DA)
"^DD",2,2,1010.1511,1,2,"%D",0)
^^1^1^3080214^
"^DD",2,2,1010.1511,1,2,"%D",1,0)
This cross reference is used for Enrollee Appt. Call List
"^DD",2,2,1010.1511,1,2,"DT")
3080214
"^DD",2,2,1010.1511,1,3,0)
^^TRIGGER^2^1010.1515
"^DD",2,2,1010.1511,1,3,1)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() X ^DD(2,1010.1511,1,3,1.4)
"^DD",2,2,1010.1511,1,3,1.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,15)=DIV,DIH=2,DIG=1010.1515 D ^DICR
"^DD",2,2,1010.1511,1,3,2)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() X ^DD(2,1010.1511,1,3,2.4)
"^DD",2,2,1010.1511,1,3,2.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,15)=DIV,DIH=2,DIG=1010.1515 D ^DICR
"^DD",2,2,1010.1511,1,3,"%D",0)
^.101^2^2^3190307^^
"^DD",2,2,1010.1511,1,3,"%D",1,0)
This cross reference TRIGGERS the APPT REQUEST 1010EZ CHG DT/TM field 
"^DD",2,2,1010.1511,1,3,"%D",2,0)
(#1010.1515) of the PATIENT file (#2).
"^DD",2,2,1010.1511,1,3,"CREATE VALUE")
S X=$$NOW^XLFDT()
"^DD",2,2,1010.1511,1,3,"DELETE VALUE")
S X=$$NOW^XLFDT()
"^DD",2,2,1010.1511,1,3,"DT")
3190228
"^DD",2,2,1010.1511,1,3,"FIELD")
APPT REQUEST 1010EZ CHG DT/TM
"^DD",2,2,1010.1511,1,4,0)
^^TRIGGER^2^1010.1513
"^DD",2,2,1010.1511,1,4,1)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,13)="" I X S X=DIV S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(2,1010.1511,1,4,1.4)
"^DD",2,2,1010.1511,1,4,1.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,13)=DIV,DIH=2,DIG=1010.1513 D ^DICR
"^DD",2,2,1010.1511,1,4,2)
Q
"^DD",2,2,1010.1511,1,4,"%D",0)
^^3^3^3190325^
"^DD",2,2,1010.1511,1,4,"%D",1,0)
This cross reference will set the current value of the APPOINTMENT 
"^DD",2,2,1010.1511,1,4,"%D",2,0)
REQUEST DATE field into the ORIGINAL APPT REQUEST DATE field (#1010.1513) 
"^DD",2,2,1010.1511,1,4,"%D",3,0)
if that field has not been set.
"^DD",2,2,1010.1511,1,4,"CREATE CONDITION")
#1010.1513=""
"^DD",2,2,1010.1511,1,4,"CREATE VALUE")
INTERNAL(#1010.1511)
"^DD",2,2,1010.1511,1,4,"DELETE VALUE")
NO EFFECT
"^DD",2,2,1010.1511,1,4,"DT")
3190325
"^DD",2,2,1010.1511,1,4,"FIELD")
#1010.1513
"^DD",2,2,1010.1511,3)
Enter date VA was notified the enrolling patient is requesting an appointment.
"^DD",2,2,1010.1511,21,0)
^.001^3^3^3190308^^
"^DD",2,2,1010.1511,21,1,0)
This field contains the date the VA was notified that an enrolling 
"^DD",2,2,1010.1511,21,2,0)
patient or newly enrolled patient request an appointment with a 
"^DD",2,2,1010.1511,21,3,0)
provider.  The request may originate from a 1010EZ or a later encounter.
"^DD",2,2,1010.1511,"AUDIT")
y
"^DD",2,2,1010.1511,"DT")
3190325
"^DD",2,2,1010.1512,0)
ORIGINAL APPOINTMENT REQUEST^SIa^0:NO;1:YES;^1010.15;12^Q
"^DD",2,2,1010.1512,1,0)
^.1
"^DD",2,2,1010.1512,1,1,0)
^^TRIGGER^2^1010.1514
"^DD",2,2,1010.1512,1,1,1)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() X ^DD(2,1010.1512,1,1,1.4)
"^DD",2,2,1010.1512,1,1,1.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,14)=DIV,DIH=2,DIG=1010.1514 D ^DICR
"^DD",2,2,1010.1512,1,1,2)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() X ^DD(2,1010.1512,1,1,2.4)
"^DD",2,2,1010.1512,1,1,2.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,14)=DIV,DIH=2,DIG=1010.1514 D ^DICR
"^DD",2,2,1010.1512,1,1,"%D",0)
^^2^2^3190301^
"^DD",2,2,1010.1512,1,1,"%D",1,0)
This cross reference TRIGGERS the ORIG APPT REQUEST CHG DT/TM field 
"^DD",2,2,1010.1512,1,1,"%D",2,0)
(#1010.1514) of the PATIENT file (#2).
"^DD",2,2,1010.1512,1,1,"CREATE VALUE")
S X=$$NOW^XLFDT()
"^DD",2,2,1010.1512,1,1,"DELETE VALUE")
S X=$$NOW^XLFDT()
"^DD",2,2,1010.1512,1,1,"FIELD")
ORIG APPT REQUEST CHG DT/TM
"^DD",2,2,1010.1512,3)
Enter 'Y' if the veteran applicant has requested an appointment with a VA doctor/provider on the patient's initial 1010EZ.
"^DD",2,2,1010.1512,5,1,0)
2^1010.159^3
"^DD",2,2,1010.1512,9)
^
"^DD",2,2,1010.1512,21,0)
^.001^4^4^3190402^^^^
"^DD",2,2,1010.1512,21,1,0)
Enter a 'Y' if the veteran applicant has requested an appointment with a 
"^DD",2,2,1010.1512,21,2,0)
VA doctor or provider and wants to be seen as soon as one becomes 
"^DD",2,2,1010.1512,21,3,0)
available. Enter a 'N' if the veteran applicant has not requested an 
"^DD",2,2,1010.1512,21,4,0)
appointment
"^DD",2,2,1010.1512,23,0)
^.001^1^1^3190402^^^^
"^DD",2,2,1010.1512,23,1,0)
This field reflects a request indicated on the patient's initial 1010EZ.
"^DD",2,2,1010.1512,"AUDIT")
y
"^DD",2,2,1010.1512,"DT")
3190402
"^DD",2,2,1010.1513,0)
ORIGINAL APPT REQUEST DATE^DIa^^1010.15;13^S %DT="E" D ^%DT S X=Y K:Y<1 X
"^DD",2,2,1010.1513,.1)
ORIGINAL APPOINTMENT REQUEST DATE
"^DD",2,2,1010.1513,1,0)
^.1
"^DD",2,2,1010.1513,1,1,0)
^^TRIGGER^2^1010.1514
"^DD",2,2,1010.1513,1,1,1)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() X ^DD(2,1010.1513,1,1,1.4)
"^DD",2,2,1010.1513,1,1,1.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,14)=DIV,DIH=2,DIG=1010.1514 D ^DICR
"^DD",2,2,1010.1513,1,1,2)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() X ^DD(2,1010.1513,1,1,2.4)
"^DD",2,2,1010.1513,1,1,2.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,14)=DIV,DIH=2,DIG=1010.1514 D ^DICR
"^DD",2,2,1010.1513,1,1,"%D",0)
^^2^2^3190301^
"^DD",2,2,1010.1513,1,1,"%D",1,0)
This cross reference TRIGGERS the ORIG APPT REQUEST CHG DT/TM field 
"^DD",2,2,1010.1513,1,1,"%D",2,0)
(#1010.1514) of the PATIENT file (#2).
"^DD",2,2,1010.1513,1,1,"CREATE VALUE")
S X=$$NOW^XLFDT()
"^DD",2,2,1010.1513,1,1,"DELETE VALUE")
S X=$$NOW^XLFDT()
"^DD",2,2,1010.1513,1,1,"FIELD")
ORIG APPT REQUEST CHG DT/TM
"^DD",2,2,1010.1513,3)
Enter the first date the VA was notified that the enrolling patient requested an appointment.
"^DD",2,2,1010.1513,5,1,0)
2^1010.1511^4
"^DD",2,2,1010.1513,9)
^
"^DD",2,2,1010.1513,21,0)
^^3^3^3190301^
"^DD",2,2,1010.1513,21,1,0)
This field contains the date the VA enrolling a patient for the first 
"^DD",2,2,1010.1513,21,2,0)
time was notified the patient is requesting an appointment with a 
"^DD",2,2,1010.1513,21,3,0)
provider.
"^DD",2,2,1010.1513,"AUDIT")
y
"^DD",2,2,1010.1513,"DT")
3190305
"^DD",2,2,1010.1514,0)
ORIG APPT REQUEST CHG DT/TM^DI^^1010.15;14^S %DT="E" D ^%DT S X=Y K:Y<1 X
"^DD",2,2,1010.1514,.1)
ORIGINAL APPOINTMENT REQUEST LAST UPDATE DATETIME
"^DD",2,2,1010.1514,3)
Enter the date and time the APPOINTMENT REQUEST ON 1010EZ field was modified. It is used to verify that the most recent update is stored in VistA REE.
"^DD",2,2,1010.1514,5,1,0)
2^1010.1512^1
"^DD",2,2,1010.1514,5,2,0)
2^1010.1513^1
"^DD",2,2,1010.1514,21,0)
^.001^9^9^3190304^^
"^DD",2,2,1010.1514,21,1,0)
ORIGINAL APPOINTMENT REQUEST LAST UPDATE DATETIME will be used to compare 
"^DD",2,2,1010.1514,21,2,0)
incoming HL7 change message's datetime stamp to, if populated, what is 
"^DD",2,2,1010.1514,21,3,0)
stored in VistA REE's database. The database will not be updated if the 
"^DD",2,2,1010.1514,21,4,0)
incoming HL7 message is older than what is currently stored. The message 
"^DD",2,2,1010.1514,21,5,0)
will be rejected if it is not more recent than what is stored in VistA 
"^DD",2,2,1010.1514,21,6,0)
REE. 
"^DD",2,2,1010.1514,21,7,0)
 
"^DD",2,2,1010.1514,21,8,0)
It is an 'display only' field and is not editable by the VistA user and 
"^DD",2,2,1010.1514,21,9,0)
is used for data verification only.
"^DD",2,2,1010.1514,"DT")
3190311
"^DD",2,2,1010.1515,0)
APPT REQUEST 1010EZ CHG DT/TM^DI^^1010.15;15^S %DT="E" D ^%DT S X=Y K:Y<1 X
"^DD",2,2,1010.1515,.1)
APPOINTMENT REQUEST ON 1010EZ LAST CHANGE DATETIME
"^DD",2,2,1010.1515,3)
Enter the date and time the APPOINTMENT REQUEST ON 1010EZ field was modified. It is used to verify that the most recent update is stored in VistA REE.
"^DD",2,2,1010.1515,5,1,0)
2^1010.159^2
"^DD",2,2,1010.1515,5,2,0)
2^1010.1511^3
"^DD",2,2,1010.1515,21,0)
^.001^8^8^3190304^^
"^DD",2,2,1010.1515,21,1,0)
It will be used to compare incoming HL7 change message's datetime stamp 
"^DD",2,2,1010.1515,21,2,0)
to, if populated, what is stored in VistA REE's database. The database 
"^DD",2,2,1010.1515,21,3,0)
will not be updated if the incoming HL7 message is older than what is 
"^DD",2,2,1010.1515,21,4,0)
currently stored. The message will be rejected if it is not more recent 
"^DD",2,2,1010.1515,21,5,0)
than what is stored in VistA REE. 
"^DD",2,2,1010.1515,21,6,0)
 
"^DD",2,2,1010.1515,21,7,0)
It is an 'display only' field and is not editable by the VistA user and 
"^DD",2,2,1010.1515,21,8,0)
is used for data verification only.
"^DD",2,2,1010.1515,"DT")
3190311
"^DD",2,2,1010.159,0)
APPOINTMENT REQUEST ON 1010EZ^Sa^0:NO;1:YES;^1010.15;9^Q
"^DD",2,2,1010.159,.1)
Do you want an appt. with a VA doctor/provider as soon as available?
"^DD",2,2,1010.159,1,0)
^.1^^-1
"^DD",2,2,1010.159,1,1,0)
2^AENR1010159^MUMPS
"^DD",2,2,1010.159,1,1,1)
D EVENT^IVMPLOG(DA)
"^DD",2,2,1010.159,1,1,2)
D EVENT^IVMPLOG(DA)
"^DD",2,2,1010.159,1,1,3)
 DO NOT DELETE
"^DD",2,2,1010.159,1,1,"%D",0)
^.101^2^2^3050627^^^^
"^DD",2,2,1010.159,1,1,"%D",1,0)
This cross-reference is used to notify HEC of changes that may affect
"^DD",2,2,1010.159,1,1,"%D",2,0)
enrollment.
"^DD",2,2,1010.159,1,1,"DT")
3050627
"^DD",2,2,1010.159,1,2,0)
^^TRIGGER^2^1010.1515
"^DD",2,2,1010.159,1,2,1)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() X ^DD(2,1010.159,1,2,1.4)
"^DD",2,2,1010.159,1,2,1.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,15)=DIV,DIH=2,DIG=1010.1515 D ^DICR
"^DD",2,2,1010.159,1,2,2)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() X ^DD(2,1010.159,1,2,2.4)
"^DD",2,2,1010.159,1,2,2.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,15)=DIV,DIH=2,DIG=1010.1515 D ^DICR
"^DD",2,2,1010.159,1,2,"%D",0)
^.101^2^2^3190301^^
"^DD",2,2,1010.159,1,2,"%D",1,0)
This cross references TRIGGERS the APPT REQUEST 1010EZ CHG DT/TM field 
"^DD",2,2,1010.159,1,2,"%D",2,0)
(#1010.1515) of the PATIENT file (#2).
"^DD",2,2,1010.159,1,2,"CREATE VALUE")
S X=$$NOW^XLFDT()
"^DD",2,2,1010.159,1,2,"DELETE VALUE")
S X=$$NOW^XLFDT()
"^DD",2,2,1010.159,1,2,"DT")
3190228
"^DD",2,2,1010.159,1,2,"FIELD")
APPT REQUEST 1010EZ CHG DT/TM
"^DD",2,2,1010.159,1,3,0)
^^TRIGGER^2^1010.1512
"^DD",2,2,1010.159,1,3,1)
X ^DD(2,1010.159,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(2,1010.159,1,3,1.4)
"^DD",2,2,1010.159,1,3,1.3)
K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(2)=$C(59)_$P($G(^DD(2,1010.1512,0)),U,3),Y(1)=$S($D(^DPT(D0,1010.15)):^(1010.15),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,12)_":",2),$C(59))=""
"^DD",2,2,1010.159,1,3,1.4)
S DIH=$G(^DPT(DIV(0),1010.15)),DIV=X S $P(^(1010.15),U,12)=DIV,DIH=2,DIG=1010.1512 D ^DICR
"^DD",2,2,1010.159,1,3,2)
Q
"^DD",2,2,1010.159,1,3,"%D",0)
^^3^3^3190312^
"^DD",2,2,1010.159,1,3,"%D",1,0)
This cross reference will set the current value of the APPOINTMENT REQUEST
"^DD",2,2,1010.159,1,3,"%D",2,0)
ON 1010EZ field into the ORIGINAL APPOINTMENT REQUEST field (#1010.1512) 
"^DD",2,2,1010.159,1,3,"%D",3,0)
if that field has not been set.
"^DD",2,2,1010.159,1,3,"CREATE CONDITION")
#1010.1512=""
"^DD",2,2,1010.159,1,3,"CREATE VALUE")
INTERNAL(#1010.159)
"^DD",2,2,1010.159,1,3,"DELETE VALUE")
NO EFFECT
"^DD",2,2,1010.159,1,3,"DT")
3190307
"^DD",2,2,1010.159,1,3,"FIELD")
#1010.1512
"^DD",2,2,1010.159,3)
Enter 'Y' if the Veteran applicant has requested an appointment with a VA doctor/provider.
"^DD",2,2,1010.159,4)

"^DD",2,2,1010.159,21,0)
^.001^7^7^3190308^^^^
"^DD",2,2,1010.159,21,1,0)
Enter a 'Y' if the Veteran applicant has requested an appointment with a
"^DD",2,2,1010.159,21,2,0)
VA doctor or provider and wants to be seen as soon as one becomes
"^DD",2,2,1010.159,21,3,0)
available.  Enter a 'N' if the Veteran applicant has not requested an
"^DD",2,2,1010.159,21,4,0)
appointment.
"^DD",2,2,1010.159,21,5,0)
 
"^DD",2,2,1010.159,21,6,0)
This question may only be entered once for the Veteran if the initial 
"^DD",2,2,1010.159,21,7,0)
entry is Yes.
"^DD",2,2,1010.159,23,0)
^.001^2^2^3190308^^^^
"^DD",2,2,1010.159,23,1,0)
This field reflects a request indicated on the patient's initial 
"^DD",2,2,1010.159,23,2,0)
1010EZ or at a later encounter.
"^DD",2,2,1010.159,"AUDIT")
y
"^DD",2,2,1010.159,"DT")
3190308
**INSTALL NAME**
IVM*2.0*180
"BLD",10921,0)
IVM*2.0*180^INCOME VERIFICATION MATCH^0^3190621^y
"BLD",10921,1,0)
^^2^2^3190319^
"BLD",10921,1,1,0)
Please see the IVM*2.0*180 patch description for detailed information 
"BLD",10921,1,2,0)
regarding this patch.
"BLD",10921,4,0)
^9.64PA^^
"BLD",10921,6.3)
16
"BLD",10921,"ABPKG")
n
"BLD",10921,"KRN",0)
^9.67PA^779.2^20
"BLD",10921,"KRN",.4,0)
.4
"BLD",10921,"KRN",.401,0)
.401
"BLD",10921,"KRN",.402,0)
.402
"BLD",10921,"KRN",.403,0)
.403
"BLD",10921,"KRN",.5,0)
.5
"BLD",10921,"KRN",.84,0)
.84
"BLD",10921,"KRN",3.6,0)
3.6
"BLD",10921,"KRN",3.8,0)
3.8
"BLD",10921,"KRN",9.2,0)
9.2
"BLD",10921,"KRN",9.8,0)
9.8
"BLD",10921,"KRN",9.8,"NM",0)
^9.68A^1^1
"BLD",10921,"KRN",9.8,"NM",1,0)
IVMPTRN9^^0^B55375213
"BLD",10921,"KRN",9.8,"NM","B","IVMPTRN9",1)

"BLD",10921,"KRN",19,0)
19
"BLD",10921,"KRN",19,"NM",0)
^9.68A^^
"BLD",10921,"KRN",19.1,0)
19.1
"BLD",10921,"KRN",101,0)
101
"BLD",10921,"KRN",409.61,0)
409.61
"BLD",10921,"KRN",771,0)
771
"BLD",10921,"KRN",779.2,0)
779.2
"BLD",10921,"KRN",870,0)
870
"BLD",10921,"KRN",8989.51,0)
8989.51
"BLD",10921,"KRN",8989.52,0)
8989.52
"BLD",10921,"KRN",8994,0)
8994
"BLD",10921,"KRN","B",.4,.4)

"BLD",10921,"KRN","B",.401,.401)

"BLD",10921,"KRN","B",.402,.402)

"BLD",10921,"KRN","B",.403,.403)

"BLD",10921,"KRN","B",.5,.5)

"BLD",10921,"KRN","B",.84,.84)

"BLD",10921,"KRN","B",3.6,3.6)

"BLD",10921,"KRN","B",3.8,3.8)

"BLD",10921,"KRN","B",9.2,9.2)

"BLD",10921,"KRN","B",9.8,9.8)

"BLD",10921,"KRN","B",19,19)

"BLD",10921,"KRN","B",19.1,19.1)

"BLD",10921,"KRN","B",101,101)

"BLD",10921,"KRN","B",409.61,409.61)

"BLD",10921,"KRN","B",771,771)

"BLD",10921,"KRN","B",779.2,779.2)

"BLD",10921,"KRN","B",870,870)

"BLD",10921,"KRN","B",8989.51,8989.51)

"BLD",10921,"KRN","B",8989.52,8989.52)

"BLD",10921,"KRN","B",8994,8994)

"BLD",10921,"QDEF")
^^^^NO^^^^NO^^YES
"BLD",10921,"QUES",0)
^9.62^^
"BLD",10921,"REQB",0)
^9.611^1^1
"BLD",10921,"REQB",1,0)
IVM*2.0*164^1
"BLD",10921,"REQB","B","IVM*2.0*164",1)

"MBREQ")
0
"PKG",120,-1)
1^1
"PKG",120,0)
INCOME VERIFICATION MATCH^IVM^IVM Software for interface with the IVM Center
"PKG",120,20,0)
^9.402P^^
"PKG",120,22,0)
^9.49I^1^1
"PKG",120,22,1,0)
2.0^2941021^2960823
"PKG",120,22,1,"PAH",1,0)
180^3190621
"PKG",120,22,1,"PAH",1,1,0)
^^2^2^3190621
"PKG",120,22,1,"PAH",1,1,1,0)
Please see the IVM*2.0*180 patch description for detailed information 
"PKG",120,22,1,"PAH",1,1,2,0)
regarding this patch.
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
YES
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
1
"RTN","IVMPTRN9")
0^1^B55375213
"RTN","IVMPTRN9",1,0)
IVMPTRN9 ;ALB/KCL,CN,BRM,TDM,EG,LBD,TGH,KUM,JAM - HL7 FULL DATA TRANSMISSION (Z07) BUILDER (CONTINUED) ;12/7/12 2:56pm
"RTN","IVMPTRN9",2,0)
 ;;2.0;INCOME VERIFICATION MATCH;**9,11,19,12,21,17,46,50,53,34,49,58,79,99,116,105,115,152,160,164,180**;21-OCT-94;Build 16
"RTN","IVMPTRN9",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","IVMPTRN9",4,0)
 ;
"RTN","IVMPTRN9",5,0)
 ;
"RTN","IVMPTRN9",6,0)
GOTO ; place to break up the routine
"RTN","IVMPTRN9",7,0)
 ;
"RTN","IVMPTRN9",8,0)
 ; create (ZIO) Inpatient/Outpatient segment for veteran
"RTN","IVMPTRN9",9,0)
 S N101015=$G(^DPT(DFN,1010.15))
"RTN","IVMPTRN9",10,0)
 S ZIOSEG="ZIO^1^"_$$EN^IVMUFNC1(DFN,IVMMTDT,.IVMQUERY)  ;seq 1-3
"RTN","IVMPTRN9",11,0)
 S ZIOSEG=ZIOSEG_"^"_$$LTD^IVMUFNC(DFN,.IVMQUERY)        ;seq 4
"RTN","IVMPTRN9",12,0)
 S X=$P(N101015,"^",9),$P(ZIOSEG,U,6)=$S(X=0:"N",X=1:"Y",1:HLQ)   ;Appt Request
"RTN","IVMPTRN9",13,0)
 S X=$P(N101015,"^",11),$P(ZIOSEG,U,7)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ) ;Appt Request Date
"RTN","IVMPTRN9",14,0)
 ; jam ; IVM*2.0*180 - add seq 7, field 1010.1515 - Appt Request Change DT/TM
"RTN","IVMPTRN9",15,0)
 S X=$P(N101015,"^",15),$P(ZIOSEG,U,8)=$S(X]"":$$HLDATE^HLFNC(X,"TS"),1:HLQ)
"RTN","IVMPTRN9",16,0)
 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=ZIOSEG
"RTN","IVMPTRN9",17,0)
 ;
"RTN","IVMPTRN9",18,0)
 ; create (NTE) Notes and Comments segment
"RTN","IVMPTRN9",19,0)
 D NTE^IVMUFNC4(DFN,.IVMNTE,IVMMTDT)
"RTN","IVMPTRN9",20,0)
 I '$D(IVMNTE) D
"RTN","IVMPTRN9",21,0)
 . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)="NTE^1"
"RTN","IVMPTRN9",22,0)
 I $D(IVMNTE) D
"RTN","IVMPTRN9",23,0)
 . ; - get notes and comments
"RTN","IVMPTRN9",24,0)
 . F IVMSUB=0:0 S IVMSUB=$O(IVMNTE(IVMSUB)) Q:'IVMSUB  D
"RTN","IVMPTRN9",25,0)
 . . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMNTE(IVMSUB)
"RTN","IVMPTRN9",26,0)
 ;
"RTN","IVMPTRN9",27,0)
 ; create (IN1) Insurance segment(s) for all active insurance
"RTN","IVMPTRN9",28,0)
 K ^TMP("VAFIN1",$J)
"RTN","IVMPTRN9",29,0)
 D EN^VAFHLIN1(DFN,"1,4,5,7,8,9,12,13,15,16,17,28,36")
"RTN","IVMPTRN9",30,0)
 F IVMSUB=0:0 S IVMSUB=$O(^TMP("VAFIN1",$J,IVMSUB)) Q:'IVMSUB  D
"RTN","IVMPTRN9",31,0)
 . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=^TMP("VAFIN1",$J,+IVMSUB,0)
"RTN","IVMPTRN9",32,0)
 ;
"RTN","IVMPTRN9",33,0)
 ;find if the deletion flags were set in the IVM Patient file, and if so, should the deletion indicators be sent?
"RTN","IVMPTRN9",34,0)
 F I="RX","MT","HARDSHIP","DATE OF TEST","LTC" S DELETE(I)=""
"RTN","IVMPTRN9",35,0)
 S IVMPIEN=$$FIND^IVMPLOG(DFN,($E(IVMMTDT,1,3)-1))
"RTN","IVMPTRN9",36,0)
 I IVMPIEN D
"RTN","IVMPTRN9",37,0)
 . S IVMPNODE=$G(^IVM(301.5,IVMPIEN,0))
"RTN","IVMPTRN9",38,0)
 . I $P(IVMPNODE,"^",8)!$P(IVMPNODE,"^",9)!$P(IVMPNODE,"^",10)!$P(IVMPNODE,"^",11) S DELETE("SET")=1
"RTN","IVMPTRN9",39,0)
 . ;was the MT deletion flag set, and if so verify that there is no completed MT
"RTN","IVMPTRN9",40,0)
 . I $P(IVMPNODE,"^",8),(TESTTYPE'=1)!(TESTCODE="")!("ACGP"'[TESTCODE) S DELETE("DATE OF TEST")=$P(IVMPNODE,"^",8),DELETE("MT")=1
"RTN","IVMPTRN9",41,0)
 . ;
"RTN","IVMPTRN9",42,0)
 . ;was the hardship deletion flag set, and if so verify that there is no completed hardship
"RTN","IVMPTRN9",43,0)
 . I $P(IVMPNODE,"^",10),'HARDSHIP D
"RTN","IVMPTRN9",44,0)
 . . S:('DELETE("DATE OF TEST")) DELETE("DATE OF TEST")=$P(IVMPNODE,"^",10)
"RTN","IVMPTRN9",45,0)
 . . S DELETE("HARDSHIP")=1
"RTN","IVMPTRN9",46,0)
 ;
"RTN","IVMPTRN9",47,0)
 ; create (ZMT) Means Test segment 
"RTN","IVMPTRN9",48,0)
 ;
"RTN","IVMPTRN9",49,0)
 S SEQS=$S(TESTTYPE=1:"1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,21,22,23,24,25,26,28,29,30,31",1:"1,17")  ;IVM*2.0*160
"RTN","IVMPTRN9",50,0)
 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^IVMCZMT(DFN,SEQS,IVMMTDT,1,1,.DELETE,1)
"RTN","IVMPTRN9",51,0)
 ;
"RTN","IVMPTRN9",52,0)
 ; create (ZMT) Rx-Copay Test segment
"RTN","IVMPTRN9",53,0)
 I IVMPIEN D
"RTN","IVMPTRN9",54,0)
 . ;was the RX deletion flag set, and if so verify that there is no completed test
"RTN","IVMPTRN9",55,0)
 . I $P(IVMPNODE,"^",9),(TESTTYPE'=2)!(TESTCODE="")!("EM"'[TESTCODE) S DELETE("DATE OF TEST")=$P(IVMPNODE,"^",9),DELETE("RX")=1
"RTN","IVMPTRN9",56,0)
 ;
"RTN","IVMPTRN9",57,0)
 N IVMCPDT,CPTST,LINK,CPDATE
"RTN","IVMPTRN9",58,0)
 ;should be ok to get the last co-pay test for this year vs. looking from the IVMMTDT backwards
"RTN","IVMPTRN9",59,0)
 ;as long as the means test date is in the current year
"RTN","IVMPTRN9",60,0)
 S CPTST=$$LST^DGMTU(DFN,$E(IVMIY,1,3)+1_1231,2)
"RTN","IVMPTRN9",61,0)
 I CPTST D
"RTN","IVMPTRN9",62,0)
 . S CPDATE=$P(CPTST,U,2)
"RTN","IVMPTRN9",63,0)
 . S LINK=$P($G(^DGMT(408.31,+CPTST,2)),U,6)
"RTN","IVMPTRN9",64,0)
 . I TESTTYPE=1,$E(CPDATE,1,3)=$E(IVMMTDT,1,3) D
"RTN","IVMPTRN9",65,0)
 . . ;if you have a means test and a linked co-pay test then send both (the means test
"RTN","IVMPTRN9",66,0)
 . . ;was already sent from above)
"RTN","IVMPTRN9",67,0)
 . . ;if means and copay are not linked, don't send the co-pay test (the means test
"RTN","IVMPTRN9",68,0)
 . . ;was already sent from above)
"RTN","IVMPTRN9",69,0)
 . . I LINK=+$$LST^DGMTU(DFN,IVMMTDT,1) S TESTTYPE=2,(IVMCPDT,IVMMTDT)=CPDATE
"RTN","IVMPTRN9",70,0)
 . . Q
"RTN","IVMPTRN9",71,0)
 . Q
"RTN","IVMPTRN9",72,0)
 ;always send the 2nd ZMT segment
"RTN","IVMPTRN9",73,0)
 S SEQS="1,17"
"RTN","IVMPTRN9",74,0)
 ;can also send a co-pay test if there is no means test (see module GETTYPE)
"RTN","IVMPTRN9",75,0)
 I TESTTYPE=2 D
"RTN","IVMPTRN9",76,0)
 . S SEQS="1,2,3,4,5,6,7,9,10,12,15,16,17,18,21,22,25,26,30,31"  ;IVM*2.0*160
"RTN","IVMPTRN9",77,0)
 . Q
"RTN","IVMPTRN9",78,0)
 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^IVMCZMT(DFN,SEQS,IVMMTDT,2,2,.DELETE,1)
"RTN","IVMPTRN9",79,0)
 ;
"RTN","IVMPTRN9",80,0)
 ; create (ZMT) Long Term Care Copay Exemption Test segment
"RTN","IVMPTRN9",81,0)
 I IVMPIEN D
"RTN","IVMPTRN9",82,0)
 . ; set deletion indicators if LTC test deletion should be transmitted
"RTN","IVMPTRN9",83,0)
 . I $P(IVMPNODE,"^",11) S DELETE("LTC")=1 S:('DELETE("DATE OF TEST")) DELETE("DATE OF TEST")=$P(IVMPNODE,"^",11)
"RTN","IVMPTRN9",84,0)
 ;
"RTN","IVMPTRN9",85,0)
 S SEQS="1,2,3,4,5,7,9,10,12,16,17,18,22,25,30,31"  ;IVM*2.0*160
"RTN","IVMPTRN9",86,0)
 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^IVMCZMT(DFN,SEQS,IVMMTDT,4,4,.DELETE,1)
"RTN","IVMPTRN9",87,0)
 ;
"RTN","IVMPTRN9",88,0)
 ;if the deletion flags were set in the IVM Patient file, unset them
"RTN","IVMPTRN9",89,0)
 I $G(DELETE("SET")) D
"RTN","IVMPTRN9",90,0)
 . N DATA
"RTN","IVMPTRN9",91,0)
 . S DATA(.08)="",DATA(.09)="",DATA(.1)="",DATA(.11)=""
"RTN","IVMPTRN9",92,0)
 . I $$UPD^DGENDBS(301.5,IVMPIEN,.DATA)
"RTN","IVMPTRN9",93,0)
 ;
"RTN","IVMPTRN9",94,0)
 ; create (ZBT) Beneficiary Travel segment based on last BT Claim
"RTN","IVMPTRN9",95,0)
 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZBT($$BTCLM^IVMUFNC4(DFN),"1,2,3,4,7")
"RTN","IVMPTRN9",96,0)
 ;
"RTN","IVMPTRN9",97,0)
 ; create (ZFE) Fee Basis segment(s)
"RTN","IVMPTRN9",98,0)
 D EN^FBHLZFE(DFN,"1,2,3,4,5")
"RTN","IVMPTRN9",99,0)
 F IVMSUB=0:0 S IVMSUB=+$O(FBZFE(IVMSUB)) Q:'IVMSUB  D
"RTN","IVMPTRN9",100,0)
 . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(FBZFE(+IVMSUB))
"RTN","IVMPTRN9",101,0)
 ;
"RTN","IVMPTRN9",102,0)
 ; create (ZSP) Service Period segment
"RTN","IVMPTRN9",103,0)
 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZSP(DFN,1,1)
"RTN","IVMPTRN9",104,0)
 ;
"RTN","IVMPTRN9",105,0)
 ; optionally create (OBX) segment for Patient Sensitivity Flag
"RTN","IVMPTRN9",106,0)
 K OBXTMP
"RTN","IVMPTRN9",107,0)
 S OBXCNT=0,GETCUR=$$FINDSEC^DGENSEC(DFN)
"RTN","IVMPTRN9",108,0)
 I GETCUR,$$GET^DGENSEC(GETCUR,.DGSEC) D
"RTN","IVMPTRN9",109,0)
 . Q:(DGSEC("LEVEL")'=1)&(DGSEC("LEVEL")'=0)
"RTN","IVMPTRN9",110,0)
 . S OBXTMP(2)="CE",OBXTMP(3)="38.1"_$E(HL("ECH"))_"SECURITY LOG"
"RTN","IVMPTRN9",111,0)
 . S:DGSEC("LEVEL") OBXTMP(5)="Y"_$E(HL("ECH"))_"YES"_$E(HL("ECH"))_"HL70136"
"RTN","IVMPTRN9",112,0)
 . S:'DGSEC("LEVEL") OBXTMP(5)="N"_$E(HL("ECH"))_"NO"_$E(HL("ECH"))_"HL70136"
"RTN","IVMPTRN9",113,0)
 . S OBXTMP(11)="R",OBXTMP(14)=DGSEC("DATETIME")
"RTN","IVMPTRN9",114,0)
 . S OBXTMP(16)="" I $G(DGSEC("SOURCE"))'="" D
"RTN","IVMPTRN9",115,0)
 . . S $P(OBXTMP(16),$E(HL("ECH")),14)=$E(HL("ECH"),4)_DGSEC("SOURCE")
"RTN","IVMPTRN9",116,0)
 . S IVMCT=IVMCT+1,OBXCNT=OBXCNT+1
"RTN","IVMPTRN9",117,0)
 . S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLOBX(.OBXTMP,OBXCNT,"2,3,5,11,14,16")
"RTN","IVMPTRN9",118,0)
 . I $G(OBXTMP(16))'="" S $P(^TMP("HLS",$J,IVMCT),"^",17)=$G(OBXTMP(16))
"RTN","IVMPTRN9",119,0)
 ;
"RTN","IVMPTRN9",120,0)
 ; create (OBX) segment for NTR
"RTN","IVMPTRN9",121,0)
 ; CALL PIMS API TO GET NTRARRY OF NTR DATA
"RTN","IVMPTRN9",122,0)
 S GETCUR=$$ENRGET^DGNTAPI1(DFN)
"RTN","IVMPTRN9",123,0)
 I GETCUR D NTROBX^IVMPTRNA(.DGNTARR)
"RTN","IVMPTRN9",124,0)
 I $D(NTROBX) D
"RTN","IVMPTRN9",125,0)
 . S IVMCT=IVMCT+1,OBXCNT=OBXCNT+1
"RTN","IVMPTRN9",126,0)
 . S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLOBX(.NTROBX,OBXCNT,"2,3,5,11,12,14,15,16,17")
"RTN","IVMPTRN9",127,0)
 . I $G(NTROBX(16))'="" S $P(^TMP("HLS",$J,IVMCT),"^",17)=$G(NTROBX(16))
"RTN","IVMPTRN9",128,0)
 . K NTROBX
"RTN","IVMPTRN9",129,0)
 ;
"RTN","IVMPTRN9",130,0)
 ; create (RF1) segment
"RTN","IVMPTRN9",131,0)
 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$RF1^IVMPTRNA(DFN,"SAD")
"RTN","IVMPTRN9",132,0)
 ; IVM*2.0*164 - Add Residential Address Change
"RTN","IVMPTRN9",133,0)
 F RF1TYP="CAD","CPH","PNO","EAD","PHH","RAD" D   ;Create Optional RF1 Segments
"RTN","IVMPTRN9",134,0)
 . S RF1SEG=$$RF1^IVMPTRNA(DFN,RF1TYP) Q:RF1SEG=""
"RTN","IVMPTRN9",135,0)
 . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=RF1SEG
"RTN","IVMPTRN9",136,0)
 ;
"RTN","IVMPTRN9",137,0)
 Q
"RTN","IVMPTRN9",138,0)
 ;
"RTN","IVMPTRN9",139,0)
GETTYPE(DFN,IVMMTDT,CODE,HARDSHIP,ACTVIEN)      ;
"RTN","IVMPTRN9",140,0)
 ;Determines the type of test to include in the Z10.  HEC wants only the
"RTN","IVMPTRN9",141,0)
 ;test that they would consider primary,i.e., preference given to a comptleted means test, even if not currently in effect.
"RTN","IVMPTRN9",142,0)
 ;
"RTN","IVMPTRN9",143,0)
 ;Input:
"RTN","IVMPTRN9",144,0)
 ;  DFN
"RTN","IVMPTRN9",145,0)
 ;  IVMMTDT -date to be the search for the test
"RTN","IVMPTRN9",146,0)
 ;Output:
"RTN","IVMPTRN9",147,0)
 ;  Function value - type of test to send in Z10
"RTN","IVMPTRN9",148,0)
 ;  CODE - status code of test (pass by reference)
"RTN","IVMPTRN9",149,0)
 ;  HARDSHIP - hardship indicator (pass by reference)
"RTN","IVMPTRN9",150,0)
 ;  ACTVIEN - ien of test that should have the associated Income Relations (pass by reference)
"RTN","IVMPTRN9",151,0)
 ;
"RTN","IVMPTRN9",152,0)
 N TESTTYPE,MTNODE,RXNODE,NODE0,NODE2
"RTN","IVMPTRN9",153,0)
 S TESTTYPE=1
"RTN","IVMPTRN9",154,0)
 S (HARDSHIP,CODE,ACTVIEN)=""
"RTN","IVMPTRN9",155,0)
 Q:'$G(IVMMTDT) TESTTYPE
"RTN","IVMPTRN9",156,0)
 Q:'$G(DFN) TESTTYPE
"RTN","IVMPTRN9",157,0)
 ;
"RTN","IVMPTRN9",158,0)
 S MTNODE=$$LST^DGMTU(DFN,IVMMTDT,1) I $E($P(MTNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S MTNODE=""
"RTN","IVMPTRN9",159,0)
 S RXNODE=$$LST^DGMTU(DFN,IVMMTDT,2) I $E($P(RXNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S RXNODE=""
"RTN","IVMPTRN9",160,0)
 ;
"RTN","IVMPTRN9",161,0)
 I MTNODE="" S MTNODE=$$FUT^DGMTU(DFN,"",1) I $E($P(MTNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S MTNODE=""
"RTN","IVMPTRN9",162,0)
 I RXNODE="" S RXNODE=$$FUT^DGMTU(DFN,"",2) I $E($P(RXNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S RXNODE=""
"RTN","IVMPTRN9",163,0)
 D
"RTN","IVMPTRN9",164,0)
 . ;determine which test has the associated income relations
"RTN","IVMPTRN9",165,0)
 . ;
"RTN","IVMPTRN9",166,0)
 . I +MTNODE S CODE=$P(MTNODE,"^",4) I CODE'="",("ACGPR"[CODE) S ACTVIEN=+MTNODE Q
"RTN","IVMPTRN9",167,0)
 . I +RXNODE S CODE=$P(RXNODE,"^",4) I CODE'="",("EMI"[CODE) S ACTVIEN=+RXNODE Q
"RTN","IVMPTRN9",168,0)
 . I +MTNODE S ACTVIEN=+MTNODE Q
"RTN","IVMPTRN9",169,0)
 . I +RXNODE S ACTVIEN=+RXNODE Q
"RTN","IVMPTRN9",170,0)
 I ACTVIEN,+MTNODE,+RXNODE D TRANSFER^DGMTU4(DFN,$S((ACTVIEN=+MTNODE):+RXNODE,1:+MTNODE),ACTVIEN)
"RTN","IVMPTRN9",171,0)
 ;
"RTN","IVMPTRN9",172,0)
 ;now find the primary test
"RTN","IVMPTRN9",173,0)
 I '(+MTNODE) G CHKCOPAY
"RTN","IVMPTRN9",174,0)
 S CODE=$P(MTNODE,"^",4)
"RTN","IVMPTRN9",175,0)
 S HARDSHIP=$P($G(^DGMT(408.31,+MTNODE,0)),"^",20)
"RTN","IVMPTRN9",176,0)
 I (CODE="")!("ACGP"'[CODE) S NODE2=$G(^DGMT(408.31,+MTNODE,2)),CODE=$$GETCODE^DGMTH($P(NODE2,"^",3)) I (CODE="")!("ACGP"'[CODE) G CHKCOPAY
"RTN","IVMPTRN9",177,0)
 ;
"RTN","IVMPTRN9",178,0)
 G QGETTYPE
"RTN","IVMPTRN9",179,0)
 ;
"RTN","IVMPTRN9",180,0)
CHKCOPAY        ;
"RTN","IVMPTRN9",181,0)
 I '(+RXNODE) G QGETTYPE
"RTN","IVMPTRN9",182,0)
 S CODE=$P(RXNODE,"^",4)
"RTN","IVMPTRN9",183,0)
 I (CODE="")!("EM"'[CODE) S NODE2=$G(^DGMT(408.31,+RXNODE,2)),CODE=$$GETCODE^DGMTH($P(NODE2,"^",3)) I (CODE="")!("EM"'[CODE) G QGETTYPE
"RTN","IVMPTRN9",184,0)
 S TESTTYPE=2
"RTN","IVMPTRN9",185,0)
 ;
"RTN","IVMPTRN9",186,0)
QGETTYPE        ;
"RTN","IVMPTRN9",187,0)
 Q TESTTYPE
"RTN","IVMPTRN9",188,0)
 ;
"RTN","IVMPTRN9",189,0)
FILTER(DFN)     ; address transmission filter
"RTN","IVMPTRN9",190,0)
 ; Check Bad Address Indicator for a known bad address and
"RTN","IVMPTRN9",191,0)
 ; Scrutinize the Street Address line 1 field for known bad address
"RTN","IVMPTRN9",192,0)
 ; strings based on functionality currently in place in HEC Legacy.
"RTN","IVMPTRN9",193,0)
 ;
"RTN","IVMPTRN9",194,0)
 ;  Input: DFN - ien of the Patient (#2) file
"RTN","IVMPTRN9",195,0)
 ; Output:   0 - filter passed (ok to transmit address)
"RTN","IVMPTRN9",196,0)
 ;           1 - filter failed (do not transmit address)
"RTN","IVMPTRN9",197,0)
 ;
"RTN","IVMPTRN9",198,0)
 N VAPA
"RTN","IVMPTRN9",199,0)
 Q:'$G(DFN) 1  ;DFN missing
"RTN","IVMPTRN9",200,0)
 Q:$$BADADR^DGUTL3(DFN) 1  ;check Bad Address Indicator
"RTN","IVMPTRN9",201,0)
 D ADD^VADPT  ;get patient address
"RTN","IVMPTRN9",202,0)
 ; Street Address Line 1 or Zip Code is <null>
"RTN","IVMPTRN9",203,0)
 Q:($G(VAPA(1))="")!($P($G(VAPA(11)),"^")="") 1
"RTN","IVMPTRN9",204,0)
 ; St Addr Line 1 contains 'UNKNOWN', 'HOMELESS', or 'ADDRESS'
"RTN","IVMPTRN9",205,0)
 Q:(VAPA(1)["UNKNOWN")!(VAPA(1)["HOMELESS")!(VAPA(1)["ADDRESS") 1
"RTN","IVMPTRN9",206,0)
 ; The first two characters of the address is equal to '**'
"RTN","IVMPTRN9",207,0)
 Q:$E(VAPA(1),1,2)="**" 1
"RTN","IVMPTRN9",208,0)
 ; passed all address filters - ok to send
"RTN","IVMPTRN9",209,0)
 Q 0
"VER")
8.0^22.2
**END**
**END**