DG53672D ;ALB/ERC - PATCH INSTALL UTILITIES FOR DG 672 ; 9/21/05 4:32pm
;;5.3;Registration;**672**; Aug 13, 1993
;convert values from Patient file, field .362 (Disability Retirement
;from the Military) and 1010.158 (Disability Discharge on 1010EZ)
;to two new fields, Military Disability Retirement (.3602) and
;Discharge Due to Disability? (.3603)
;
;for field .362 values converted to .3602
; 0 (NO) not converted
; 1 (YES, RECEIVING MILITARY RETIREMENT) converted to 1(yes)
; 2 (YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION)
; converted to 1(yes)
; 3 (UNKNOWN) not converted
;for field 1010.158 to .3603
; 0 (NO) to 0
; 1 (YES) to 1
;
;this routine is called from DG53672C
;
EN(DFN) ;entry from DG53672C
N DGD,DGFDA,DGDIS,DGERR,DGLOD,DGRAND
D GETS^DIQ(2,DFN_",",".362;1010.158","I","DGD","DGERR")
S DGDIS=$G(DGD(2,DFN_",",.362,"I"))
S DGLOD=$G(DGD(2,DFN_",",1010.158,"I"))
I $G(DGLOD)]"" D
. D LOD
. S ^XTMP("DG53672C","DG53672D",1010.158,"CNT")=$G(^XTMP("DG53672C","DG53672D",1010.158,"CNT"))+1
I $G(DGDIS)=1!($G(DGDIS)=2) D
. D DIS
. S ^XTMP("DG53672C","DG53672D",.362,"CNT")=$G(^XTMP("DG53672C","DG53672D",.362,"CNT"))+1
FILE ;
D FILE^DIE("K","DGFDA","DGERR")
I $G(DGERR)']"" D
.I $G(DGDIS)]"" D
. . S ^XTMP("DG53672C","DG53672D","DATA",.362,DGDIS)=$G(^XTMP("DG53672C","DG53672D","DATA",".362",DGDIS))+1
. I $G(DGLOD)]"" D
. . S ^XTMP("DG53672C","DG53672D","DATA",1010.158,DGLOD)=$G(^XTMP("DG53672C","DG53672D","DATA","1010.158",DGLOD))+1
Q
;
DIS ;convert Disability Retirement to new fields
S DGFDA(2,DFN_",",.3602)=1
I $G(DGFDA(2,DFN_",",.3603))']"" S DGFDA(2,DFN_",",.3603)=1
Q
;
LOD ;Discharge Due to Disability is populated
S DGFDA(2,DFN_",",.3603)=DGLOD
Q
;
SNDMSG ; Send Mailman bulletin when process completes
N SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG
S SITE=$$SITE^VASITE,STATN=$P($G(SITE),U,3),SITENM=$P($G(SITE),U,2)
S:$$GET1^DIQ(869.3,"1,",.03,"I")'="P" STATN=STATN_" [TEST]"
S XMDUZ="DISABILITY RETIREMENT DATA CONVERSION",XMSUB=XMDUZ_" - "_STATN
S SITE=$$SITE^VASITE,STATN=$P($G(SITE),U,3),SITENM=$P($G(SITE),U,2)
S:$$GET1^DIQ(869.3,"1,",.03,"I")'="P" STATN=STATN_" [TEST]"
S XMDUZ="DISABILITY RETIREMENT DATA CONVERSION",XMSUB=XMDUZ_" - "_STATN
S XMY(DUZ)=""
S XMY("CURTIN,EDNA@MNTVMM.FO-ALBANY")=""
S XMTEXT="MSG("
S MSG(1)="The Disability Retirement Data Conversion has completed successfully."
S MSG(2)="Fields .362 (DISABILITY RET. FROM MILITARY?) and 1010.158 (DISABILITY"
S MSG(3)="DISCHARGE ON 1010EZ), both in the Patient file, have been converted"
S MSG(4)="to fields .3602 (MILITARY DISABILITY RETIREMENT) and .3603 (DISCHARGE DUE"
S MSG(5)="TO DISABILITY), according to the following algorithm:"
S MSG(6)=" value of 'Yes' in 1010.158 is now 'Yes' in field .3603"
S MSG(7)=" value of 'No' in 1010.158 is now 'No' in field .3603"
S MSG(8)=""
S MSG(9)=" value of 1 or 2 in .362 is now 'Yes' in .3602 and .3603"
S MSG(10)=" value of 0 or 3 in .362 was not converted"
S MSG(12)=""
S MSG(13)="Task: "_$G(^XTMP("DG53672C",0,"TASK"))
S MSG(14)="Site Station Number: "_STATN
S MSG(15)="Site Name: "_SITENM
S MSG(16)=""
S MSG(17)="Process started : "_$$FMTE^XLFDT($P($G(^XTMP("DG53672C",0)),U,2))
S MSG(18)="Process completed : "_$$FMTE^XLFDT($P($G(^XTMP("DG53672C",0)),"^",4))
S MSG(19)=""
S MSG(20)="Total Patients processed : "_+$G(^XTMP("DG53672C","TCNT"))
S MSG(21)="Total with 'Yes' in 1010.158: "_+$G(^XTMP("DG53672C","DG53672D","DATA","1010.158",1))
S MSG(22)="Total with 'No' in 1010.158: "_+$G(^XTMP("DG53672C","DG53672D","DATA","1010.158",0))
S MSG(23)="Total with 1 in .362: "_+$G(^XTMP("DG53672C","DG53672D","DATA",".362",1))
S MSG(24)="Total with 2 in .362: "_+$G(^XTMP("DG53672C","DG53672D","DATA",".362",2))
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53672D 3886 printed Sep 23, 2025@20:14:08 Page 2
DG53672D ;ALB/ERC - PATCH INSTALL UTILITIES FOR DG 672 ; 9/21/05 4:32pm
+1 ;;5.3;Registration;**672**; Aug 13, 1993
+2 ;convert values from Patient file, field .362 (Disability Retirement
+3 ;from the Military) and 1010.158 (Disability Discharge on 1010EZ)
+4 ;to two new fields, Military Disability Retirement (.3602) and
+5 ;Discharge Due to Disability? (.3603)
+6 ;
+7 ;for field .362 values converted to .3602
+8 ; 0 (NO) not converted
+9 ; 1 (YES, RECEIVING MILITARY RETIREMENT) converted to 1(yes)
+10 ; 2 (YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION)
+11 ; converted to 1(yes)
+12 ; 3 (UNKNOWN) not converted
+13 ;for field 1010.158 to .3603
+14 ; 0 (NO) to 0
+15 ; 1 (YES) to 1
+16 ;
+17 ;this routine is called from DG53672C
+18 ;
EN(DFN) ;entry from DG53672C
+1 NEW DGD,DGFDA,DGDIS,DGERR,DGLOD,DGRAND
+2 DO GETS^DIQ(2,DFN_",",".362;1010.158","I","DGD","DGERR")
+3 SET DGDIS=$GET(DGD(2,DFN_",",.362,"I"))
+4 SET DGLOD=$GET(DGD(2,DFN_",",1010.158,"I"))
+5 IF $GET(DGLOD)]""
Begin DoDot:1
+6 DO LOD
+7 SET ^XTMP("DG53672C","DG53672D",1010.158,"CNT")=$GET(^XTMP("DG53672C","DG53672D",1010.158,"CNT"))+1
End DoDot:1
+8 IF $GET(DGDIS)=1!($GET(DGDIS)=2)
Begin DoDot:1
+9 DO DIS
+10 SET ^XTMP("DG53672C","DG53672D",.362,"CNT")=$GET(^XTMP("DG53672C","DG53672D",.362,"CNT"))+1
End DoDot:1
FILE ;
+1 DO FILE^DIE("K","DGFDA","DGERR")
+2 IF $GET(DGERR)']""
Begin DoDot:1
+3 IF $GET(DGDIS)]""
Begin DoDot:2
+4 SET ^XTMP("DG53672C","DG53672D","DATA",.362,DGDIS)=$GET(^XTMP("DG53672C","DG53672D","DATA",".362",DGDIS))+1
End DoDot:2
+5 IF $GET(DGLOD)]""
Begin DoDot:2
+6 SET ^XTMP("DG53672C","DG53672D","DATA",1010.158,DGLOD)=$GET(^XTMP("DG53672C","DG53672D","DATA","1010.158",DGLOD))+1
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
DIS ;convert Disability Retirement to new fields
+1 SET DGFDA(2,DFN_",",.3602)=1
+2 IF $GET(DGFDA(2,DFN_",",.3603))']""
SET DGFDA(2,DFN_",",.3603)=1
+3 QUIT
+4 ;
LOD ;Discharge Due to Disability is populated
+1 SET DGFDA(2,DFN_",",.3603)=DGLOD
+2 QUIT
+3 ;
SNDMSG ; Send Mailman bulletin when process completes
+1 NEW SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG
+2 SET SITE=$$SITE^VASITE
SET STATN=$PIECE($GET(SITE),U,3)
SET SITENM=$PIECE($GET(SITE),U,2)
+3 if $$GET1^DIQ(869.3,"1,",.03,"I")'="P"
SET STATN=STATN_" [TEST]"
+4 SET XMDUZ="DISABILITY RETIREMENT DATA CONVERSION"
SET XMSUB=XMDUZ_" - "_STATN
+5 SET SITE=$$SITE^VASITE
SET STATN=$PIECE($GET(SITE),U,3)
SET SITENM=$PIECE($GET(SITE),U,2)
+6 if $$GET1^DIQ(869.3,"1,",.03,"I")'="P"
SET STATN=STATN_" [TEST]"
+7 SET XMDUZ="DISABILITY RETIREMENT DATA CONVERSION"
SET XMSUB=XMDUZ_" - "_STATN
+8 SET XMY(DUZ)=""
+9 SET XMY("CURTIN,EDNA@MNTVMM.FO-ALBANY")=""
+10 SET XMTEXT="MSG("
+11 SET MSG(1)="The Disability Retirement Data Conversion has completed successfully."
+12 SET MSG(2)="Fields .362 (DISABILITY RET. FROM MILITARY?) and 1010.158 (DISABILITY"
+13 SET MSG(3)="DISCHARGE ON 1010EZ), both in the Patient file, have been converted"
+14 SET MSG(4)="to fields .3602 (MILITARY DISABILITY RETIREMENT) and .3603 (DISCHARGE DUE"
+15 SET MSG(5)="TO DISABILITY), according to the following algorithm:"
+16 SET MSG(6)=" value of 'Yes' in 1010.158 is now 'Yes' in field .3603"
+17 SET MSG(7)=" value of 'No' in 1010.158 is now 'No' in field .3603"
+18 SET MSG(8)=""
+19 SET MSG(9)=" value of 1 or 2 in .362 is now 'Yes' in .3602 and .3603"
+20 SET MSG(10)=" value of 0 or 3 in .362 was not converted"
+21 SET MSG(12)=""
+22 SET MSG(13)="Task: "_$GET(^XTMP("DG53672C",0,"TASK"))
+23 SET MSG(14)="Site Station Number: "_STATN
+24 SET MSG(15)="Site Name: "_SITENM
+25 SET MSG(16)=""
+26 SET MSG(17)="Process started : "_$$FMTE^XLFDT($PIECE($GET(^XTMP("DG53672C",0)),U,2))
+27 SET MSG(18)="Process completed : "_$$FMTE^XLFDT($PIECE($GET(^XTMP("DG53672C",0)),"^",4))
+28 SET MSG(19)=""
+29 SET MSG(20)="Total Patients processed : "_+$GET(^XTMP("DG53672C","TCNT"))
+30 SET MSG(21)="Total with 'Yes' in 1010.158: "_+$GET(^XTMP("DG53672C","DG53672D","DATA","1010.158",1))
+31 SET MSG(22)="Total with 'No' in 1010.158: "_+$GET(^XTMP("DG53672C","DG53672D","DATA","1010.158",0))
+32 SET MSG(23)="Total with 1 in .362: "_+$GET(^XTMP("DG53672C","DG53672D","DATA",".362",1))
+33 SET MSG(24)="Total with 2 in .362: "_+$GET(^XTMP("DG53672C","DG53672D","DATA",".362",2))
+34 DO ^XMD
+35 QUIT
