DG53P624 ;ALB/CMF - PATCH DG*5.3*624 INSTALL UTILITIES ; 09/30/04 8:14am
;;5.3;Registration;**624,1015**;Aug 13, 1993;Build 21
;
ENV ;Main entry point for Environment check point.
;
S XPDABORT=""
D PROGCHK(.XPDABORT) ;checks programmer variables
I XPDABORT="" K XPDABORT
Q
;
;
PRE ;Main entry point for Pre-init items.
;
Q
;
;
POST ;Main entry point for Post-init items.
D MAPRS
D BULLETIN
Q
;
MAPRS ; set maximum annual pension rate parameters
D BMES^XPDUTL("*****")
D MES^XPDUTL("Setting Maximum Annual Pension Rate Parameters")
;
;set MAPR rate parameter to 5(%)
D SETPARM("DGMT MAPR GLOBAL RATE",1999,5)
D SETPARM("DGMT MAPR GLOBAL RATE",2000,5)
D SETPARM("DGMT MAPR GLOBAL RATE",2001,5)
D SETPARM("DGMT MAPR GLOBAL RATE",2002,5)
D SETPARM("DGMT MAPR GLOBAL RATE",2003,5)
D SETPARM("DGMT MAPR GLOBAL RATE",2004,5)
;
;set MAPR max values
D SETPARM("DGMT MAPR 0 DEPENDENTS",1999,8989)
D SETPARM("DGMT MAPR 0 DEPENDENTS",2000,9304)
D SETPARM("DGMT MAPR 0 DEPENDENTS",2001,9556)
D SETPARM("DGMT MAPR 0 DEPENDENTS",2002,9690)
D SETPARM("DGMT MAPR 0 DEPENDENTS",2003,9894)
D SETPARM("DGMT MAPR 0 DEPENDENTS",2004,10162)
;
D SETPARM("DGMT MAPR 1 DEPENDENTS",1999,11773)
D SETPARM("DGMT MAPR 1 DEPENDENTS",2000,12186)
D SETPARM("DGMT MAPR 1 DEPENDENTS",2001,12516)
D SETPARM("DGMT MAPR 1 DEPENDENTS",2002,12692)
D SETPARM("DGMT MAPR 1 DEPENDENTS",2003,12959)
D SETPARM("DGMT MAPR 1 DEPENDENTS",2004,13309)
;
D SETPARM("DGMT MAPR N DEPENDENTS",1999,1532)
D SETPARM("DGMT MAPR N DEPENDENTS",2000,1586)
D SETPARM("DGMT MAPR N DEPENDENTS",2001,1630)
D SETPARM("DGMT MAPR N DEPENDENTS",2002,1653)
D SETPARM("DGMT MAPR N DEPENDENTS",2003,1688)
D SETPARM("DGMT MAPR N DEPENDENTS",2004,1734)
;
D MES^XPDUTL("...Rates set.")
D MES^XPDUTL("*****")
Q
;
SETPARM(DGPARM,DGINST,DGVALU) ;set PACKAGE entity parameters
;
; DBIA: #2263 SUPPORTED PARAMETER TOOL ENTRY POINTS
;
; Input:
; DGPARM - PARAMETER DEFINITION name
; DGINST - parameter instance
; DGVALU - parameter value
;
; Output:
; None
;
N DGERR
;
D EN^XPAR("PKG",DGPARM,DGINST,DGVALU,.DGERR)
I '$G(DGERR) D
.D MES^XPDUTL(DGPARM_" parameter, instance "_DGINST_", set to "_DGVALU_".")
E D
.D MES^XPDUTL(DGPARM_" parameter, instance "_DGINST_", FAILED! ("_DGVALU_")")
Q
;
;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
;
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
.D BMES^XPDUTL("*****")
.D MES^XPDUTL("Your programming variables are not set up properly.")
.D MES^XPDUTL("Installation aborted.")
.D MES^XPDUTL("*****")
.S XPDABORT=2
Q
;
BULLETIN ;
N ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE
S ZTDTH=$H
S ZTIO=""
S ZTDESC="DG*5.3*624 Post-Install message"
S ZTRTN="DQMESS^DG53P624"
S ZTSAVE("DUZ")=""
S ZTSAVE("JVAL")=$J
D ^%ZTLOAD
I $G(ZTSK) D BMES^XPDUTL("POST-INSTALL CLEANUP MESSAGE QUEUED TO SEND")
I '$G(ZTSK) D BMES^XPDUTL("PROBLEM: POST-INSTALL CLEANUP MESSAGE NOT SENT")
;
I $D(^XTMP("DG",$J,"PATCH 624 ERROR MESSAGE")) DO
. D BMES^XPDUTL("PROBLEM SENDING MESSAGE")
. D MES^XPDUTL("CHECK FOR ^XTMP(""DG"",$J,""PATCH 624 CLEANUP BULLETIN"") GLOBAL")
. D MES^XPDUTL("CHECK FOR ^XTMP(""DG"",$J,""PATCH 624 ERROR MESSAGE"") GLOBAL")
D BMES^XPDUTL("Means Test database cleanup has been completed. Check your VA Mailman")
D MES^XPDUTL("mailbox for the ""DG*5.3*624 External value cleanup"" message.")
D BMES^XPDUTL("If you do not receive an E-mail, remember to check the following globals:")
D MES^XPDUTL(" ^XTMP(""DG"",$J,""PATCH 624 CLEANUP BULLETIN"")")
D MES^XPDUTL(" ^XTMP(""DG"",$J,""PATCH 624 ERROR MESSAGE"")")
Q
;
DQMESS ;
N DGMMLNE
;*Create bulletin head to identify cleanup records
K ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN")
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",1)="This message indicates the patients in the Income Person file (408.13)"
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",2)=" and the Income Relation file (408.22) that have had external values"
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",3)=" in the STATE, LIVED WITH PATIENT, and CONTRIBUTED TO SUPPORT"
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",4)=" fields converted to internal pointer or set of code values."
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",5)=" "
S DGMMLNE=6
;
;*Perform cleanup
D STATE
D CLEAN
;
;*Send message
I $O(^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",11))="" DO
.S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",11)=" "
.S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",12)=" No corrupted records found."
.S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",13)=" "
;
;* Queue message to be sent
S XMSUB="DG*5.3*624 External value cleanup"
S XMDUZ="DG*5.3*624 Install Cleanup"
S XMTEXT="^XTMP(""DG"",JVAL,""PATCH 624 CLEANUP BULLETIN"","
S XMY(DUZ)=""
S XMY(.5)=""
S XMY("G.EAS_1_57@FORUM.VA.GOV")=""
D ^XMD
S DGMMLNE=$P($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")_U_$G(XMMG)_U_$G(XMZ)
S ^XTMP("DG",JVAL,"PATCH 624 ERROR MESSAGE",0)=DGMMLNE
S DGMMLNE=$P($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",0)=DGMMLNE
I '$D(XMMG) K ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN")
Q
;
STATE ;Correct STATE field in 408.13/1.6 with text instead of pointers
N DA,STATE,PTR
;* Setup message text
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking STATE field (1.6) in the INCOME PERSON file (408.13)..."
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
S DGMMLNE=DGMMLNE+1
;
S DA=0 F S DA=$O(^DGPR(408.13,DA)) Q:'DA D
. Q:'$D(^DGPR(408.13,DA,1))
. S STATE=$P(^DGPR(408.13,DA,1),"^",6)
. Q:(+STATE=STATE) Q:(STATE']"")
. S PTR=$O(^DIC(5,"B",STATE,""))
. S $P(^DGPR(408.13,DA,1),"^",6)=PTR
.;
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" State for "_$P(^DGPR(408.13,DA,0),"^",1)_"'s entry "_DA_" has been changed: "
. S DGMMLNE=DGMMLNE+1
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_STATE_" has been changed to "_PTR_" IEN from STATE file (5)."
. S DGMMLNE=DGMMLNE+1
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
. S DGMMLNE=DGMMLNE+1
Q
;
CLEAN ;Clean up text "YES" and "NO" values in 408.22/.06 and 408.22/.1
N DA,LWP,CTS
;*Setup message text
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking LIVED WITH PATIENT field (.06) in the INCOME RELATION file (408.22)..."
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
S DGMMLNE=DGMMLNE+1
;
S DA=0 F S DA=$O(^DGMT(408.22,DA)) Q:'DA D
. S LWP=$P($G(^DGMT(408.22,DA,0)),"^",6) ;Lived With Patient
. Q:(+LWP=LWP) Q:(LWP']"")
. S $P(^DGMT(408.22,DA,0),"^",6)=$S(LWP="YES":1,LWP="NO":0,1:"")
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" LIVED WITH PATIENT for "_$P($G(^DPT($P($G(^DGMT(408.22,DA,0)),"^",1),0)),"^",1)_"'s entry "_DA_" has been changed: "
. S DGMMLNE=DGMMLNE+1
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_LWP_" has been changed to "_$S(LWP="YES":1,LWP="NO":0,1:"NULL")_"."
. S DGMMLNE=DGMMLNE+1
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
. S DGMMLNE=DGMMLNE+1
.;
. S DIK="^DGMT(408.22,"
. S DIK(1)=".06"
. D EN^DIK
. K DIK
;
;
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking CONTRIBUTED TO SUPPORT field (.1) in the INCOME RELATION file (408.22)..."
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
S DGMMLNE=DGMMLNE+1
;
S DA=0 F S DA=$O(^DGMT(408.22,DA)) Q:'DA D
. S CTS=$P($G(^DGMT(408.22,DA,0)),"^",10) ;Contributed To Support
. Q:(+CTS=CTS) Q:(CTS']"")
. S $P(^DGMT(408.22,DA,0),"^",10)=$S(CTS="YES":1,CTS="NO":0,1:"")
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" CONTRIBUTED TO SUPPORT for "_$P($G(^DPT($P($G(^DGMT(408.22,DA,0)),"^",1),0)),"^",1)_"'s entry "_DA_" has been changed: "
. S DGMMLNE=DGMMLNE+1
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_CTS_" has been changed to "_$S(CTS="YES":1,CTS="NO":0,1:"NULL")_"."
. S DGMMLNE=DGMMLNE+1
. S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
. S DGMMLNE=DGMMLNE+1
.;
. S DIK="^DGMT(408.22,"
. S DIK(1)=".06"
. D EN^DIK
. K DIK
Q
DG53P624 ;ALB/CMF - PATCH DG*5.3*624 INSTALL UTILITIES ; 09/30/04 8:14am
+1 ;;5.3;Registration;**624,1015**;Aug 13, 1993;Build 21
+2 ;
ENV ;Main entry point for Environment check point.
+1 ;
+2 SET XPDABORT=""
+3 ;checks programmer variables
DO PROGCHK(.XPDABORT)
+4 IF XPDABORT=""
KILL XPDABORT
+5 QUIT
+6 ;
+7 ;
PRE ;Main entry point for Pre-init items.
+1 ;
+2 QUIT
+3 ;
+4 ;
POST ;Main entry point for Post-init items.
+1 DO MAPRS
+2 DO BULLETIN
+3 QUIT
+4 ;
MAPRS ; set maximum annual pension rate parameters
+1 DO BMES^XPDUTL("*****")
+2 DO MES^XPDUTL("Setting Maximum Annual Pension Rate Parameters")
+3 ;
+4 ;set MAPR rate parameter to 5(%)
+5 DO SETPARM("DGMT MAPR GLOBAL RATE",1999,5)
+6 DO SETPARM("DGMT MAPR GLOBAL RATE",2000,5)
+7 DO SETPARM("DGMT MAPR GLOBAL RATE",2001,5)
+8 DO SETPARM("DGMT MAPR GLOBAL RATE",2002,5)
+9 DO SETPARM("DGMT MAPR GLOBAL RATE",2003,5)
+10 DO SETPARM("DGMT MAPR GLOBAL RATE",2004,5)
+11 ;
+12 ;set MAPR max values
+13 DO SETPARM("DGMT MAPR 0 DEPENDENTS",1999,8989)
+14 DO SETPARM("DGMT MAPR 0 DEPENDENTS",2000,9304)
+15 DO SETPARM("DGMT MAPR 0 DEPENDENTS",2001,9556)
+16 DO SETPARM("DGMT MAPR 0 DEPENDENTS",2002,9690)
+17 DO SETPARM("DGMT MAPR 0 DEPENDENTS",2003,9894)
+18 DO SETPARM("DGMT MAPR 0 DEPENDENTS",2004,10162)
+19 ;
+20 DO SETPARM("DGMT MAPR 1 DEPENDENTS",1999,11773)
+21 DO SETPARM("DGMT MAPR 1 DEPENDENTS",2000,12186)
+22 DO SETPARM("DGMT MAPR 1 DEPENDENTS",2001,12516)
+23 DO SETPARM("DGMT MAPR 1 DEPENDENTS",2002,12692)
+24 DO SETPARM("DGMT MAPR 1 DEPENDENTS",2003,12959)
+25 DO SETPARM("DGMT MAPR 1 DEPENDENTS",2004,13309)
+26 ;
+27 DO SETPARM("DGMT MAPR N DEPENDENTS",1999,1532)
+28 DO SETPARM("DGMT MAPR N DEPENDENTS",2000,1586)
+29 DO SETPARM("DGMT MAPR N DEPENDENTS",2001,1630)
+30 DO SETPARM("DGMT MAPR N DEPENDENTS",2002,1653)
+31 DO SETPARM("DGMT MAPR N DEPENDENTS",2003,1688)
+32 DO SETPARM("DGMT MAPR N DEPENDENTS",2004,1734)
+33 ;
+34 DO MES^XPDUTL("...Rates set.")
+35 DO MES^XPDUTL("*****")
+36 QUIT
+37 ;
SETPARM(DGPARM,DGINST,DGVALU) ;set PACKAGE entity parameters
+1 ;
+2 ; DBIA: #2263 SUPPORTED PARAMETER TOOL ENTRY POINTS
+3 ;
+4 ; Input:
+5 ; DGPARM - PARAMETER DEFINITION name
+6 ; DGINST - parameter instance
+7 ; DGVALU - parameter value
+8 ;
+9 ; Output:
+10 ; None
+11 ;
+12 NEW DGERR
+13 ;
+14 DO EN^XPAR("PKG",DGPARM,DGINST,DGVALU,.DGERR)
+15 IF '$GET(DGERR)
Begin DoDot:1
+16 DO MES^XPDUTL(DGPARM_" parameter, instance "_DGINST_", set to "_DGVALU_".")
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 DO MES^XPDUTL(DGPARM_" parameter, instance "_DGINST_", FAILED! ("_DGVALU_")")
End DoDot:1
+19 QUIT
+20 ;
+21 ;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
+1 ;
+2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+3 DO BMES^XPDUTL("*****")
+4 DO MES^XPDUTL("Your programming variables are not set up properly.")
+5 DO MES^XPDUTL("Installation aborted.")
+6 DO MES^XPDUTL("*****")
+7 SET XPDABORT=2
End DoDot:1
+8 QUIT
+9 ;
BULLETIN ;
+1 NEW ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE
+2 SET ZTDTH=$HOROLOG
+3 SET ZTIO=""
+4 SET ZTDESC="DG*5.3*624 Post-Install message"
+5 SET ZTRTN="DQMESS^DG53P624"
+6 SET ZTSAVE("DUZ")=""
+7 SET ZTSAVE("JVAL")=$JOB
+8 DO ^%ZTLOAD
+9 IF $GET(ZTSK)
DO BMES^XPDUTL("POST-INSTALL CLEANUP MESSAGE QUEUED TO SEND")
+10 IF '$GET(ZTSK)
DO BMES^XPDUTL("PROBLEM: POST-INSTALL CLEANUP MESSAGE NOT SENT")
+11 ;
+12 IF $DATA(^XTMP("DG",$JOB,"PATCH 624 ERROR MESSAGE"))
Begin DoDot:1
+13 DO BMES^XPDUTL("PROBLEM SENDING MESSAGE")
+14 DO MES^XPDUTL("CHECK FOR ^XTMP(""DG"",$J,""PATCH 624 CLEANUP BULLETIN"") GLOBAL")
+15 DO MES^XPDUTL("CHECK FOR ^XTMP(""DG"",$J,""PATCH 624 ERROR MESSAGE"") GLOBAL")
End DoDot:1
+16 DO BMES^XPDUTL("Means Test database cleanup has been completed. Check your VA Mailman")
+17 DO MES^XPDUTL("mailbox for the ""DG*5.3*624 External value cleanup"" message.")
+18 DO BMES^XPDUTL("If you do not receive an E-mail, remember to check the following globals:")
+19 DO MES^XPDUTL(" ^XTMP(""DG"",$J,""PATCH 624 CLEANUP BULLETIN"")")
+20 DO MES^XPDUTL(" ^XTMP(""DG"",$J,""PATCH 624 ERROR MESSAGE"")")
+21 QUIT
+22 ;
DQMESS ;
+1 NEW DGMMLNE
+2 ;*Create bulletin head to identify cleanup records
+3 KILL ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN")
+4 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",1)="This message indicates the patients in the Income Person file (408.13)"
+5 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",2)=" and the Income Relation file (408.22) that have had external values"
+6 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",3)=" in the STATE, LIVED WITH PATIENT, and CONTRIBUTED TO SUPPORT"
+7 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",4)=" fields converted to internal pointer or set of code values."
+8 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",5)=" "
+9 SET DGMMLNE=6
+10 ;
+11 ;*Perform cleanup
+12 DO STATE
+13 DO CLEAN
+14 ;
+15 ;*Send message
+16 IF $ORDER(^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",11))=""
Begin DoDot:1
+17 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",11)=" "
+18 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",12)=" No corrupted records found."
+19 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",13)=" "
End DoDot:1
+20 ;
+21 ;* Queue message to be sent
+22 SET XMSUB="DG*5.3*624 External value cleanup"
+23 SET XMDUZ="DG*5.3*624 Install Cleanup"
+24 SET XMTEXT="^XTMP(""DG"",JVAL,""PATCH 624 CLEANUP BULLETIN"","
+25 SET XMY(DUZ)=""
+26 SET XMY(.5)=""
+27 SET XMY("G.EAS_1_57@FORUM.VA.GOV")=""
+28 DO ^XMD
+29 SET DGMMLNE=$PIECE($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")_U_$GET(XMMG)_U_$GET(XMZ)
+30 SET ^XTMP("DG",JVAL,"PATCH 624 ERROR MESSAGE",0)=DGMMLNE
+31 SET DGMMLNE=$PIECE($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")
+32 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",0)=DGMMLNE
+33 IF '$DATA(XMMG)
KILL ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN")
+34 QUIT
+35 ;
STATE ;Correct STATE field in 408.13/1.6 with text instead of pointers
+1 NEW DA,STATE,PTR
+2 ;* Setup message text
+3 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking STATE field (1.6) in the INCOME PERSON file (408.13)..."
+4 SET DGMMLNE=DGMMLNE+1
+5 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
+6 SET DGMMLNE=DGMMLNE+1
+7 ;
+8 SET DA=0
FOR
SET DA=$ORDER(^DGPR(408.13,DA))
IF 'DA
QUIT
Begin DoDot:1
+9 IF '$DATA(^DGPR(408.13,DA,1))
QUIT
+10 SET STATE=$PIECE(^DGPR(408.13,DA,1),"^",6)
+11 IF (+STATE=STATE)
QUIT
IF (STATE']"")
QUIT
+12 SET PTR=$ORDER(^DIC(5,"B",STATE,""))
+13 SET $PIECE(^DGPR(408.13,DA,1),"^",6)=PTR
+14 ;
+15 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" State for "_$PIECE(^DGPR(408.13,DA,0),"^",1)_"'s entry "_DA_" has been changed: "
+16 SET DGMMLNE=DGMMLNE+1
+17 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_STATE_" has been changed to "_PTR_" IEN from STATE file (5)."
+18 SET DGMMLNE=DGMMLNE+1
+19 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
+20 SET DGMMLNE=DGMMLNE+1
End DoDot:1
+21 QUIT
+22 ;
CLEAN ;Clean up text "YES" and "NO" values in 408.22/.06 and 408.22/.1
+1 NEW DA,LWP,CTS
+2 ;*Setup message text
+3 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking LIVED WITH PATIENT field (.06) in the INCOME RELATION file (408.22)..."
+4 SET DGMMLNE=DGMMLNE+1
+5 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
+6 SET DGMMLNE=DGMMLNE+1
+7 ;
+8 SET DA=0
FOR
SET DA=$ORDER(^DGMT(408.22,DA))
IF 'DA
QUIT
Begin DoDot:1
+9 ;Lived With Patient
SET LWP=$PIECE($GET(^DGMT(408.22,DA,0)),"^",6)
+10 IF (+LWP=LWP)
QUIT
IF (LWP']"")
QUIT
+11 SET $PIECE(^DGMT(408.22,DA,0),"^",6)=$SELECT(LWP="YES":1,LWP="NO":0,1:"")
+12 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" LIVED WITH PATIENT for "_$PIECE($GET(^DPT($PIECE($GET(^DGMT(408.22,DA,0)),"^",1),0)),"^",1)_"'s entry "_DA_" has been changed: "
+13 SET DGMMLNE=DGMMLNE+1
+14 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_LWP_" has been changed to "_$SELECT(LWP="YES":1,LWP="NO":0,1:"NULL")_"."
+15 SET DGMMLNE=DGMMLNE+1
+16 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
+17 SET DGMMLNE=DGMMLNE+1
+18 ;
+19 SET DIK="^DGMT(408.22,"
+20 SET DIK(1)=".06"
+21 DO EN^DIK
+22 KILL DIK
End DoDot:1
+23 ;
+24 ;
+25 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking CONTRIBUTED TO SUPPORT field (.1) in the INCOME RELATION file (408.22)..."
+26 SET DGMMLNE=DGMMLNE+1
+27 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
+28 SET DGMMLNE=DGMMLNE+1
+29 ;
+30 SET DA=0
FOR
SET DA=$ORDER(^DGMT(408.22,DA))
IF 'DA
QUIT
Begin DoDot:1
+31 ;Contributed To Support
SET CTS=$PIECE($GET(^DGMT(408.22,DA,0)),"^",10)
+32 IF (+CTS=CTS)
QUIT
IF (CTS']"")
QUIT
+33 SET $PIECE(^DGMT(408.22,DA,0),"^",10)=$SELECT(CTS="YES":1,CTS="NO":0,1:"")
+34 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" CONTRIBUTED TO SUPPORT for "_$PIECE($GET(^DPT($PIECE($GET(^DGMT(408.22,DA,0)),"^",1),0)),"^",1)_"'s entry "_DA_" has been changed: "
+35 SET DGMMLNE=DGMMLNE+1
+36 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_CTS_" has been changed to "_$SELECT(CTS="YES":1,CTS="NO":0,1:"NULL")_"."
+37 SET DGMMLNE=DGMMLNE+1
+38 SET ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
+39 SET DGMMLNE=DGMMLNE+1
+40 ;
+41 SET DIK="^DGMT(408.22,"
+42 SET DIK(1)=".06"
+43 DO EN^DIK
+44 KILL DIK
End DoDot:1
+45 QUIT
