- 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 Jan 18, 2025@03:38:59 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