Released DG*5.3*632 SEQ #550 Extracted from mail message **KIDS**:DG*5.3*632^ **INSTALL NAME** DG*5.3*632 "BLD",5473,0) DG*5.3*632^REGISTRATION^0^3041206^y "BLD",5473,4,0) ^9.64PA^2^1 "BLD",5473,4,2,0) 2 "BLD",5473,4,2,2,0) ^9.641^2^1 "BLD",5473,4,2,2,2,0) PATIENT (File-top level) "BLD",5473,4,2,2,2,1,0) ^9.6411^.305^1 "BLD",5473,4,2,2,2,1,.305,0) UNEMPLOYABLE "BLD",5473,4,2,222) y^y^p^^^^n^^n "BLD",5473,4,2,224) "BLD",5473,4,"APDD",2,2) "BLD",5473,4,"APDD",2,2,.305) "BLD",5473,4,"B",2,2) "BLD",5473,"INID") ^n "BLD",5473,"INIT") POST^DG53632P "BLD",5473,"KRN",0) ^9.67PA^8989.52^19 "BLD",5473,"KRN",.4,0) .4 "BLD",5473,"KRN",.401,0) .401 "BLD",5473,"KRN",.402,0) .402 "BLD",5473,"KRN",.403,0) .403 "BLD",5473,"KRN",.5,0) .5 "BLD",5473,"KRN",.84,0) .84 "BLD",5473,"KRN",3.6,0) 3.6 "BLD",5473,"KRN",3.8,0) 3.8 "BLD",5473,"KRN",9.2,0) 9.2 "BLD",5473,"KRN",9.8,0) 9.8 "BLD",5473,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",5473,"KRN",9.8,"NM",1,0) DGRPCE1^^0^B52840183 "BLD",5473,"KRN",9.8,"NM",2,0) DGRPC3^^0^B16200328 "BLD",5473,"KRN",9.8,"NM","B","DGRPC3",2) "BLD",5473,"KRN",9.8,"NM","B","DGRPCE1",1) "BLD",5473,"KRN",19,0) 19 "BLD",5473,"KRN",19.1,0) 19.1 "BLD",5473,"KRN",101,0) 101 "BLD",5473,"KRN",409.61,0) 409.61 "BLD",5473,"KRN",771,0) 771 "BLD",5473,"KRN",870,0) 870 "BLD",5473,"KRN",8989.51,0) 8989.51 "BLD",5473,"KRN",8989.52,0) 8989.52 "BLD",5473,"KRN",8994,0) 8994 "BLD",5473,"KRN","B",.4,.4) "BLD",5473,"KRN","B",.401,.401) "BLD",5473,"KRN","B",.402,.402) "BLD",5473,"KRN","B",.403,.403) "BLD",5473,"KRN","B",.5,.5) "BLD",5473,"KRN","B",.84,.84) "BLD",5473,"KRN","B",3.6,3.6) "BLD",5473,"KRN","B",3.8,3.8) "BLD",5473,"KRN","B",9.2,9.2) "BLD",5473,"KRN","B",9.8,9.8) "BLD",5473,"KRN","B",19,19) "BLD",5473,"KRN","B",19.1,19.1) "BLD",5473,"KRN","B",101,101) "BLD",5473,"KRN","B",409.61,409.61) "BLD",5473,"KRN","B",771,771) "BLD",5473,"KRN","B",870,870) "BLD",5473,"KRN","B",8989.51,8989.51) "BLD",5473,"KRN","B",8989.52,8989.52) "BLD",5473,"KRN","B",8994,8994) "BLD",5473,"QUES",0) ^9.62^^ "BLD",5473,"REQB",0) ^9.611^1^1 "BLD",5473,"REQB",1,0) DG*5.3*564^2 "BLD",5473,"REQB","B","DG*5.3*564",1) "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^y^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,.305) "INIT") POST^DG53632P "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 632^3041206 "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") YES "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") YES "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") 3 "RTN","DG53632P") 0^^B41635725 "RTN","DG53632P",1,0) DG53632P ;ALB/LBD - Post install routine for DG*5.3*632; 1 NOV 2004 "RTN","DG53632P",2,0) ;;5.3;Registration;**632**; Aug 13, 1993 "RTN","DG53632P",3,0) ; "RTN","DG53632P",4,0) POST ; Post install entry point "RTN","DG53632P",5,0) D FVINC Q:$G(XPDABORT)=2 "RTN","DG53632P",6,0) D UNEMPOW "RTN","DG53632P",7,0) Q "RTN","DG53632P",8,0) FVINC ; Add new entry #86 to the INCONSISTENT DATA ELEMENTS file (#38.6) "RTN","DG53632P",9,0) N DGFDA,DGIEN,DGERR,ROOT,DGWP,DGINC "RTN","DG53632P",10,0) K XPDABORT "RTN","DG53632P",11,0) D BMES^XPDUTL(">>> Adding entry #86 to the INCONSISTENT DATA ELEMENTS file (#38.6) <<<") "RTN","DG53632P",12,0) S DGINC="INEL FIL VET SHOULD BE VET='N'" "RTN","DG53632P",13,0) I $D(^DGIN(38.6,86,0)) D Q "RTN","DG53632P",14,0) .D BMES^XPDUTL(" Internal entry #86 already exists in file #38.6") "RTN","DG53632P",15,0) .I $P($G(^DGIN(38.6,86,0)),U)=DGINC D MES^XPDUTL(" Entry matches incoming inconsistency for Filipino Vet - OK") Q "RTN","DG53632P",16,0) .D MES^XPDUTL(" >>> ERROR: Entry #86 needs to be reviewed by EVS!") "RTN","DG53632P",17,0) .D MES^XPDUTL(" Existing entry: "_$P($G(^DGIN(38.6,86,0)),U)) "RTN","DG53632P",18,0) .D MES^XPDUTL(" Incoming entry: "_DGINC) "RTN","DG53632P",19,0) .D BMES^XPDUTL(" <<<< INSTALLATION ABORTED >>>>") "RTN","DG53632P",20,0) .S XPDABORT=2 "RTN","DG53632P",21,0) S ROOT="DGFDA(38.6,""?+1,"")" "RTN","DG53632P",22,0) S @ROOT@(.01)=DGINC "RTN","DG53632P",23,0) S @ROOT@(2)="INELIGIBLE FILIPINO VETERAN SHOULD HAVE A VETERAN STATUS OF 'NO'" "RTN","DG53632P",24,0) S @ROOT@(3)=3 "RTN","DG53632P",25,0) S @ROOT@(50)="DGWP" "RTN","DG53632P",26,0) S DGWP(1,0)="Inconsistency results if a veteran has a Filipino Veteran branch of" "RTN","DG53632P",27,0) S DGWP(2,0)="service (F.COMMONWEALTH, F.GUERILLA, F.SCOUTS NEW, or F.SCOUTS OLD)," "RTN","DG53632P",28,0) S DGWP(3,0)="but is ineligible because of no World War II military service dates" "RTN","DG53632P",29,0) S DGWP(4,0)="or no proof of F.Vet eligibility (for the first three BOS only), and" "RTN","DG53632P",30,0) S DGWP(5,0)="the Veteran Status is set to 'YES'." "RTN","DG53632P",31,0) S DGIEN(1)=86 "RTN","DG53632P",32,0) D UPDATE^DIE("","DGFDA","DGIEN","DGERR") "RTN","DG53632P",33,0) I $D(DGERR) D Q "RTN","DG53632P",34,0) .D BMES^XPDUTL(" >>> ERROR: "_DGINC_" not added to file #38.6") "RTN","DG53632P",35,0) .D MES^XPDUTL(" "_DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1)) "RTN","DG53632P",36,0) .D BMES^XPDUTL(" <<<< INSTALLATION ABORTED >>>>") "RTN","DG53632P",37,0) .S XPDABORT=2 "RTN","DG53632P",38,0) D BMES^XPDUTL(" "_DGINC_" successfully added.") "RTN","DG53632P",39,0) Q "RTN","DG53632P",40,0) ; "RTN","DG53632P",41,0) UNEMPOW ; Run update process for Unemployable and POW Veterans "RTN","DG53632P",42,0) D BMES^XPDUTL(">>> Update process for Unemployable and POW Veterans <<<") "RTN","DG53632P",43,0) Q:'$$CHK "RTN","DG53632P",44,0) D QUETASK "RTN","DG53632P",45,0) Q "RTN","DG53632P",46,0) QUETASK ; Queue the Unemp/POW Vet update job "RTN","DG53632P",47,0) N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH "RTN","DG53632P",48,0) S ZTRTN="EN^DG53632P",ZTIO="",ZTDTH=$$NOW^XLFDT() "RTN","DG53632P",49,0) S ZTDESC="UPDATE PROCESS FOR UNEMPLOYABLE AND POW VETS" "RTN","DG53632P",50,0) D ^%ZTLOAD S ^XTMP("DG53632P",0,"TASK")=$G(ZTSK) "RTN","DG53632P",51,0) S TXT=$S($G(ZTSK):"Task: "_ZTSK_" Queued.",1:"Error: Process not queued!") "RTN","DG53632P",52,0) D BMES^XPDUTL(TXT) "RTN","DG53632P",53,0) Q "RTN","DG53632P",54,0) ; "RTN","DG53632P",55,0) EN ; Entry point for queued process "RTN","DG53632P",56,0) I $G(ZTSK) S ZTREQ="@" "RTN","DG53632P",57,0) S $P(^XTMP("DG53632P",0,"DATE"),U,1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P") "RTN","DG53632P",58,0) ; Loop through Patient file "AENRC" x-ref for verified enrollments (2) "RTN","DG53632P",59,0) N DFN "RTN","DG53632P",60,0) S DFN=0 "RTN","DG53632P",61,0) F S DFN=$O(^DPT("AENRC",2,DFN)) Q:'DFN D "RTN","DG53632P",62,0) .I $$POW(DFN) D Q "RTN","DG53632P",63,0) ..S ^XTMP("DG53632P","POWTOT")=$G(^XTMP("DG53632P","POWTOT"))+1 "RTN","DG53632P",64,0) ..D UPRX(DFN,"POW") "RTN","DG53632P",65,0) .I $$UNEMP(DFN) D "RTN","DG53632P",66,0) ..S ^XTMP("DG53632P","UNEMPTOT")=$G(^XTMP("DG53632P","UNEMPTOT"))+1 "RTN","DG53632P",67,0) ..D UPRX(DFN,"UNEMP") "RTN","DG53632P",68,0) S $P(^XTMP("DG53632P",0,"DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P") "RTN","DG53632P",69,0) S ^XTMP("DG53632P",0,"COMPLETED")=1 "RTN","DG53632P",70,0) D SENDMSG "RTN","DG53632P",71,0) Q "RTN","DG53632P",72,0) ; "RTN","DG53632P",73,0) POW(DFN) ; Is veteran a POW? "RTN","DG53632P",74,0) I '$G(DFN) Q 0 "RTN","DG53632P",75,0) I $P($G(^DPT(DFN,.52)),U,5)="Y" Q 1 ;POW Indicator='Y' "RTN","DG53632P",76,0) I +$G(^DPT(DFN,.36))=18 Q 1 ;Primary Eligibility code = POW "RTN","DG53632P",77,0) I $D(^DPT(DFN,"E",18)) Q 1 ;Secondary Eligibility code = POW "RTN","DG53632P",78,0) Q 0 "RTN","DG53632P",79,0) ; "RTN","DG53632P",80,0) UNEMP(DFN) ; Is veteran Unemployable Priority 1? "RTN","DG53632P",81,0) N DGENRIEN "RTN","DG53632P",82,0) S DGENRIEN=$$FINDCUR^DGENA(DFN) Q:'DGENRIEN 0 ;Get current enrollment "RTN","DG53632P",83,0) Q:'$$GET^DGENA(DGENRIEN,.DGENR) 0 ;Get enrollment data "RTN","DG53632P",84,0) Q:$G(DGENR("PRIORITY"))'=1 0 ;Quit if not priority group 1 "RTN","DG53632P",85,0) Q:$G(DGENR("ELIG","UNEMPLOY"))'="Y" 0 ;Quit if not unemployable "RTN","DG53632P",86,0) Q:$G(DGENR("ELIG","SCPER"))>49 0 ;Quit if SC % 50-100 "RTN","DG53632P",87,0) Q 1 "RTN","DG53632P",88,0) ; "RTN","DG53632P",89,0) UPRX(DFN,EX) ; Update RX Copay status in Annual Means Test file (#408.31) "RTN","DG53632P",90,0) ; and Billing Patient file (#354) "RTN","DG53632P",91,0) ; INPUT - DFN = Patient IEN "RTN","DG53632P",92,0) ; EX = Exemption type, either POW or UNEMP "RTN","DG53632P",93,0) N REAS,STAT "RTN","DG53632P",94,0) I '$D(^IBA(354,DFN)) Q "RTN","DG53632P",95,0) S STAT=$$GET1^DIQ(354,DFN_",",.04,"E") "RTN","DG53632P",96,0) S REAS=$$GET1^DIQ(354,DFN_",",.05,"E") "RTN","DG53632P",97,0) I REAS[EX Q ;correct exemption type already set "RTN","DG53632P",98,0) I EX="POW",STAT="EXEMPT",REAS'["INCOME" Q "RTN","DG53632P",99,0) D EN^DGMTCOR ;Update RX copay test and IB file #354 "RTN","DG53632P",100,0) S ^XTMP("DG53632P",EX_"UP")=$G(^XTMP("DG53632P",EX_"UP"))+1 "RTN","DG53632P",101,0) S ^XTMP("DG53632P","VET",DFN)=EX "RTN","DG53632P",102,0) Q "RTN","DG53632P",103,0) CHK() ; Check if Unemp Vet update process should be run "RTN","DG53632P",104,0) N CDT,TASK,TXT "RTN","DG53632P",105,0) I '$D(^XTMP("DG53632P",0)) S ^XTMP("DG53632P",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_"DG*5.3*632 POST-INSTALL UPDATE FOR POW & UNEMP VETS" Q 1 "RTN","DG53632P",106,0) I $G(^XTMP("DG53632P",0,"COMPLETED")) D Q 0 "RTN","DG53632P",107,0) .S CDT=$P($G(^XTMP("DG53632P",0,"DATE")),U,2) "RTN","DG53632P",108,0) .S TXT(1)="The update process for Unemployable and POW Veterans was completed" "RTN","DG53632P",109,0) .S TXT(2)="on "_CDT "RTN","DG53632P",110,0) .D BMES^XPDUTL(.TXT) "RTN","DG53632P",111,0) S TASK=$G(^XTMP("DG53632P",0,"TASK")) I 'TASK Q 1 "RTN","DG53632P",112,0) I $$ACTIVE(TASK) D Q 0 "RTN","DG53632P",113,0) .S TXT(1)="Task: "_TASK_" is currently running the update process for unemployable" "RTN","DG53632P",114,0) .S TXT(2)="& POW veterans. A duplicate job cannot be started." "RTN","DG53632P",115,0) .D BMES^XPDUTL(.TXT) "RTN","DG53632P",116,0) Q 1 "RTN","DG53632P",117,0) ACTIVE(TASK) ; Check if task is running "RTN","DG53632P",118,0) ; Input -- TASK = Task number "RTN","DG53632P",119,0) ; Output -- 1 = Task is running "RTN","DG53632P",120,0) ; 0 = Task is not running "RTN","DG53632P",121,0) N STAT,ZTSK,Y "RTN","DG53632P",122,0) S STAT=0,ZTSK=+$G(TASK) I 'ZTSK Q STAT "RTN","DG53632P",123,0) D STAT^%ZTLOAD "RTN","DG53632P",124,0) S Y=ZTSK(1) "RTN","DG53632P",125,0) I "^1^2^"[(U_Y_U) S STAT=1 "RTN","DG53632P",126,0) I "^3^5^"[(U_Y_U) S STAT=0 "RTN","DG53632P",127,0) Q STAT "RTN","DG53632P",128,0) ; "RTN","DG53632P",129,0) SENDMSG ; Send Mailman bulletin when process completes "RTN","DG53632P",130,0) N SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG "RTN","DG53632P",131,0) S SITE=$$SITE^VASITE,STATN=$P($G(SITE),U,3),SITENM=$P($G(SITE),U,2) "RTN","DG53632P",132,0) S:$$GET1^DIQ(869.3,"1,",.03,"I")'="P" STATN=STATN_" [TEST]" "RTN","DG53632P",133,0) S XMDUZ="UNEMPLOYABLE AND POW VETS UPDATE",XMSUB=XMDUZ_" (DG*5.3*632) - "_STATN "RTN","DG53632P",134,0) S (XMY(DUZ),XMY("linda.desmond@med.va.gov"))="" "RTN","DG53632P",135,0) S XMTEXT="MSG(" "RTN","DG53632P",136,0) S MSG(1)="The post-install process for patch DG*5.3*632 has completed successfully." "RTN","DG53632P",137,0) S MSG(2)="This process searched for POW and Priority 1 Unemployable Veterans and" "RTN","DG53632P",138,0) S MSG(3)="updated their RX copay status to Exempt in the Billing Patient file #354," "RTN","DG53632P",139,0) S MSG(3.1)="if necessary." "RTN","DG53632P",140,0) S MSG(4)="" "RTN","DG53632P",141,0) S MSG(5)="Task: "_$G(^XTMP("DG53632P",0,"TASK")) "RTN","DG53632P",142,0) S MSG(6)="Site Station Number: "_STATN "RTN","DG53632P",143,0) S MSG(7)="Site Name: "_SITENM "RTN","DG53632P",144,0) S MSG(8)="" "RTN","DG53632P",145,0) S MSG(9)="Process started : "_$P($G(^XTMP("DG53632P",0,"DATE")),U,1) "RTN","DG53632P",146,0) S MSG(10)="Process completed : "_$P($G(^XTMP("DG53632P",0,"DATE")),U,2) "RTN","DG53632P",147,0) S MSG(10.5)="" "RTN","DG53632P",148,0) S MSG(11)="Total Priority 1 Unemployable Vets : "_+$G(^XTMP("DG53632P","UNEMPTOT")) "RTN","DG53632P",149,0) S MSG(12)="Total RX Copay Status Updates : "_+$G(^XTMP("DG53632P","UNEMPUP")) "RTN","DG53632P",150,0) S MSG(12.5)="" "RTN","DG53632P",151,0) S MSG(13)="Total Former POW Veterans : "_+$G(^XTMP("DG53632P","POWTOT")) "RTN","DG53632P",152,0) S MSG(14)="Total RX Copay Status Updates : "_+$G(^XTMP("DG53632P","POWUP")) "RTN","DG53632P",153,0) D ^XMD "RTN","DG53632P",154,0) Q "RTN","DGRPC3") 0^2^B16200328 "RTN","DGRPC3",1,0) DGRPC3 ;ALB/PJR,LBD - CHECK CONSISTENCY OF PATIENT DATA (CONT) ; 5/17/04 9:00am "RTN","DGRPC3",2,0) ;;5.3;Registration;**451,632**;Aug 13, 1993 "RTN","DGRPC3",3,0) ; "RTN","DGRPC3",4,0) 79 ;; MSE Dates overlap "RTN","DGRPC3",5,0) ;; Don't check if MSE Dates Incomplete or if MSE TO precedes FROM "RTN","DGRPC3",6,0) ;; or unless at least 2 ranges "RTN","DGRPC3",7,0) S:'$G(MSECHK) MSECHK=$$MSCK^DGMSCK I MSDATERR!($L(ANYMSE)<2) D NEXT G @DGLST "RTN","DGRPC3",8,0) I ANYMSE[1,'$$OVRLPCHK^DGRPDT(DFN,$P(DGP(.32),"^",6),$P(DGP(.32),"^",7),1,".326^.327") S X=79 D COMB S MSERR=1 D NEXT G @DGLST "RTN","DGRPC3",9,0) I ANYMSE'[1,'$$OVRLPCHK^DGRPDT(DFN,$P(DGP(.32),"^",11),$P(DGP(.32),"^",12),1,".3292^.3293") S X=79 D COMB S MSERR=1 D NEXT G @DGLST "RTN","DGRPC3",10,0) D NEXT G @DGLST "RTN","DGRPC3",11,0) 80 ;; POW Dates not within MSE "RTN","DGRPC3",12,0) I '$P(DGP(.52),"^",6) D NEXT G @DGLST ;; Don't check if no POW Data "RTN","DGRPC3",13,0) ;; Don't check if POW Data Incomplete or if POW TO precedes FROM "RTN","DGRPC3",14,0) I ((","_DGER_",")[(",37,"))!((","_DGER_",")[(",38,")) D NEXT G @DGLST "RTN","DGRPC3",15,0) S:'$G(MSECHK) MSECHK=$$MSCK^DGMSCK S:'$G(MSESET) MSESET=$$MSFROMTO^DGMSCK "RTN","DGRPC3",16,0) ;; If POW, but no MSE, then Range is NOT within MSE "RTN","DGRPC3",17,0) I 'ANYMSE S X=80 D COMB D NEXT G @DGLST "RTN","DGRPC3",18,0) I '$$RWITHIN^DGRPDT($P(MSESET,"^",1),$P(MSESET,"^",2),$P(DGP(.52),"^",7),$P(DGP(.52),"^",8)) S X=80 D COMB "RTN","DGRPC3",19,0) D NEXT G @DGLST "RTN","DGRPC3",20,0) 81 ;; Combat Dates not within MSE "RTN","DGRPC3",21,0) I '$P(DGP(.52),"^",12) D NEXT G @DGLST ;; Don't check if no COMBAT Data "RTN","DGRPC3",22,0) ;; Don't check if COMBAT Data Incomplete or if COMBAT TO precedes FROM "RTN","DGRPC3",23,0) I ((","_DGER_",")[(",39,"))!((","_DGER_",")[(",40,")) D NEXT G @DGLST "RTN","DGRPC3",24,0) S:'$G(MSECHK) MSECHK=$$MSCK^DGMSCK S:'$G(MSESET) MSESET=$$MSFROMTO^DGMSCK "RTN","DGRPC3",25,0) ;; If COMBAT, but no MSE, then Range is NOT within MSE "RTN","DGRPC3",26,0) I 'ANYMSE S X=81 D COMB D NEXT G @DGLST "RTN","DGRPC3",27,0) I '$$RWITHIN^DGRPDT($P(MSESET,"^",1),$P(MSESET,"^",2),$P(DGP(.52),"^",13),$P(DGP(.52),"^",14)) S X=81 D COMB "RTN","DGRPC3",28,0) D NEXT G @DGLST "RTN","DGRPC3",29,0) 82 ;; Conflict Dates not within MSE "RTN","DGRPC3",30,0) S:'$G(CONCHK) CONCHK=$$CNCK^DGMSCK "RTN","DGRPC3",31,0) S:'$G(MSECHK) MSECHK=$$MSCK^DGMSCK S:'$G(MSESET) MSESET=$$MSFROMTO^DGMSCK "RTN","DGRPC3",32,0) S LOC="",I2=0 F I1=1:1 S LOC=$O(CONSPEC(LOC)) Q:LOC="" I CONARR(LOC)=1 D "RTN","DGRPC3",33,0) .N FROMDAT,FROMPC,TODAT,TOPC,NODE,DATA "RTN","DGRPC3",34,0) .S DATA=CONSPEC(LOC) "RTN","DGRPC3",35,0) .S NODE=$P(DATA,",",1),FROMPC=$P(DATA,",",3),TOPC=$P(DATA,",",4) "RTN","DGRPC3",36,0) .S FROMDAT=$P(DGP(NODE),"^",FROMPC),TODAT=$P(DGP(NODE),"^",TOPC) "RTN","DGRPC3",37,0) .I '$$RWITHIN^DGRPDT($P(MSESET,"^",1),$P(MSESET,"^",2),FROMDAT,TODAT) S X=82 D COMB:'I2 S CONARR(LOC)=2,I2=1 "RTN","DGRPC3",38,0) .Q "RTN","DGRPC3",39,0) D NEXT G @DGLST "RTN","DGRPC3",40,0) 83 ;Merchant Seaman or Filipino Vet BOS requires service dates during WWII "RTN","DGRPC3",41,0) N BOS,BOSN,MS,MSE,OUT "RTN","DGRPC3",42,0) F MS=1:1:3 D Q:$G(OUT) "RTN","DGRPC3",43,0) .I MS=2,$P(DGP(.32),U,19)'="Y" S OUT=1 Q "RTN","DGRPC3",44,0) .I MS=3,$P(DGP(.32),U,20)'="Y" S OUT=1 Q "RTN","DGRPC3",45,0) .S BOS=$P(DGP(.32),U,(5*MS)) Q:'BOS S BOSN=$P($G(^DIC(23,BOS,0)),U) "RTN","DGRPC3",46,0) .S MSE=$S(MS=1:"MSL",MS=2:"MSNTL",1:"MSNNTL") "RTN","DGRPC3",47,0) .I $$BRANCH^DGRPMS(BOS_U_BOSN),'$$WWII^DGRPMS(DFN,"",MSE) S X=83 D COMB S OUT=1 Q "RTN","DGRPC3",48,0) D NEXT G @DGLST "RTN","DGRPC3",49,0) 84 ;Filipino Vet BOS requires Filipino Vet Proof "RTN","DGRPC3",50,0) N MS,BOS,OUT "RTN","DGRPC3",51,0) F MS=1:1:3 D Q:$G(OUT) "RTN","DGRPC3",52,0) .I MS=2,$P(DGP(.32),U,19)'="Y" S OUT=1 Q "RTN","DGRPC3",53,0) .I MS=3,$P(DGP(.32),U,20)'="Y" S OUT=1 Q "RTN","DGRPC3",54,0) .S BOS=$P(DGP(.32),U,(5*MS)) "RTN","DGRPC3",55,0) .I $$FV^DGRPMS(BOS)=1,$P(DGP(.321),U,14)="" S X=84 D COMB S OUT=1 Q "RTN","DGRPC3",56,0) D NEXT G @DGLST "RTN","DGRPC3",57,0) 85 ;Eligible Filipino Vet should have Veteran status = 'YES' "RTN","DGRPC3",58,0) 86 ;Ineligible Filipino Vet should have Veteran status = 'NO' "RTN","DGRPC3",59,0) N MS,BOS,FV,FILV,NOTFV,MSE,OUT "RTN","DGRPC3",60,0) F MS=1:1:3 D Q:$G(OUT) "RTN","DGRPC3",61,0) .I MS=2,$P(DGP(.32),U,19)'="Y" S OUT=1 Q "RTN","DGRPC3",62,0) .I MS=3,$P(DGP(.32),U,20)'="Y" S OUT=1 Q "RTN","DGRPC3",63,0) .S BOS=$P(DGP(.32),U,(5*MS)),FV=$$FV^DGRPMS(BOS) I 'FV S NOTFV="" Q "RTN","DGRPC3",64,0) .S MSE=$S(MS=1:"MSL",MS=2:"MSNTL",1:"MSNNTL") "RTN","DGRPC3",65,0) .I '$$WWII^DGRPMS(DFN,"",MSE) S FILV("I")="" Q "RTN","DGRPC3",66,0) .I FV=2 S FILV("E")="" Q "RTN","DGRPC3",67,0) .I $P(DGP(.321),U,14)=""!($P(DGP(.321),U,14)="NO") S FILV("I")="" Q "RTN","DGRPC3",68,0) .S FILV("E")="" "RTN","DGRPC3",69,0) I $D(FILV) D "RTN","DGRPC3",70,0) .I DGVT'=1,$D(FILV("E")) S X=85 D COMB Q "RTN","DGRPC3",71,0) .I DGCHK'[(",86,") Q "RTN","DGRPC3",72,0) .I DGVT=1,'$D(NOTFV),'$D(FILV("E")),$D(FILV("I")) S X=86 D COMB "RTN","DGRPC3",73,0) S DGLST=86 "RTN","DGRPC3",74,0) D NEXT G @DGLST "RTN","DGRPC3",75,0) 99 ; synonymous with END "RTN","DGRPC3",76,0) END I DGNCK S X=99 D COMB "RTN","DGRPC3",77,0) I DGEDCN S DGCON=0 D TIME^DGRPC "RTN","DGRPC3",78,0) K C,C1,C2,DGCD,DGD,DGD1,DGD2,DGDATE,DGDEP,DGCHK,DGFL,DGINC,DGISYR,DGLST,DGMS,DGNCK,DGP,DGPTYP,DGREL,DGSCT,DGT,DGTIME,DGTOT,DGVT,I,I2,I2,J,VAIN,X,X1 "RTN","DGRPC3",79,0) G ^DGRPCF "RTN","DGRPC3",80,0) ; "RTN","DGRPC3",81,0) COMB S DGCT=DGCT+1,DGER=DGER_X_",",DGLST=X Q "RTN","DGRPC3",82,0) ;; "RTN","DGRPC3",83,0) NEXT S I=$F(DGCHK,(","_+DGLST_",")),DGLST=+$E(DGCHK,I,999) S:'DGLST DGLST="END" "RTN","DGRPC3",84,0) Q "RTN","DGRPCE1") 0^1^B52840183 "RTN","DGRPCE1",1,0) DGRPCE1 ;ALB/MIR/BRM/LBD - CONSISTENCY CHECKER EDIT ; 6/21/04 8:47am "RTN","DGRPCE1",2,0) ;;5.3;Registration;**108,226,470,454,489,505,522,451,632**;Aug 13, 1993 "RTN","DGRPCE1",3,0) N I,J F I=1:1:8,16,53,57,58,61:1:86 D SASK "RTN","DGRPCE1",4,0) ;F I=49,50,52 D SASK ;BELOW REPLACED WITH ^IBCNSP2 CALL "RTN","DGRPCE1",5,0) ;OLDS DR(2,2.312)="S DGRPADI="""";.01;1;2;15;8;7;3;6;S DGRPADI=X;I DGRPADI'=""v"" S Y=""@2312"";17///^S X=""`""_DFN;16///^S X=""01"";S Y=""@23121"";@2312;17;16//^S X=$S(DGRPADI=""s"":""02"",1:"""");@23121;9:14;" "RTN","DGRPCE1",6,0) Q "RTN","DGRPCE1",7,0) SASK I DGER[(","_I_","),DGASK'[(","_I_",") F J=I,I*1000:1 Q:'$T(@J) S DGD=DGD_$P($T(@J),";;",2,999) D SAVE "RTN","DGRPCE1",8,0) S DGASK=DGASK_I_"," "RTN","DGRPCE1",9,0) Q "RTN","DGRPCE1",10,0) SAVE I $L(@DGDR)+$L(DGD)<241 S @DGDR=@DGDR_DGD,DGD="" Q "RTN","DGRPCE1",11,0) S DGDRC=DGDRC+1,DGDR="DR(1,2,"_DGDRC_")",@DGDR=DGD,DGD="" Q "RTN","DGRPCE1",12,0) ; "RTN","DGRPCE1",13,0) ; "RTN","DGRPCE1",14,0) ELIG ;eligibility code...if M11+, use compiled template, otherwise DR string "RTN","DGRPCE1",15,0) I ^%ZOSF("OS")'["M/11+" S DGD=$P($T(14),";;",2,999) D SAVE Q "RTN","DGRPCE1",16,0) N DA,DIE,DR S DIE="^DPT(",DA=DFN,DR="[DG CONSISTENCY CHECKER]" D ^DIE "RTN","DGRPCE1",17,0) Q "RTN","DGRPCE1",18,0) ; "RTN","DGRPCE1",19,0) ; "RTN","DGRPCE1",20,0) 1 ;;.01; "RTN","DGRPCE1",21,0) 2 ;;1; "RTN","DGRPCE1",22,0) 3 ;;.02; "RTN","DGRPCE1",23,0) 4 ;;.03; "RTN","DGRPCE1",24,0) 5 ;;.05; "RTN","DGRPCE1",25,0) 6 ;;.08; "RTN","DGRPCE1",26,0) 7 ;;.09; "RTN","DGRPCE1",27,0) 8 ;;N FLG S FLG(2)=1 S:$G(DGER)[",61," FLG(1)=1 D EN^DGREGAED(DFN,.FLG); "RTN","DGRPCE1",28,0) 14 ;;.361;S DGECODE=$S($D(^DIC(8,+X,0)):$P(^(0),"^",1),1:"");S:$S(DGECODE["ALLIED":0,DGECODE["FEDERAL":0,1:1) Y=.323;.309;.323;D ^DGYZODS;S:'DGODS Y="@14";11500.02;11500.03;@14; "RTN","DGRPCE1",29,0) 16 ;;.351; "RTN","DGRPCE1",30,0) 53 ;;.07;.31115;I $S(X']"":1,X=3:1,X=9:1,1:0) S Y="@53";.3111;S:X']"" Y="@53";.3113;S:X']"" Y=.3116;.3114;S:X']"" Y=.3116;.3115:.3117;.2205;.3119;@53; "RTN","DGRPCE1",31,0) 57 ;;.381;.382///NOW; "RTN","DGRPCE1",32,0) 58 ;;.322013;S:X'="Y" Y="@589";.322014;.322015;.32201;S:X'="Y" Y="@581";.322011;.322012;@581;.322016;S:X'="Y" Y="@589";.322017;.322018;@589; "RTN","DGRPCE1",33,0) 61 ;;S:$G(DGER)[",8," Y="@619";.131;.132;@619; "RTN","DGRPCE1",34,0) 62 ;;.331; "RTN","DGRPCE1",35,0) 63 ;;.1411;S DIE("NO^")="OUTOK";S:X']"" Y=.1414;.1412;S:X']"" Y=.1414;.1413;.1414;.1415;.1416;Q;.14111;K DIE("NO^"); "RTN","DGRPCE1",36,0) 64 ;;.092;.093; "RTN","DGRPCE1",37,0) 65 ;;.2403; "RTN","DGRPCE1",38,0) 66 ;;.09; "RTN","DGRPCE1",39,0) 67 ;;S:$$DGERCK^DGRPCE1("73^79^80^81^82",.DGER) Y="@67";W !!,$C(7),"SERVICE SEPARATION DATE [LAST] must be a precise date to determine CV Elig",!;.325;.326;.327;@67; "RTN","DGRPCE1",40,0) 68 ;;S:$$DGERCK^DGRPCE1("39^40",.DGER) Y="@68";W !!,$C(7),"COMBAT TO DATE must be a precise date to determine CV Eligibility",!;.5291;S:X'="Y" Y="@68";.5292;.5293;.5294;@68; "RTN","DGRPCE1",41,0) 69 ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@69";W !!,$C(7),"YUGOSLAVIA TO DATE must be a precise date to determine CV Eligibility",!;.322019;S:X'="Y" Y="@69";.32202;.322021;@69; "RTN","DGRPCE1",42,0) 70 ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@70";W !!,$C(7),"SOMALIA TO DATE must be a precise date to determine CV Eligibility",!;.322016;S:X'="Y" Y="@70";.322017;.322018,@70; "RTN","DGRPCE1",43,0) 71 ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@71";W !!,$C(7),"PERSIAN GULF TO DATE must be a precise date to determine CV Eligibility",!;.32201;S:X'="Y" Y="@71";.322011;.322012;@71; "RTN","DGRPCE1",44,0) 72 ;;.325;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7201";.3291;.3292;.3293;.329;@7201;S:'$$YN^DGRPCE1(.32945) Y="@7202";.3296;.3297;.3298;.3295;@7202; "RTN","DGRPCE1",45,0) ; "RTN","DGRPCE1",46,0) 73 ;;S:$$DGERCK^DGRPCE1(72,.DGER) Y="@7302";.325;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7301";.3291;.3292;.3293;.329;@7301;S:'$$YN^DGRPCE1(.32945) Y="@7302";.3296;.3297;.3298;.3295;@7302; "RTN","DGRPCE1",47,0) 74 ;;S:'$$YN^DGRPCE1(.32101) Y="@7401";.32101;S:X'="Y" Y="@7401";.32104;.32105;@7401;S:'$$YN^DGRPCE1(.322016) Y="@7402";.322016;S:X'="Y" Y="@7402";.322017;.322018;@7402; "RTN","DGRPCE1",48,0) 74000 ;;S:'$$YN^DGRPCE1(.322019) Y="@7403";.322019;S:X'="Y" Y="@7403";.32202;.322021;@7403;S:'$$YN^DGRPCE1(.3221) Y="@7404";.3221;S:X'="Y" Y="@7404";.3222;.3223;@7404; "RTN","DGRPCE1",49,0) 74001 ;;S:'$$YN^DGRPCE1(.3224) Y="@7405";.3224;S:X'="Y" Y="@7405";.3225;.3226;@7405;S:'$$YN^DGRPCE1(.3227) Y="@7406";.3227;S:X'="Y" Y="@7406";.3228;.3229;@7406; "RTN","DGRPCE1",50,0) 74002 ;;S:'$$YN^DGRPCE1(.32201) Y="@7407";.32201;S:X'="Y" Y="@7407";.322011;.322012;@7407; "RTN","DGRPCE1",51,0) 75 ;;S:$$DGERCK^DGRPCE1(74,.DGER) Y="@7507";S:'$$YN^DGRPCE1(.32101) Y="@7501";.32101;S:X'="Y" Y="@7501";.32104;.32105;@7501;S:'$$YN^DGRPCE1(.322016) Y="@7502";.322016;S:X'="Y" Y="@7502";.322017;.322018;@7502; "RTN","DGRPCE1",52,0) 75000 ;;S:'$$YN^DGRPCE1(.322019) Y="@7503";.322019;S:X'="Y" Y="@7503";.32202;.322021;@7503;S:'$$YN^DGRPCE1(.3221) Y="@7504";.3221;S:X'="Y" Y="@7504";.3222;.3223;@7504; "RTN","DGRPCE1",53,0) 75001 ;;S:'$$YN^DGRPCE1(.3224) Y="@7505";.3224;S:X'="Y" Y="@7505";.3225;.3226;@7505;S:'$$YN^DGRPCE1(.3227) Y="@7506";.3227;S:X'="Y" Y="@7506";.3228;.3229;@7506; "RTN","DGRPCE1",54,0) 75002 ;;S:'$$YN^DGRPCE1(.32201) Y="@7507";.32201;S:X'="Y" Y="@7507";.322011;.322012;@7507; "RTN","DGRPCE1",55,0) 76 ;;S:$$DGERCK^DGRPCE1("74^75",.DGER) Y="@7607";S:'$$YN^DGRPCE1(.32101) Y="@7601";.32101;S:X'="Y" Y="@7601";.32104;.32105;@7601;S:'$$YN^DGRPCE1(.322016) Y="@7602";.322016;S:X'="Y" Y="@7602";.322017;.322018;@7602; "RTN","DGRPCE1",56,0) 76000 ;;S:'$$YN^DGRPCE1(.322019) Y="@7603";.322019;S:X'="Y" Y="@7603";.32202;.322021;@7603;S:'$$YN^DGRPCE1(.3221) Y="@7604";.3221;S:X'="Y" Y="@7604";.3222;.3223;@7604; "RTN","DGRPCE1",57,0) 76001 ;;S:'$$YN^DGRPCE1(.3224) Y="@7605";.3224;S:X'="Y" Y="@7605";.3225;.3226;@7605;S:'$$YN^DGRPCE1(.3227) Y="@7606";.3227;S:X'="Y" Y="@7606";.3228;.3229;@7606; "RTN","DGRPCE1",58,0) 76002 ;;S:'$$YN^DGRPCE1(.32201) Y="@7607";.32201;S:X'="Y" Y="@7607";.322011;.322012;@7607; "RTN","DGRPCE1",59,0) 77 ;;S:(($$DGERCK^DGRPCE1("37^38",.DGER))!('$$YN^DGRPCE1(.525))) Y="@77";.525;S:X'="Y" Y="@77";.526;.527;.528;@77; "RTN","DGRPCE1",60,0) 78 ;;S:(($$DGERCK^DGRPCE1("39^40^68",.DGER))!('$$YN^DGRPCE1(.5291))) Y="@78";.5291;S:X'="Y" Y="@78";.5292;.5293;.5294;@78; "RTN","DGRPCE1",61,0) 79 ;;S:$$DGERCK^DGRPCE1("72^73",.DGER) Y="@7902";.325;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7901";.3291;.3292;.3293;.329;@7901;S:'$$YN^DGRPCE1(.32945) Y="@7902";.3296;.3297;.3298;.3295;@7902; "RTN","DGRPCE1",62,0) 80 ;;S:(($$DGERCK^DGRPCE1("37^38^77",.DGER))!('$$YN^DGRPCE1(.525))) Y="@8001";.525;S:X'="Y" Y="@8001";.526;.527;.528;@8001;S:$$DGERCK^DGRPCE1("72^73^79",.DGER) Y="@8003"; "RTN","DGRPCE1",63,0) 80000 ;;.325;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8002";.3291;.3292;.3293;.329;@8002;S:'$$YN^DGRPCE1(.32945) Y="@8003";.3296;.3297;.3298;.3295;@8003; "RTN","DGRPCE1",64,0) 81 ;;S:(($$DGERCK^DGRPCE1("39^40^78",.DGER))!('$$YN^DGRPCE1(.5291))) Y="@8101";.5291;S:X'="Y" Y="@8101";.5292;.5293;.5294;@8101;S:$$DGERCK^DGRPCE1("72^73^79^80",.DGER) Y="@8103"; "RTN","DGRPCE1",65,0) 81000 ;;.325;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8102";.3291;.3292;.3293;.329;@8102;S:'$$YN^DGRPCE1(.32945) Y="@8103";.3296;.3297;.3298;.3295;@8103; "RTN","DGRPCE1",66,0) 82 ;;S:($$DGERCK^DGRPCE1("74^75^76",.DGER)) Y="@8207";S:'$$YN^DGRPCE1(.32101) Y="@8201";.32101;S:X'="Y" Y="@8201";.32104;.32105;@8201;S:'$$YN^DGRPCE1(.322016) Y="@8202";.322016; "RTN","DGRPCE1",67,0) 82000 ;;S:X'="Y" Y="@8202";.322017;.322018;@8202;S:'$$YN^DGRPCE1(.322019) Y="@8203";.322019;S:X'="Y" Y="@8203";.32202;.322021;@8203;S:'$$YN^DGRPCE1(.3221) Y="@8204";.3221; "RTN","DGRPCE1",68,0) 82001 ;;S:X'="Y" Y="@8204";.3222;.3223;@8204;S:'$$YN^DGRPCE1(.3224) Y="@8205";.3224;S:X'="Y" Y="@8205";.3225;.3226;@8205;S:'$$YN^DGRPCE1(.3227) Y="@8206";.3227;S:X'="Y" Y="@8206"; "RTN","DGRPCE1",69,0) 82002 ;;.3228;.3229;@8206;S:'$$YN^DGRPCE1(.32201) Y="@8207";.32201;S:X'="Y" Y="@8207";.322011;.322012;@8207;S:($$DGERCK^DGRPCE1("72^73^79^80^81",.DGER)) Y="@8209"; "RTN","DGRPCE1",70,0) 82003 ;;.325;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8208";.3291;.3292;.3293;.329;@8208;S:'$$YN^DGRPCE1(.32945) Y="@8209";.3296;.3297;.3298;.3295;@8209; "RTN","DGRPCE1",71,0) 83 ;;S:$$DGERCK^DGRPCE1(73,.DGER) Y="@83";@8295;.325;S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y="@8296";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y="@8295";@8296;.326;.327; "RTN","DGRPCE1",72,0) 83000 ;;.3285//NO;S:X'="Y" Y="@83";.3291;S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y=".3292";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y=".3291";.3292;.3293; "RTN","DGRPCE1",73,0) 83001 ;;.32945//NO;S:X'="Y" Y="@83";.3296;S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y=".3297";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y=".3296";.3297;.3298;@83; "RTN","DGRPCE1",74,0) 84 ;;.3214; "RTN","DGRPCE1",75,0) 85 ;;1901; "RTN","DGRPCE1",76,0) 86 ;;1901; "RTN","DGRPCE1",77,0) ; "RTN","DGRPCE1",78,0) YN(FLD,DFN,FILE) ; return binary for YES/NO flds in the Patient (#2) file "RTN","DGRPCE1",79,0) N RTN "RTN","DGRPCE1",80,0) Q:$G(FLD)']"" "" "RTN","DGRPCE1",81,0) S:$G(FILE)="" FILE=2 S:$G(DFN)="" DFN=$G(DA) Q:$G(DFN)']"" "" "RTN","DGRPCE1",82,0) S RTN=$$GET1^DIQ(FILE,DFN_",",FLD,"I") "RTN","DGRPCE1",83,0) Q $S(RTN=1:1,RTN=0:0,RTN="Y":1,RTN="N":0,1:"") "RTN","DGRPCE1",84,0) ; "RTN","DGRPCE1",85,0) DGERCK(STR,DGER) ;do any of the STR errors exist in DGER? "RTN","DGRPCE1",86,0) N RTN,X "RTN","DGRPCE1",87,0) Q:$G(STR)']"" 0 Q:$G(DGER)']"" 0 "RTN","DGRPCE1",88,0) S RTN=0 F X=1:1 Q:RTN!($P(STR,"^",X)="") I DGER[(","_$P(STR,"^",X)_",") S RTN=1 "RTN","DGRPCE1",89,0) Q RTN "VER") 8.0^22 "^DD",2,2,.305,0) UNEMPLOYABLE^S^Y:YES;N:NO;^.3;5^Q "^DD",2,2,.305,1,0) ^.1 "^DD",2,2,.305,1,1,0) 2^AENR305^MUMPS "^DD",2,2,.305,1,1,1) D AUTOUPD^DGENA2(DA) "^DD",2,2,.305,1,1,2) D AUTOUPD^DGENA2(DA) "^DD",2,2,.305,1,1,3) DO NOT DELETE "^DD",2,2,.305,1,1,"%D",0) ^^2^2^3040722^ "^DD",2,2,.305,1,1,"%D",1,0) This cross-reference is used to update the patient's current "^DD",2,2,.305,1,1,"%D",2,0) Patient Enrollment record. "^DD",2,2,.305,1,1,"DT") 3040722 "^DD",2,2,.305,1,2,0) 2^AT^MUMPS "^DD",2,2,.305,1,2,1) S DFN=DA D EN^DGMTCOR K DGMTCOR "^DD",2,2,.305,1,2,2) S DFN=DA D EN^DGMTCOR K DGMTCOR "^DD",2,2,.305,1,2,"%D",0) ^^3^3^3041117^ "^DD",2,2,.305,1,2,"%D",1,0) This cross reference acts like a trigger. It 'triggers' the status field "^DD",2,2,.305,1,2,"%D",2,0) in file 408.31 (ANNUAL MEANS TEST) for the co-pay exemption test. It "^DD",2,2,.305,1,2,"%D",3,0) will update the field to 'NO LONGER APPLICABLE' if appropriate. "^DD",2,2,.305,1,2,"DT") 3041117 "^DD",2,2,.305,3) Is this patient unemployable due to an SC condition as rated by VARO? "^DD",2,2,.305,21,0) ^^2^2^2911203^^ "^DD",2,2,.305,21,1,0) Is this patient rated unemployable by the VARO due to a service connected "^DD",2,2,.305,21,2,0) condition? "^DD",2,2,.305,"DT") 3041117 **END** **END**