Released DG*5.3*463 SEQ #444 Extracted from mail message **KIDS**:DG*5.3*463^ **INSTALL NAME** DG*5.3*463 "BLD",4461,0) DG*5.3*463^REGISTRATION^0^3030501^y "BLD",4461,1,0) ^^1^1^3030207^ "BLD",4461,1,1,0) FIX MT UPLOAD PROBLEM "BLD",4461,4,0) ^9.64PA^^ "BLD",4461,"INIT") EN^DG53463 "BLD",4461,"KRN",0) ^9.67PA^8989.52^19 "BLD",4461,"KRN",.4,0) .4 "BLD",4461,"KRN",.401,0) .401 "BLD",4461,"KRN",.402,0) .402 "BLD",4461,"KRN",.403,0) .403 "BLD",4461,"KRN",.5,0) .5 "BLD",4461,"KRN",.84,0) .84 "BLD",4461,"KRN",3.6,0) 3.6 "BLD",4461,"KRN",3.8,0) 3.8 "BLD",4461,"KRN",3.8,"NM",0) ^9.68A^1^1 "BLD",4461,"KRN",3.8,"NM",1,0) MT INCONSISTENCIES^^0 "BLD",4461,"KRN",3.8,"NM","B","MT INCONSISTENCIES",1) "BLD",4461,"KRN",9.2,0) 9.2 "BLD",4461,"KRN",9.8,0) 9.8 "BLD",4461,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",4461,"KRN",9.8,"NM",1,0) DGMTSC^^0^B10775175 "BLD",4461,"KRN",9.8,"NM",2,0) DGMTUTL1^^0^B7752700 "BLD",4461,"KRN",9.8,"NM",3,0) DGMTUTL2^^0^B27008069 "BLD",4461,"KRN",9.8,"NM",4,0) DG53463^^0^B323339 "BLD",4461,"KRN",9.8,"NM","B","DG53463",4) "BLD",4461,"KRN",9.8,"NM","B","DGMTSC",1) "BLD",4461,"KRN",9.8,"NM","B","DGMTUTL1",2) "BLD",4461,"KRN",9.8,"NM","B","DGMTUTL2",3) "BLD",4461,"KRN",19,0) 19 "BLD",4461,"KRN",19.1,0) 19.1 "BLD",4461,"KRN",101,0) 101 "BLD",4461,"KRN",409.61,0) 409.61 "BLD",4461,"KRN",771,0) 771 "BLD",4461,"KRN",870,0) 870 "BLD",4461,"KRN",8989.51,0) 8989.51 "BLD",4461,"KRN",8989.52,0) 8989.52 "BLD",4461,"KRN",8994,0) 8994 "BLD",4461,"KRN","B",.4,.4) "BLD",4461,"KRN","B",.401,.401) "BLD",4461,"KRN","B",.402,.402) "BLD",4461,"KRN","B",.403,.403) "BLD",4461,"KRN","B",.5,.5) "BLD",4461,"KRN","B",.84,.84) "BLD",4461,"KRN","B",3.6,3.6) "BLD",4461,"KRN","B",3.8,3.8) "BLD",4461,"KRN","B",9.2,9.2) "BLD",4461,"KRN","B",9.8,9.8) "BLD",4461,"KRN","B",19,19) "BLD",4461,"KRN","B",19.1,19.1) "BLD",4461,"KRN","B",101,101) "BLD",4461,"KRN","B",409.61,409.61) "BLD",4461,"KRN","B",771,771) "BLD",4461,"KRN","B",870,870) "BLD",4461,"KRN","B",8989.51,8989.51) "BLD",4461,"KRN","B",8989.52,8989.52) "BLD",4461,"KRN","B",8994,8994) "BLD",4461,"QUES",0) ^9.62^^ "BLD",4461,"REQB",0) ^9.611^2^2 "BLD",4461,"REQB",1,0) DG*5.3*433^2 "BLD",4461,"REQB",2,0) IVM*2.0*71^2 "BLD",4461,"REQB","B","DG*5.3*433",1) "BLD",4461,"REQB","B","IVM*2.0*71",2) "INIT") EN^DG53463 "KRN",3.8,6102,-1) 0^1 "KRN",3.8,6102,0) MT INCONSISTENCIES^PU^y^^^^ "KRN",3.8,6102,3) "KRN",3.8,6102,5,0) ^3.811P "MBREQ") 0 "ORD",11,3.8) 3.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%) "ORD",11,3.8,0) MAIL GROUP "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) 463^3030501^123456798 "PKG",5,22,1,"PAH",1,1,0) ^^1^1^3030501 "PKG",5,22,1,"PAH",1,1,1,0) FIX MT UPLOAD PROBLEM "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") 4 "RTN","DG53463") 0^4^B323339 "RTN","DG53463",1,0) DG53463 ;ALB/RMM - Mail Group Utility ; 2/03/03 "RTN","DG53463",2,0) ;;5.3;Registration;**463**;Aug 13, 1993 "RTN","DG53463",3,0) ; "RTN","DG53463",4,0) ; This post-install routine will add the user who is performing the "RTN","DG53463",5,0) ; install of Patch DG*5.3*463 to the MT INCONSISTENCIES Mail Group "RTN","DG53463",6,0) ; "RTN","DG53463",7,0) EN ; Get the IEN of the mail group distributed in this patch "RTN","DG53463",8,0) N DGENDA,DATA,ERR "RTN","DG53463",9,0) S DGENDA(1)=$O(^XMB(3.8,"B","MT INCONSISTENCIES","")) "RTN","DG53463",10,0) ; "RTN","DG53463",11,0) ; Quit if the user has already been added to the mail group "RTN","DG53463",12,0) Q:$D(^XMB(3.8,DGENDA(1),1,"B",DUZ)) "RTN","DG53463",13,0) ; "RTN","DG53463",14,0) ; Add the user to the MT INCONSISTENCIES Mail Group "RTN","DG53463",15,0) S DATA(.01)=DUZ "RTN","DG53463",16,0) I $$ADD^DGENDBS(3.81,.DGENDA,.DATA,.ERR) "RTN","DG53463",17,0) ; "RTN","DG53463",18,0) Q "RTN","DGMTSC") 0^1^B10775175 "RTN","DGMTSC",1,0) DGMTSC ;ALB/RMO,CAW,RTK,PDJ - Means Test Screen Driver ;02/04/03 "RTN","DGMTSC",2,0) ;;5.3;Registration;**182,327,372,433,463**;Aug 13, 1993 "RTN","DGMTSC",3,0) ; "RTN","DGMTSC",4,0) ;A series of screens used to collect the means test data "RTN","DGMTSC",5,0) ; Input -- DFN Patient IEN "RTN","DGMTSC",6,0) ; DGMTACT Means Test Action (ie, ADD to Add a Means Test) "RTN","DGMTSC",7,0) ; DGMTDT Date of Test "RTN","DGMTSC",8,0) ; DGMTI Annual Means Test IEN "RTN","DGMTSC",9,0) ; DTMTYPT Type of Test 1=MT 2=COPAY "RTN","DGMTSC",10,0) ; DGMTROU Option Routine Return "RTN","DGMTSC",11,0) ; Output -- None "RTN","DGMTSC",12,0) ; "RTN","DGMTSC",13,0) EN ;Entry point for means test screen driver "RTN","DGMTSC",14,0) D PRIOR^DGMTEVT:DGMTACT'="VEW",HOME^%ZIS,SETUP^DGMTSCU I DGERR D MG G Q1 "RTN","DGMTSC",15,0) EN1 ;Entry point to edit means test if incomplete "RTN","DGMTSC",16,0) S DGMTSCI=+$O(DGMTSC(0)) G @($$ROU^DGMTSCU(DGMTSCI)) "RTN","DGMTSC",17,0) ; "RTN","DGMTSC",18,0) Q I DGMTACT'="VEW" D EN^DGMTSCC I DGERR G EN1:$$EDT "RTN","DGMTSC",19,0) ; Added for LTC Co-pay Phase II - DG*5.3*433 "RTN","DGMTSC",20,0) I DGMTACT'="VEW",DGMTYPT=4 D G K "RTN","DGMTSC",21,0) .Q:$P($G(^DGMT(408.31,DGMTI,0)),U,3)="" ; LTC 4 test is incomplete "RTN","DGMTSC",22,0) .D AFTER^DGMTEVT S DGMTINF=0 "RTN","DGMTSC",23,0) .D EN^DGMTAUD,EN^IVMPMTE "RTN","DGMTSC",24,0) .D DATETIME^DGMTU4(DGMTI) "RTN","DGMTSC",25,0) .; If LTC copay exemption test is edited, update LTC copay test "RTN","DGMTSC",26,0) .I DGMTACT="EDT" D UPLTC3^EASECMT(DGMTI) "RTN","DGMTSC",27,0) Q1 I DGMTACT'="VEW" D AFTER^DGMTEVT S DGMTINF=0 D EN^DGMTEVT "RTN","DGMTSC",28,0) ; "RTN","DGMTSC",29,0) ;If the veteran has agreed to pay copay after previously refusing, "RTN","DGMTSC",30,0) ;automatically update their Primary Eligibility (327-Ineligible Project) "RTN","DGMTSC",31,0) I $D(DGMTP),$D(DGMTA) D "RTN","DGMTSC",32,0) .I $D(^DPT(DFN,.3)),$P(DGMTP,U,11)=0,$P(DGMTA,U,11)=1 D "RTN","DGMTSC",33,0) ..N DATA "RTN","DGMTSC",34,0) ..I $P(^DPT(DFN,.3),U)="Y" S DATA(.361)=$O(^DIC(8,"B","SC LESS THAN 50%","")) "RTN","DGMTSC",35,0) ..E S DATA(.361)=$O(^DIC(8,"B","NSC","")) "RTN","DGMTSC",36,0) ..I $$UPD^DGENDBS(2,DFN,.DATA) "RTN","DGMTSC",37,0) .;If the veteran has refused to pay copay, update ENROLLMENT "RTN","DGMTSC",38,0) .;PRIORITY to null. "RTN","DGMTSC",39,0) .I $P(DGMTA,U,11)=0 D "RTN","DGMTSC",40,0) ..S CUR=$$FINDCUR^DGENA(DFN) "RTN","DGMTSC",41,0) ..N DATA S DATA(.07)="@" I $$UPD^DGENDBS(27.11,CUR,.DATA) "RTN","DGMTSC",42,0) ; "RTN","DGMTSC",43,0) ; Added for LTC Copay Phase II (DG*5.2*433) "RTN","DGMTSC",44,0) ; If means test or copay test is edited and has a LTC copay exemption "RTN","DGMTSC",45,0) ; test associated with it, update the LTC copay exemption test. "RTN","DGMTSC",46,0) I DGMTACT="EDT",$O(^DGMT(408.31,"AT",DGMTI,0)) D LTC4^EASECMT(DGMTI) "RTN","DGMTSC",47,0) ; "RTN","DGMTSC",48,0) K K %,DGBL,DGDC,DGDEP,DGDR,DGFCOL,DGFL,DGMT0,DGMTA,DGMTINF,DGMTOUT,DGMTP,DGMTPAR,DGMTSC,DGMTSCI,DGREL,DGRNG,DGRPPR,DGSCOL,DGSEL,DGSELTY,DGVI,DGVINI,DGVIRI,DGVO,DGVPRI,DGX,DGY,DTOUT,DUOUT,Y,Z "RTN","DGMTSC",49,0) ; "RTN","DGMTSC",50,0) ; Validate record with consistency checks, when adding, editing, or "RTN","DGMTSC",51,0) ; completing either a means or copay test. "RTN","DGMTSC",52,0) K IVMERR,IVMAR,IVMAR2 "RTN","DGMTSC",53,0) I DGMTACT'="VEW" D INCON^DGMTUTL1(DFN,DGMTDT,DGMTI,DGMTYPT,.IVMERR),PROB^IVMCMFB(DGMTDT,.IVMERR,1) "RTN","DGMTSC",54,0) ; "RTN","DGMTSC",55,0) ;Update the TEST-DETERMINED STATUS field (#2.03) in the ANNUAL MEANS "RTN","DGMTSC",56,0) ;TEST file (408.31) when adding a means or copay test, completing a "RTN","DGMTSC",57,0) ;means test, or editing a means or copay test. "RTN","DGMTSC",58,0) I "ADDCOMEDT"[DGMTACT D SAVESTAT^DGMTU4(DGMTI,DGERR) "RTN","DGMTSC",59,0) K DGERR,IVMERR,ARRAY,ZIC,ZIR,ZMT,ZDP,IVMAR,IVMAR2 "RTN","DGMTSC",60,0) ; "RTN","DGMTSC",61,0) G @(DGMTROU) "RTN","DGMTSC",62,0) ; "RTN","DGMTSC",63,0) MG ;Print set-up error messages "RTN","DGMTSC",64,0) I $D(DGVPRI),DGVPRI'>0 W !!?3,"Patient Relation cannot be setup for patient." "RTN","DGMTSC",65,0) I $D(DGVINI),DGVINI'>0 W !!?3,"Individual Annual Income cannot be setup for patient." "RTN","DGMTSC",66,0) I $D(DGMTPAR),DGMTPAR']"",DGMTYPT=1 W !!?3,"Means Test Thresholds are not defined." "RTN","DGMTSC",67,0) W !?3,*7,"Please contact your site manager." "RTN","DGMTSC",68,0) Q "RTN","DGMTSC",69,0) ; "RTN","DGMTSC",70,0) EDT() ;Edit means/copay test if incomplete "RTN","DGMTSC",71,0) N DIR,Y "RTN","DGMTSC",72,0) S DIR("A")="Do you wish to edit the "_$S(DGMTYPT=1:"means",1:"copay exemption")_" test" "RTN","DGMTSC",73,0) S DIR("B")="YES",DIR(0)="Y" D ^DIR "RTN","DGMTSC",74,0) Q +$G(Y) "RTN","DGMTUTL1") 0^2^B7752700 "RTN","DGMTUTL1",1,0) DGMTUTL1 ;ALB/RMM - Means Test Consistency Checker ; 1/31/03 "RTN","DGMTUTL1",2,0) ;;5.3;Registration;**463**;Aug 13, 1993 "RTN","DGMTUTL1",3,0) ; "RTN","DGMTUTL1",4,0) ; "RTN","DGMTUTL1",5,0) ; Apply Consistency Checks to the Income Test Processes: ADD, "RTN","DGMTUTL1",6,0) ; EDIT, and COMPLETE. "RTN","DGMTUTL1",7,0) ; "RTN","DGMTUTL1",8,0) ; "RTN","DGMTUTL1",9,0) Q "RTN","DGMTUTL1",10,0) ; "RTN","DGMTUTL1",11,0) INCON(DFN,DGMTDT,DGMTI,IVMTYPE,IVMERR) ; "RTN","DGMTUTL1",12,0) ; Build the data strings for the veteran, and apply consistency checks "RTN","DGMTUTL1",13,0) ; "RTN","DGMTUTL1",14,0) ; Get information and initialize variables "RTN","DGMTUTL1",15,0) N CNT,I,HLFS,IEN,ARRAY,SPOUSE,DEP,DEPIEN,DGDEP,DGINC,DGINR,DGREL "RTN","DGMTUTL1",16,0) N ZIC,ZIR,ZMT,ZDP,ARRAY,DIEN "RTN","DGMTUTL1",17,0) S CNT=1,HLFS=U,SPOUSE=0 "RTN","DGMTUTL1",18,0) D ALL^DGMTU21(DFN,"VSC",DGMTDT) "RTN","DGMTUTL1",19,0) ; "RTN","DGMTUTL1",20,0) ; Build ZMT array for CC's "RTN","DGMTUTL1",21,0) S $P(ARRAY("ZMT"),U,2)=$P($G(^DGMT(408.31,DGMTI,0)),U,1) "RTN","DGMTUTL1",22,0) S $P(ARRAY("ZMT"),U,2)=$E($P(ARRAY("ZMT"),U,2),1,3)+1700_$E($P(ARRAY("ZMT"),U,2),4,7) "RTN","DGMTUTL1",23,0) S $P(ARRAY("ZMT"),U,3)=$P($G(^DGMT(408.31,DGMTI,0)),U,3) "RTN","DGMTUTL1",24,0) S $P(ARRAY("ZMT"),U,3)=$P(^DG(408.32,$P(ARRAY("ZMT"),U,3),0),U,2) "RTN","DGMTUTL1",25,0) ; "RTN","DGMTUTL1",26,0) ; Build Spouse ZIC, ZIR, and ZDP Arrays "RTN","DGMTUTL1",27,0) I $D(DGREL("S")) D "RTN","DGMTUTL1",28,0) .S SPOUSE=1 "RTN","DGMTUTL1",29,0) .; Use the Individual Annual Income File #408.21 "RTN","DGMTUTL1",30,0) .S ARRAY(SPOUSE,"ZIC")=$$ZIC^DGMTUTL2(DGINC("S"),SPOUSE) "RTN","DGMTUTL1",31,0) .; Use the Income Relation File #408.22 "RTN","DGMTUTL1",32,0) .S ARRAY(SPOUSE,"ZIR")=$$ZIR^DGMTUTL2(DGINR("S"),SPOUSE) "RTN","DGMTUTL1",33,0) .; Use Patient Relation File #408.12 and Income Person File #408.13 "RTN","DGMTUTL1",34,0) .S ARRAY(SPOUSE,"ZDP")=$$ZDP^DGMTUTL2(DGREL("S"),SPOUSE) "RTN","DGMTUTL1",35,0) ; "RTN","DGMTUTL1",36,0) ; Build Dependent ZIC, ZIR, and ZDP Arrays "RTN","DGMTUTL1",37,0) F IEN=1:1:DGDEP D "RTN","DGMTUTL1",38,0) .S DIEN=IEN+SPOUSE "RTN","DGMTUTL1",39,0) .; Use the Individual Annual Income File #408.21 "RTN","DGMTUTL1",40,0) .S ARRAY(DIEN,"ZIC")=$$ZIC^DGMTUTL2(DGINC("C",IEN),DIEN) "RTN","DGMTUTL1",41,0) .; Use the Income Relation File #408.22 "RTN","DGMTUTL1",42,0) .S ARRAY(DIEN,"ZIR")=$$ZIR^DGMTUTL2(DGINR("C",IEN),DIEN) "RTN","DGMTUTL1",43,0) .; Use Patient Relation File #408.12 and Income Person File #408.13 "RTN","DGMTUTL1",44,0) .S ARRAY(DIEN,"ZDP")=$$ZDP^DGMTUTL2(DGREL("C",IEN),DIEN) "RTN","DGMTUTL1",45,0) S DEP=DGDEP+SPOUSE "RTN","DGMTUTL1",46,0) ; "RTN","DGMTUTL1",47,0) ; Check the Individual Annual Income File #408.21 "RTN","DGMTUTL1",48,0) S ZIC=$$ZIC^DGMTUTL2(DGINC("V")) "RTN","DGMTUTL1",49,0) D ZIC^IVMCMF1(ZIC) "RTN","DGMTUTL1",50,0) ; "RTN","DGMTUTL1",51,0) ; Check the Income Relation File #408.22 "RTN","DGMTUTL1",52,0) S ZIR=$$ZIR^DGMTUTL2(DGINR("V"),DGMTDT) "RTN","DGMTUTL1",53,0) D ZIR^IVMCMF1(ZIR) "RTN","DGMTUTL1",54,0) ; "RTN","DGMTUTL1",55,0) ; Check the Annual Means Test File #408.31 "RTN","DGMTUTL1",56,0) I "^1^2^4^"[("^"_IVMTYPE_"^") D "RTN","DGMTUTL1",57,0) .S ZMT=$$ZMT^DGMTUTL2(DGMTI) "RTN","DGMTUTL1",58,0) .; Create array for Income Calculator "RTN","DGMTUTL1",59,0) .M ARRAY("ZIC")=ZIC "RTN","DGMTUTL1",60,0) .D ZMT^IVMCMF2(ZMT) "RTN","DGMTUTL1",61,0) ; "RTN","DGMTUTL1",62,0) ; Apply the Consistency Checks to the dependent information "RTN","DGMTUTL1",63,0) F IEN=1:1:DEP D "RTN","DGMTUTL1",64,0) .; Check Patient Relation File #408.12 and Income Person File #408.13 "RTN","DGMTUTL1",65,0) .D ZDP^IVMCMF2(ARRAY(IEN,"ZDP"),IEN) "RTN","DGMTUTL1",66,0) .; Check the Individual Annual Income File #408.21 "RTN","DGMTUTL1",67,0) .D ZIC^IVMCMF1(ARRAY(IEN,"ZIC"),IEN) "RTN","DGMTUTL1",68,0) .; Check the Income Relation File #408.22 "RTN","DGMTUTL1",69,0) .D ZIR^IVMCMF1(ARRAY(IEN,"ZIR"),IEN) "RTN","DGMTUTL1",70,0) ; "RTN","DGMTUTL1",71,0) Q "RTN","DGMTUTL2") 0^3^B27008069 "RTN","DGMTUTL2",1,0) DGMTUTL2 ;ALB/RMM - Means Test Consistency Checker ; 1/31/03 "RTN","DGMTUTL2",2,0) ;;5.3;Registration;**463**;Aug 13, 1993 "RTN","DGMTUTL2",3,0) ; "RTN","DGMTUTL2",4,0) ; "RTN","DGMTUTL2",5,0) ; "RTN","DGMTUTL2",6,0) ; "RTN","DGMTUTL2",7,0) ; "RTN","DGMTUTL2",8,0) ZIC(VAFIEN,DEPIEN) ; Build ZIC the data string for the veteran "RTN","DGMTUTL2",9,0) ; "RTN","DGMTUTL2",10,0) N NODE0,NODE1,NODE2,ZIC "RTN","DGMTUTL2",11,0) S NODE0=$G(^DGMT(408.21,VAFIEN,0)) "RTN","DGMTUTL2",12,0) S NODE1=$G(^DGMT(408.21,VAFIEN,1)) "RTN","DGMTUTL2",13,0) S NODE2=$G(^DGMT(408.21,VAFIEN,2)) "RTN","DGMTUTL2",14,0) S ZIC="ZIC" "RTN","DGMTUTL2",15,0) S $P(ZIC,U,2)=$P(NODE0,U,1) ;Income Year "RTN","DGMTUTL2",16,0) S $P(ZIC,U,3)=$P(NODE0,U,8) ;Social Security "RTN","DGMTUTL2",17,0) S $P(ZIC,U,4)=$P(NODE0,U,9) ;U.S. Civil Service "RTN","DGMTUTL2",18,0) S $P(ZIC,U,5)=$P(NODE0,U,10) ;U.S. Railroad Retirement "RTN","DGMTUTL2",19,0) S $P(ZIC,U,6)=$P(NODE0,U,11) ;Military Retirement "RTN","DGMTUTL2",20,0) S $P(ZIC,U,7)=$P(NODE0,U,12) ;Unemployment Compensation "RTN","DGMTUTL2",21,0) S $P(ZIC,U,9)=$P(NODE0,U,14) ;Total Income from Employment "RTN","DGMTUTL2",22,0) S $P(ZIC,U,10)=$P(NODE0,U,15) ;Interest,Dividend,Annuity "RTN","DGMTUTL2",23,0) S $P(ZIC,U,11)=$P(NODE0,U,16) ;Workers Comp. or Black Lung "RTN","DGMTUTL2",24,0) S $P(ZIC,U,12)=$P(NODE0,U,17) ;All Other Income "RTN","DGMTUTL2",25,0) S $P(ZIC,U,13)=$P(NODE1,U,1) ;Medical Expenses "RTN","DGMTUTL2",26,0) S $P(ZIC,U,14)=$P(NODE1,U,2) ;Funeral And Burial Expenses "RTN","DGMTUTL2",27,0) S $P(ZIC,U,15)=$P(NODE1,U,3) ;Educational Expenses "RTN","DGMTUTL2",28,0) S $P(ZIC,U,16)=$P(NODE2,U,1) ;Cash, Amount In Bank Accounts "RTN","DGMTUTL2",29,0) S $P(ZIC,U,17)=$P(NODE2,U,2) ;Stocks And Bonds "RTN","DGMTUTL2",30,0) S $P(ZIC,U,18)=$P(NODE2,U,3) ;Real Property "RTN","DGMTUTL2",31,0) S $P(ZIC,U,19)=$P(NODE2,U,4) ;Other Property or Assets "RTN","DGMTUTL2",32,0) S $P(ZIC,U,20)=$P(NODE2,U,5) ;Debts "RTN","DGMTUTL2",33,0) ; "RTN","DGMTUTL2",34,0) ; Adjust date field to correct format "RTN","DGMTUTL2",35,0) S $P(ZIC,U,2)=$E($P(ZIC,U,2),1,3)+1700_$E($P(ZIC,U,2),4,7) "RTN","DGMTUTL2",36,0) ; "RTN","DGMTUTL2",37,0) Q ZIC "RTN","DGMTUTL2",38,0) ; "RTN","DGMTUTL2",39,0) ZIR(VAFIEN,DEPIEN) ; Build ZIR the data string for the veteran "RTN","DGMTUTL2",40,0) ; "RTN","DGMTUTL2",41,0) N NODE0,ZIR "RTN","DGMTUTL2",42,0) S NODE0=$G(^DGMT(408.22,VAFIEN,0)),ZIR="ZIR" "RTN","DGMTUTL2",43,0) S $P(ZIR,U,2)=$P(NODE0,U,5) ;Married Last Calendar Year "RTN","DGMTUTL2",44,0) S $P(ZIR,U,3)=$P(NODE0,U,6) ;Lived With Patient "RTN","DGMTUTL2",45,0) S $P(ZIR,U,4)=$P(NODE0,U,7) ;Amount Contributed to Spouse "RTN","DGMTUTL2",46,0) S $P(ZIR,U,5)=$P(NODE0,U,8) ;Dependent Children "RTN","DGMTUTL2",47,0) S $P(ZIR,U,6)=$P(NODE0,U,9) ;Incapable of Self Suppoort "RTN","DGMTUTL2",48,0) S $P(ZIR,U,7)=$P(NODE0,U,10) ;Contributed to Support "RTN","DGMTUTL2",49,0) S $P(ZIR,U,8)=$P(NODE0,U,11) ;Child Had Income "RTN","DGMTUTL2",50,0) S $P(ZIR,U,9)=$P(NODE0,U,12) ;Income Available to You "RTN","DGMTUTL2",51,0) S $P(ZIR,U,10)=$P(NODE0,U,13) ;Number of Dependent Children "RTN","DGMTUTL2",52,0) Q ZIR "RTN","DGMTUTL2",53,0) ; "RTN","DGMTUTL2",54,0) ZMT(DGMTI) ; Build ZMT the data string for the veteran "RTN","DGMTUTL2",55,0) ; "RTN","DGMTUTL2",56,0) N NODE0,NODE2,ZMT "RTN","DGMTUTL2",57,0) S NODE0=$G(^DGMT(408.31,DGMTI,0)) "RTN","DGMTUTL2",58,0) S NODE2=$G(^DGMT(408.31,DGMTI,2)),ZMT="ZMT" "RTN","DGMTUTL2",59,0) S $P(ZMT,U,2)=$P(NODE0,U,1) ;Means Test Date "RTN","DGMTUTL2",60,0) S $P(ZMT,U,3)=$P(NODE0,U,3) ;Means Test Status "RTN","DGMTUTL2",61,0) S $P(ZMT,U,4)=$P(NODE0,U,4) ;Income "RTN","DGMTUTL2",62,0) S $P(ZMT,U,5)=$P(NODE0,U,5) ;Net Worth "RTN","DGMTUTL2",63,0) S $P(ZMT,U,6)=$P(NODE0,U,10) ;Date/Time of Adjudication "RTN","DGMTUTL2",64,0) S $P(ZMT,U,7)=$P(NODE0,U,11) ;Agreed to Pay Deductible "RTN","DGMTUTL2",65,0) S $P(ZMT,U,8)=$P(NODE0,U,12) ;Threshold A "RTN","DGMTUTL2",66,0) S $P(ZMT,U,9)=$P(NODE0,U,15) ;Deductible Expenses "RTN","DGMTUTL2",67,0) S $P(ZMT,U,10)=$P(NODE0,U,7) ;Date/Time MT Completed "RTN","DGMTUTL2",68,0) S $P(ZMT,U,11)=$P(NODE0,U,16) ;Previous Yr MT Threshold Flag "RTN","DGMTUTL2",69,0) S $P(ZMT,U,12)=$P(NODE0,U,18) ;Total Dependents "RTN","DGMTUTL2",70,0) S $P(ZMT,U,13)=$P(NODE0,U,20) ;Hardship "RTN","DGMTUTL2",71,0) S $P(ZMT,U,14)=$P(NODE0,U,21) ;Hardship Review Date "RTN","DGMTUTL2",72,0) S $P(ZMT,U,15)=$P(NODE0,U,24) ;Date Veteran Signed Test "RTN","DGMTUTL2",73,0) S $P(ZMT,U,16)=$P(NODE0,U,14) ;Declines to Give Income Info "RTN","DGMTUTL2",74,0) S $P(ZMT,U,17)=$P(NODE0,U,19) ;Type of Test "RTN","DGMTUTL2",75,0) S $P(ZMT,U,18)=$P(NODE0,U,23) ;Source of Income Test "RTN","DGMTUTL2",76,0) S $P(ZMT,U,19)=$P($G(^DGMT(408.31,DGMTI,"PRIM")),U,1) ;Primary Test? "RTN","DGMTUTL2",77,0) S $P(ZMT,U,20)=$P(NODE0,U,25) ;Date IVM Verif. MT Completed "RTN","DGMTUTL2",78,0) S $P(ZMT,U,21)=$P(NODE0,U,26) ;Refused To Sign "RTN","DGMTUTL2",79,0) S $P(ZMT,U,22)=$P(NODE2,U,5) ;Site Conducting Test "RTN","DGMTUTL2",80,0) S $P(ZMT,U,23)=$P(NODE2,U,4) ;Hardship Review Site "RTN","DGMTUTL2",81,0) S $P(ZMT,U,24)=$P(NODE2,U,1) ;Hardship Effective Date "RTN","DGMTUTL2",82,0) S $P(ZMT,U,25)=$P(NODE2,U,2) ;Date/Time Test Last Edited "RTN","DGMTUTL2",83,0) S $P(ZMT,U,26)=$P(NODE2,U,3) ;Test Determined Status "RTN","DGMTUTL2",84,0) S $P(ZMT,U,28)=$P(NODE0,U,27) ;GMT Threshold "RTN","DGMTUTL2",85,0) ; "RTN","DGMTUTL2",86,0) ; Adjust date fields to correct format "RTN","DGMTUTL2",87,0) S $P(ZMT,U,2)=$E($P(ZMT,U,2),1,3)+1700_$E($P(ZMT,U,2),4,7) "RTN","DGMTUTL2",88,0) S $P(ZMT,U,10)=$E($P(ZMT,U,10),1,3)+1700_$E($P(ZMT,U,10),4,7) "RTN","DGMTUTL2",89,0) S $P(ZMT,U,25)=$E($P(ZMT,U,25),1,3)+1700_$E($P(ZMT,U,25),4,7)_$P($P(ZMT,U,25),".",2)_"-400" "RTN","DGMTUTL2",90,0) ; "RTN","DGMTUTL2",91,0) ; Change Status IENs to Codes "RTN","DGMTUTL2",92,0) S:$P(ZMT,U,26)="" $P(ZMT,U,26)=$P(ZMT,U,3) "RTN","DGMTUTL2",93,0) S $P(ZMT,U,3)=$P(^DG(408.32,$P(ZMT,U,3),0),U,2) "RTN","DGMTUTL2",94,0) S $P(ZMT,U,26)=$P(^DG(408.32,$P(ZMT,U,26),0),U,2) "RTN","DGMTUTL2",95,0) ; "RTN","DGMTUTL2",96,0) Q ZMT "RTN","DGMTUTL2",97,0) ; "RTN","DGMTUTL2",98,0) ZDP(VAFIEN,DEPIEN) ; Build ZDP the data string for the veteran "RTN","DGMTUTL2",99,0) ; "RTN","DGMTUTL2",100,0) N NODE0,NODER,DGPR,ZDP,LIEN "RTN","DGMTUTL2",101,0) S NODE0=$G(^DGPR(408.12,+VAFIEN,0)),ZDP="ZDP" "RTN","DGMTUTL2",102,0) S DGPR=+$P(NODE0,U,3),NODER=^DGPR(408.13,DGPR,0) "RTN","DGMTUTL2",103,0) S $P(ZDP,U,2)=$P(NODER,U,1) ;Name "RTN","DGMTUTL2",104,0) S $P(ZDP,U,3)=$P(NODER,U,2) ;Sex "RTN","DGMTUTL2",105,0) S $P(ZDP,U,4)=$P(NODER,U,3) ;Date of Birth "RTN","DGMTUTL2",106,0) S $P(ZDP,U,5)=$P(NODER,U,9) ;Social Security Number "RTN","DGMTUTL2",107,0) S $P(ZDP,U,6)=$P(NODE0,U,2) ;Relationship To Patient "RTN","DGMTUTL2",108,0) S $P(ZDP,U,7)=+VAFIEN ;Internal Entry Number "RTN","DGMTUTL2",109,0) S LIEN=$O(^DGPR(408.12,+VAFIEN,"E","AID"),-1) "RTN","DGMTUTL2",110,0) S $P(ZDP,U,9)=+^DGPR(408.12,+VAFIEN,"E",LIEN,0) "RTN","DGMTUTL2",111,0) ; "RTN","DGMTUTL2",112,0) ; Change format to match CC format "RTN","DGMTUTL2",113,0) S $P(ZDP,U,2)=$TR($P(ZDP,U,2),",","~") "RTN","DGMTUTL2",114,0) S $P(ZDP,U,4)=$E($P(ZDP,U,4),1,3)+1700_$E($P(ZDP,U,4),4,7) "RTN","DGMTUTL2",115,0) S $P(ZDP,U,9)=$E($P(ZDP,U,9),1,3)+1700_$E($P(ZDP,U,9),4,7) "RTN","DGMTUTL2",116,0) ; "RTN","DGMTUTL2",117,0) Q ZDP "VER") 8.0^22 **END** **END**