PSO810PI ;BIRM/KML - PSO*7*810 Post-install routine ;10/15/2025
;;7.0;OUTPATIENT PHARMACY;**810**;DEC 1997;Build 9
;
Q ; Must be run from the POST or BACKOUT tag
;
;
; This post-install routine does the following:
;
; POST tag:
; 1. Updates the description for element PAT22 for versions 4.1 and 4.2
;
; BACKOUT tag:
; 2. Backs out updates to the description for element PAT22 versions 4.1 and 4.2
;
;
POST ; Main Entry Point
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" Starting Post-Install for PSO*7.0*810.")
D MES^XPDUTL(" This Post-Install Routine updates the description verbiage")
D MES^XPDUTL(" for File #58.4 [SPMP ASAP RECORD DEFINITION] for the PAT22")
D MES^XPDUTL(" element only for Versions 4.1 and 4.2.")
;
N PSODUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ,ZTSK
S ZTRTN="START^PSO810PI"
S ZTDESC="PSO*7.0*810 Post-Install Routine"
S ZTIO="",ZTDTH=$H
S PSODUZ=DUZ
S ZTSAVE("PSODUZ")=""
D ^%ZTLOAD
;
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" The PSO*7.0*810 Post-Install Routine has been tasked.")
D MES^XPDUTL(" Task Number: "_$G(ZTSK))
D MES^XPDUTL(" You will receive a MailMan message when it completes.")
D BMES^XPDUTL(" ")
Q
;
START ; Start correction process
N PSOSUB,PSOFROM,PSOTEXT
K ^XTMP("PSO810PI",$J),^XTMP("PSO*7.0*810 POST INSTALL") ;if Post Install run multiple times
;
S ^XTMP("PSO*7.0*810 POST INSTALL",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^PSO*7.0*810 POST INSTALL"
D CHANGE,MAIL
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
CHANGE ; INC39935062 - Update Description for PAT22 element
;ASAP versions 4.1 and 4.2
N PSOLINE,COUNT,FOUND,X1,X2
N V,S,D,E,VER
S PSOLINE=0
;
D SETTXT("==================== PSO*7.0*810 Summary Report =========================")
D SETTXT("List of ASAP Versions where PAT22 element description has been corrected.")
D SETTXT("=========================================================================")
D SETTXT("")
;
S V="VER",S="SEG",D="DAT",E="DES"
S FOUND=0
;Check if correct version before proceeding
I $P(^PS(58.4,1,V,2,0),"^",1)="4.1" D
. ;Check for the verbiage that needs to be removed
. I $G(^PS(58.4,1,V,2,S,2,D,1,E,1,0))["PAT12" D
. . S FOUND=FOUND+1
. . D SETTXT("ASAP Version 4.1 - PAT22 Description Before Post-Install Routine")
. . D SETTXT("----------------------------------------------------------------")
. . S X1=$G(^PS(58.4,1,V,2,S,2,D,1,E,1,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,2,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,3,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,4,0))
. . D SETTXT(X1)
. . D SETTXT("")
. . S ^PS(58.4,1,V,2,S,2,D,1,E,1,0)="Used when the patient's address is a foreign country."
. . S ^PS(58.4,1,V,2,S,2,D,1,E,2,0)="This is a freeform text field. ASAP does not provide a list"
. . D SETTXT("ASAP Version 4.1 - PAT22 Description After Post-Install Routine")
. . D SETTXT("---------------------------------------------------------------")
. . S X2=$G(^PS(58.4,1,V,2,S,2,D,1,E,1,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,2,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,3,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,4,0))
. . D SETTXT(X2)
. . D SETTXT("")
;Check if correct version before proceeding
I $P(^PS(58.4,1,V,7,0),"^",1)="4.2" D
. ;Check for the verbiage that needs to be removed
. I $G(^PS(58.4,1,V,7,S,2,D,1,E,1,0))["PAT12" D
. . S (X1,X2)="" S FOUND=FOUND+1
. . D SETTXT("ASAP Version 4.2 - PAT22 Description Before Post-Install Routine")
. . D SETTXT("----------------------------------------------------------------")
. . S X1=$G(^PS(58.4,1,V,7,S,2,D,1,E,1,0))_" "_$G(^PS(58.4,1,V,7,S,2,D,1,E,2,0))
. . D SETTXT(X1)
. . D SETTXT("")
. . S ^PS(58.4,1,V,7,S,2,D,1,E,1,0)="Used when the patient's address is a foreign country."
. . K ^PS(58.4,1,V,7,S,2,D,1,E,2,0)
. . ;Check header node
. . S COUNT=$O(^PS(58.4,1,V,7,S,2,D,1,E,"Z"),-1)
. . I COUNT'=$P(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",3) S $P(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",3)=COUNT S $P(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",4)=COUNT
. . D SETTXT("ASAP Version 4.2 - PAT22 Description After Post-Install Routine")
. . D SETTXT("---------------------------------------------------------------")
. . S X2=$G(^PS(58.4,1,V,7,S,2,D,1,E,1,0))
. . D SETTXT(X2)
;
D SETTXT("")
I FOUND D SETTXT("Total ASAP Versions Corrected = "_FOUND)
I 'FOUND D SETTXT("No ASAP Versions Were Corrected.")
D SETTXT("")
;
D BMES^XPDUTL(" Mailman message sent.")
D BMES^XPDUTL(" Finished Post-Install for PSO*7.0*810.")
Q
;
SETTXT(TXT) ; Setting Plain Text
S PSOLINE=$G(PSOLINE)+1,^XTMP("PSO810PI",$J,PSOLINE)=TXT
Q
;
MAIL ; Sends Mailman message
S PSOSUB="PSO*7.0*810 Post-Install Information"
S PSOFROM="PSO*7.0*810 Post-Install"
S PSOTEXT="^XTMP(""PSO810PI"",$J)"
D MAILMSG(PSOSUB,PSOFROM,PSOTEXT)
Q
MAILMSG(MSGSUBJ,MSGFROM,MSGTEXT) ; Build and send a MailMan message
N PSOREC,PSOMY,PSOMIN,PSOMZ
I '$D(PSODUZ) S PSODUZ=DUZ
S PSOMIN("FROM")=MSGFROM
S PSOREC=""
F S PSOREC=$O(^XUSEC("PSNMGR",PSOREC)) Q:PSOREC="" S PSOMY(PSOREC)=""
S PSOMY(PSODUZ)=""
D SENDMSG^XMXAPI(PSODUZ,MSGSUBJ,MSGTEXT,.PSOMY,.PSOMIN,.PSOMZ,"")
Q
BACKOUT ; Main Entry Point for Backout - Backout Description changes for PAT22 element
;ASAP versions 4.1 and 4.2
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" Starting Post-Install Backout for PSO*7.0*810.")
D MES^XPDUTL(" This Backout will remove updates to the description")
D MES^XPDUTL(" verbiage for File #58.4 [SPMP ASAP RECORD DEFINITION]")
D MES^XPDUTL(" for the PAT22 element only for Versions 4.1 and 4.2.")
;
N PSODUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ,ZTSK
S ZTRTN="STARTBO^PSO810PI"
S ZTDESC="PSO*7.0*810 Post-Install Backout"
S ZTIO="",ZTDTH=$H
S PSODUZ=DUZ
S ZTSAVE("PSODUZ")=""
D ^%ZTLOAD
;
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" The PSO*7.0*810 Post-Install Backout has been tasked.")
D MES^XPDUTL(" Task Number: "_$G(ZTSK))
D MES^XPDUTL(" You will receive a MailMan message when it completes.")
D BMES^XPDUTL(" ")
Q
;
STARTBO ; Start Backout Process
N PSOSUB,PSOFROM,PSOTEXT
K ^XTMP("PSO810PI",$J),^XTMP("PSO*7.0*810 POST INSTALL BACKOUT") ;if Post Install run multiple times
;
S ^XTMP("PSO*7.0*810 POST INSTALL BACKOUT",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^PSO*7.0*810 POST INSTALL BACKOUT"
D REMOVE,MAIL2
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
REMOVE ; INC39935062 - Remove Post-Install Updates to Description for PAT22 element
;ASAP versions 4.1 and 4.2
N PSOLINE,COUNT,FOUND,X1,X2
N V,S,D,E,VER
S PSOLINE=0
;
D SETMSG("==================== PSO*7.0*810 BACKOUT Report =========================")
D SETMSG("List of ASAP Versions where PAT22 element description has been BACKED OUT")
D SETMSG("=========================================================================")
D SETMSG("")
;
S V="VER",S="SEG",D="DAT",E="DES"
S FOUND=0
;Check if correct version before proceeding
I $P(^PS(58.4,1,V,2,0),"^",1)="4.1" D
. ;Check for the verbiage that needs to be reinstated
. I $G(^PS(58.4,1,V,2,S,2,D,1,E,1,0))["foreign country." D
. . S FOUND=FOUND+1
. . D SETMSG("ASAP Version 4.1 - PAT22 Description Before BACKOUT")
. . D SETMSG("---------------------------------------------------")
. . S X1=$G(^PS(58.4,1,V,2,S,2,D,1,E,1,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,2,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,3,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,4,0))
. . D SETMSG(X1)
. . D SETMSG("")
. . S ^PS(58.4,1,V,2,S,2,D,1,E,1,0)="Used when the patient's address is a foreign country and PAT12 through PAT16"
. . S ^PS(58.4,1,V,2,S,2,D,1,E,2,0)="are left blank. This is a freeform text field. ASAP does not provide a list"
. . D SETMSG("ASAP Version 4.1 - PAT22 Description After BACKOUT")
. . D SETMSG("--------------------------------------------------")
. . S X2=$G(^PS(58.4,1,V,2,S,2,D,1,E,1,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,2,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,3,0))_" "_$G(^PS(58.4,1,V,2,S,2,D,1,E,4,0))
. . D SETMSG(X2)
. . D SETMSG("")
;Check if correct version before proceeding
I $P(^PS(58.4,1,V,7,0),"^",1)="4.2" D
. ;Check for the verbiage that needs to be reinstated
. I $G(^PS(58.4,1,V,7,S,2,D,1,E,1,0))["foreign country." D
. . S (X1,X2)="" S FOUND=FOUND+1
. . D SETMSG("ASAP Version 4.2 - PAT22 Description Before BACKOUT")
. . D SETMSG("---------------------------------------------------")
. . S X1=$G(^PS(58.4,1,V,7,S,2,D,1,E,1,0))_" "_$G(^PS(58.4,1,V,7,S,2,D,1,E,2,0))
. . D SETMSG(X1)
. . D SETMSG("")
. . S ^PS(58.4,1,V,7,S,2,D,1,E,1,0)="Used when the patient's address is a foreign country and PAT12 through"
. . S ^PS(58.4,1,V,7,S,2,D,1,E,2,0)="PAT16 are left blank."
. . ;Check header node
. . S COUNT=$O(^PS(58.4,1,V,7,S,2,D,1,E,"Z"),-1)
. . I COUNT'=$P(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",3) S $P(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",3)=COUNT S $P(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",4)=COUNT
. . D SETMSG("ASAP Version 4.2 - PAT22 Description After BACKOUT")
. . D SETMSG("--------------------------------------------------")
. . S X2=$G(^PS(58.4,1,V,7,S,2,D,1,E,1,0))_" "_$G(^PS(58.4,1,V,7,S,2,D,1,E,2,0))
. . D SETMSG(X2)
;
D SETMSG("")
I FOUND D SETMSG("Total ASAP Versions Corrected By BACKOUT = "_FOUND)
I 'FOUND D SETMSG("No ASAP Versions Were Affected By BACKOUT.")
D SETMSG("")
;
D BMES^XPDUTL(" Mailman message sent.")
D BMES^XPDUTL(" Finished BACKOUT for PSO*7.0*810.")
Q
;
SETMSG(TXT) ; Setting Plain Text
S PSOLINE=$G(PSOLINE)+1,^XTMP("PSO810PI",$J,PSOLINE)=TXT
Q
MAIL2 ; Sends Mailman message
S PSOSUB="PSO*7.0*810 Post-Install BACKOUT Info"
S PSOFROM="PSO*7.0*810 Post-Install BACKOUT"
S PSOTEXT="^XTMP(""PSO810PI"",$J)"
D MAILMSG(PSOSUB,PSOFROM,PSOTEXT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO810PI 9717 printed Jul 22, 2026@15:32:08 Page 2
PSO810PI ;BIRM/KML - PSO*7*810 Post-install routine ;10/15/2025
+1 ;;7.0;OUTPATIENT PHARMACY;**810**;DEC 1997;Build 9
+2 ;
+3 ; Must be run from the POST or BACKOUT tag
QUIT
+4 ;
+5 ;
+6 ; This post-install routine does the following:
+7 ;
+8 ; POST tag:
+9 ; 1. Updates the description for element PAT22 for versions 4.1 and 4.2
+10 ;
+11 ; BACKOUT tag:
+12 ; 2. Backs out updates to the description for element PAT22 versions 4.1 and 4.2
+13 ;
+14 ;
POST ; Main Entry Point
+1 DO BMES^XPDUTL(" ")
+2 DO BMES^XPDUTL(" Starting Post-Install for PSO*7.0*810.")
+3 DO MES^XPDUTL(" This Post-Install Routine updates the description verbiage")
+4 DO MES^XPDUTL(" for File #58.4 [SPMP ASAP RECORD DEFINITION] for the PAT22")
+5 DO MES^XPDUTL(" element only for Versions 4.1 and 4.2.")
+6 ;
+7 NEW PSODUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ,ZTSK
+8 SET ZTRTN="START^PSO810PI"
+9 SET ZTDESC="PSO*7.0*810 Post-Install Routine"
+10 SET ZTIO=""
SET ZTDTH=$HOROLOG
+11 SET PSODUZ=DUZ
+12 SET ZTSAVE("PSODUZ")=""
+13 DO ^%ZTLOAD
+14 ;
+15 DO BMES^XPDUTL(" ")
+16 DO BMES^XPDUTL(" The PSO*7.0*810 Post-Install Routine has been tasked.")
+17 DO MES^XPDUTL(" Task Number: "_$GET(ZTSK))
+18 DO MES^XPDUTL(" You will receive a MailMan message when it completes.")
+19 DO BMES^XPDUTL(" ")
+20 QUIT
+21 ;
START ; Start correction process
+1 NEW PSOSUB,PSOFROM,PSOTEXT
+2 ;if Post Install run multiple times
KILL ^XTMP("PSO810PI",$JOB),^XTMP("PSO*7.0*810 POST INSTALL")
+3 ;
+4 SET ^XTMP("PSO*7.0*810 POST INSTALL",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^PSO*7.0*810 POST INSTALL"
+5 DO CHANGE
DO MAIL
+6 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
+8 ;
CHANGE ; INC39935062 - Update Description for PAT22 element
+1 ;ASAP versions 4.1 and 4.2
+2 NEW PSOLINE,COUNT,FOUND,X1,X2
+3 NEW V,S,D,E,VER
+4 SET PSOLINE=0
+5 ;
+6 DO SETTXT("==================== PSO*7.0*810 Summary Report =========================")
+7 DO SETTXT("List of ASAP Versions where PAT22 element description has been corrected.")
+8 DO SETTXT("=========================================================================")
+9 DO SETTXT("")
+10 ;
+11 SET V="VER"
SET S="SEG"
SET D="DAT"
SET E="DES"
+12 SET FOUND=0
+13 ;Check if correct version before proceeding
+14 IF $PIECE(^PS(58.4,1,V,2,0),"^",1)="4.1"
Begin DoDot:1
+15 ;Check for the verbiage that needs to be removed
+16 IF $GET(^PS(58.4,1,V,2,S,2,D,1,E,1,0))["PAT12"
Begin DoDot:2
+17 SET FOUND=FOUND+1
+18 DO SETTXT("ASAP Version 4.1 - PAT22 Description Before Post-Install Routine")
+19 DO SETTXT("----------------------------------------------------------------")
+20 SET X1=$GET(^PS(58.4,1,V,2,S,2,D,1,E,1,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,2,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,3,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,4,0))
+21 DO SETTXT(X1)
+22 DO SETTXT("")
+23 SET ^PS(58.4,1,V,2,S,2,D,1,E,1,0)="Used when the patient's address is a foreign country."
+24 SET ^PS(58.4,1,V,2,S,2,D,1,E,2,0)="This is a freeform text field. ASAP does not provide a list"
+25 DO SETTXT("ASAP Version 4.1 - PAT22 Description After Post-Install Routine")
+26 DO SETTXT("---------------------------------------------------------------")
+27 SET X2=$GET(^PS(58.4,1,V,2,S,2,D,1,E,1,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,2,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,3,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,4,0))
+28 DO SETTXT(X2)
+29 DO SETTXT("")
End DoDot:2
End DoDot:1
+30 ;Check if correct version before proceeding
+31 IF $PIECE(^PS(58.4,1,V,7,0),"^",1)="4.2"
Begin DoDot:1
+32 ;Check for the verbiage that needs to be removed
+33 IF $GET(^PS(58.4,1,V,7,S,2,D,1,E,1,0))["PAT12"
Begin DoDot:2
+34 SET (X1,X2)=""
SET FOUND=FOUND+1
+35 DO SETTXT("ASAP Version 4.2 - PAT22 Description Before Post-Install Routine")
+36 DO SETTXT("----------------------------------------------------------------")
+37 SET X1=$GET(^PS(58.4,1,V,7,S,2,D,1,E,1,0))_" "_$GET(^PS(58.4,1,V,7,S,2,D,1,E,2,0))
+38 DO SETTXT(X1)
+39 DO SETTXT("")
+40 SET ^PS(58.4,1,V,7,S,2,D,1,E,1,0)="Used when the patient's address is a foreign country."
+41 KILL ^PS(58.4,1,V,7,S,2,D,1,E,2,0)
+42 ;Check header node
+43 SET COUNT=$ORDER(^PS(58.4,1,V,7,S,2,D,1,E,"Z"),-1)
+44 IF COUNT'=$PIECE(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",3)
SET $PIECE(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",3)=COUNT
SET $PIECE(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",4)=COUNT
+45 DO SETTXT("ASAP Version 4.2 - PAT22 Description After Post-Install Routine")
+46 DO SETTXT("---------------------------------------------------------------")
+47 SET X2=$GET(^PS(58.4,1,V,7,S,2,D,1,E,1,0))
+48 DO SETTXT(X2)
End DoDot:2
End DoDot:1
+49 ;
+50 DO SETTXT("")
+51 IF FOUND
DO SETTXT("Total ASAP Versions Corrected = "_FOUND)
+52 IF 'FOUND
DO SETTXT("No ASAP Versions Were Corrected.")
+53 DO SETTXT("")
+54 ;
+55 DO BMES^XPDUTL(" Mailman message sent.")
+56 DO BMES^XPDUTL(" Finished Post-Install for PSO*7.0*810.")
+57 QUIT
+58 ;
SETTXT(TXT) ; Setting Plain Text
+1 SET PSOLINE=$GET(PSOLINE)+1
SET ^XTMP("PSO810PI",$JOB,PSOLINE)=TXT
+2 QUIT
+3 ;
MAIL ; Sends Mailman message
+1 SET PSOSUB="PSO*7.0*810 Post-Install Information"
+2 SET PSOFROM="PSO*7.0*810 Post-Install"
+3 SET PSOTEXT="^XTMP(""PSO810PI"",$J)"
+4 DO MAILMSG(PSOSUB,PSOFROM,PSOTEXT)
+5 QUIT
MAILMSG(MSGSUBJ,MSGFROM,MSGTEXT) ; Build and send a MailMan message
+1 NEW PSOREC,PSOMY,PSOMIN,PSOMZ
+2 IF '$DATA(PSODUZ)
SET PSODUZ=DUZ
+3 SET PSOMIN("FROM")=MSGFROM
+4 SET PSOREC=""
+5 FOR
SET PSOREC=$ORDER(^XUSEC("PSNMGR",PSOREC))
if PSOREC=""
QUIT
SET PSOMY(PSOREC)=""
+6 SET PSOMY(PSODUZ)=""
+7 DO SENDMSG^XMXAPI(PSODUZ,MSGSUBJ,MSGTEXT,.PSOMY,.PSOMIN,.PSOMZ,"")
+8 QUIT
BACKOUT ; Main Entry Point for Backout - Backout Description changes for PAT22 element
+1 ;ASAP versions 4.1 and 4.2
+2 DO BMES^XPDUTL(" ")
+3 DO BMES^XPDUTL(" Starting Post-Install Backout for PSO*7.0*810.")
+4 DO MES^XPDUTL(" This Backout will remove updates to the description")
+5 DO MES^XPDUTL(" verbiage for File #58.4 [SPMP ASAP RECORD DEFINITION]")
+6 DO MES^XPDUTL(" for the PAT22 element only for Versions 4.1 and 4.2.")
+7 ;
+8 NEW PSODUZ,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ,ZTSK
+9 SET ZTRTN="STARTBO^PSO810PI"
+10 SET ZTDESC="PSO*7.0*810 Post-Install Backout"
+11 SET ZTIO=""
SET ZTDTH=$HOROLOG
+12 SET PSODUZ=DUZ
+13 SET ZTSAVE("PSODUZ")=""
+14 DO ^%ZTLOAD
+15 ;
+16 DO BMES^XPDUTL(" ")
+17 DO BMES^XPDUTL(" The PSO*7.0*810 Post-Install Backout has been tasked.")
+18 DO MES^XPDUTL(" Task Number: "_$GET(ZTSK))
+19 DO MES^XPDUTL(" You will receive a MailMan message when it completes.")
+20 DO BMES^XPDUTL(" ")
+21 QUIT
+22 ;
STARTBO ; Start Backout Process
+1 NEW PSOSUB,PSOFROM,PSOTEXT
+2 ;if Post Install run multiple times
KILL ^XTMP("PSO810PI",$JOB),^XTMP("PSO*7.0*810 POST INSTALL BACKOUT")
+3 ;
+4 SET ^XTMP("PSO*7.0*810 POST INSTALL BACKOUT",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^PSO*7.0*810 POST INSTALL BACKOUT"
+5 DO REMOVE
DO MAIL2
+6 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
+8 ;
REMOVE ; INC39935062 - Remove Post-Install Updates to Description for PAT22 element
+1 ;ASAP versions 4.1 and 4.2
+2 NEW PSOLINE,COUNT,FOUND,X1,X2
+3 NEW V,S,D,E,VER
+4 SET PSOLINE=0
+5 ;
+6 DO SETMSG("==================== PSO*7.0*810 BACKOUT Report =========================")
+7 DO SETMSG("List of ASAP Versions where PAT22 element description has been BACKED OUT")
+8 DO SETMSG("=========================================================================")
+9 DO SETMSG("")
+10 ;
+11 SET V="VER"
SET S="SEG"
SET D="DAT"
SET E="DES"
+12 SET FOUND=0
+13 ;Check if correct version before proceeding
+14 IF $PIECE(^PS(58.4,1,V,2,0),"^",1)="4.1"
Begin DoDot:1
+15 ;Check for the verbiage that needs to be reinstated
+16 IF $GET(^PS(58.4,1,V,2,S,2,D,1,E,1,0))["foreign country."
Begin DoDot:2
+17 SET FOUND=FOUND+1
+18 DO SETMSG("ASAP Version 4.1 - PAT22 Description Before BACKOUT")
+19 DO SETMSG("---------------------------------------------------")
+20 SET X1=$GET(^PS(58.4,1,V,2,S,2,D,1,E,1,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,2,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,3,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,4,0))
+21 DO SETMSG(X1)
+22 DO SETMSG("")
+23 SET ^PS(58.4,1,V,2,S,2,D,1,E,1,0)="Used when the patient's address is a foreign country and PAT12 through PAT16"
+24 SET ^PS(58.4,1,V,2,S,2,D,1,E,2,0)="are left blank. This is a freeform text field. ASAP does not provide a list"
+25 DO SETMSG("ASAP Version 4.1 - PAT22 Description After BACKOUT")
+26 DO SETMSG("--------------------------------------------------")
+27 SET X2=$GET(^PS(58.4,1,V,2,S,2,D,1,E,1,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,2,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,3,0))_" "_$GET(^PS(58.4,1,V,2,S,2,D,1,E,4,0))
+28 DO SETMSG(X2)
+29 DO SETMSG("")
End DoDot:2
End DoDot:1
+30 ;Check if correct version before proceeding
+31 IF $PIECE(^PS(58.4,1,V,7,0),"^",1)="4.2"
Begin DoDot:1
+32 ;Check for the verbiage that needs to be reinstated
+33 IF $GET(^PS(58.4,1,V,7,S,2,D,1,E,1,0))["foreign country."
Begin DoDot:2
+34 SET (X1,X2)=""
SET FOUND=FOUND+1
+35 DO SETMSG("ASAP Version 4.2 - PAT22 Description Before BACKOUT")
+36 DO SETMSG("---------------------------------------------------")
+37 SET X1=$GET(^PS(58.4,1,V,7,S,2,D,1,E,1,0))_" "_$GET(^PS(58.4,1,V,7,S,2,D,1,E,2,0))
+38 DO SETMSG(X1)
+39 DO SETMSG("")
+40 SET ^PS(58.4,1,V,7,S,2,D,1,E,1,0)="Used when the patient's address is a foreign country and PAT12 through"
+41 SET ^PS(58.4,1,V,7,S,2,D,1,E,2,0)="PAT16 are left blank."
+42 ;Check header node
+43 SET COUNT=$ORDER(^PS(58.4,1,V,7,S,2,D,1,E,"Z"),-1)
+44 IF COUNT'=$PIECE(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",3)
SET $PIECE(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",3)=COUNT
SET $PIECE(^PS(58.4,1,V,7,S,2,D,1,E,0),"^",4)=COUNT
+45 DO SETMSG("ASAP Version 4.2 - PAT22 Description After BACKOUT")
+46 DO SETMSG("--------------------------------------------------")
+47 SET X2=$GET(^PS(58.4,1,V,7,S,2,D,1,E,1,0))_" "_$GET(^PS(58.4,1,V,7,S,2,D,1,E,2,0))
+48 DO SETMSG(X2)
End DoDot:2
End DoDot:1
+49 ;
+50 DO SETMSG("")
+51 IF FOUND
DO SETMSG("Total ASAP Versions Corrected By BACKOUT = "_FOUND)
+52 IF 'FOUND
DO SETMSG("No ASAP Versions Were Affected By BACKOUT.")
+53 DO SETMSG("")
+54 ;
+55 DO BMES^XPDUTL(" Mailman message sent.")
+56 DO BMES^XPDUTL(" Finished BACKOUT for PSO*7.0*810.")
+57 QUIT
+58 ;
SETMSG(TXT) ; Setting Plain Text
+1 SET PSOLINE=$GET(PSOLINE)+1
SET ^XTMP("PSO810PI",$JOB,PSOLINE)=TXT
+2 QUIT
MAIL2 ; Sends Mailman message
+1 SET PSOSUB="PSO*7.0*810 Post-Install BACKOUT Info"
+2 SET PSOFROM="PSO*7.0*810 Post-Install BACKOUT"
+3 SET PSOTEXT="^XTMP(""PSO810PI"",$J)"
+4 DO MAILMSG(PSOSUB,PSOFROM,PSOTEXT)
+5 QUIT
