PSO7P517 ;MHA - Post Install routine for PSO*7*517 ;1/25/18@14:30
;;7.0;OUTPATIENT PHARMACY;**517**;DEC 1997;Build 15
;This post-installation routine will loop through the PHARMACY PATIENT file (#55)
;and plus the ^PS(55,DFN,"PS") - DEFAULT PATIENT STATUS - node if it contains "^"
;delimiters, because this node should only contain one numeric piece.
Q
;
EN ; Begin post-installation routine
I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
N PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,SBJM,ZZ
S JOBN="PSO*7.0*517 Post-Installation"
S PATCH="PSO*7.0*517",ZZ="PSO7P517"
S Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
D BMES^XPDUTL("=============================================================")
D MES^XPDUTL("Queuing background job for "_JOBN_"...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
D MES^XPDUTL("A MailMan message will be sent to the installer upon Post")
D MES^XPDUTL("Install Completion. This may take an hour or more, depending")
D MES^XPDUTL("upon site size.")
D MES^XPDUTL("==============================================================")
;
S ZTRTN="ENQN^PSO7P517",ZTIO=""
S (SBJM,ZTDESC)="Background job for "_JOBN
S ZTSAVE("JOBN")="",ZTSAVE("ZTDTH")="",ZTSAVE("DUZ")="",ZTSAVE("SBJM")="",ZTSAVE("ZZ")=""
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
D BMES^XPDUTL("")
K XPDQUES
Q
;
ENQN ;
N PSOCNT,PSOCREAT,PSODFN,PSOEXPR,PSOPSNEW,PSOPSOLD,PSOSTART
D NOW^%DTC S PSOSTART=$E(%,1,12),PSOCREAT=$E(%,1,7),PSOEXPR=$$FMADD^XLFDT(PSOCREAT,60,0,0,0)
K ^XTMP($J,ZZ),^TMP($J,"PSO")
S (PSOCNT,PSODFN)=0 F S PSODFN=$O(^PS(55,PSODFN)) Q:'PSODFN D
.I $G(^PS(55,PSODFN,"PS"))["^" D
..S PSOPSOLD=^PS(55,PSODFN,"PS")
..S PSOPSNEW=+^PS(55,PSODFN,"PS")
..S ^PS(55,PSODFN,"PS")=PSOPSNEW
..S ^XTMP($J,ZZ,PSODFN,"PS")=PSOPSNEW_"|"_PSOPSOLD
..S PSOCNT=PSOCNT+1
D STOP
Q
;
STOP K DA,DIE,DR,NUM,CPS,CPSX,%
D XMAIL1
D XMAIL2
S:$D(^XTMP($J,ZZ)) ^XTMP($J,ZZ,0)=PSOEXPR_"^"_PSOCREAT
Q
;
XMAIL1 ; Post-installation Notification for Installer
K PSG,XMY S XMDUZ=.5,XMSUB="PATCH PSO*7.0*517 INSTALLATION COMPLETE",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
S PSG(1,0)=" -- INSTALLER --"
S PSG(2,0)=" The post-install for PSO*7.0*517 completed "_Y_"."
D ^XMD
Q
;
XMAIL2 ; Post-installation Notification for Users
N PSOX,PSODFN,PSOPSNEW,PSOPSOLD
S XMSUB="PSO*7.0*517 Pharmacy Patient file (#55) PS Node Change"
S XMDUZ=.5
S ^TMP($J,"PSO",1)=" Patch PSO*7.0*517 post-installation routine has updated"
S ^TMP($J,"PSO",2)=" the ""PS"" node of "_PSOCNT_" patients on the PHARMACY"
S ^TMP($J,"PSO",3)=" PATIENT file (#55)."
S ^TMP($J,"PSO",4)=" "
S ^TMP($J,"PSO",5)=" The DEFAULT PATIENT STATUS node should contain only one piece"
S ^TMP($J,"PSO",6)=" of numeric data that corresponds to a Patient Status in the"
S ^TMP($J,"PSO",7)=" RX PATIENT STATUS file (#53)."
S ^TMP($J,"PSO",8)=" "
S ^TMP($J,"PSO",9)=" Information identifying patients with PS node changes"
S ^TMP($J,"PSO",10)=" will remain in ^XTMP("_$J_",""PSO7P517"",DFN,""PS"") for 60"
S ^TMP($J,"PSO",11)=" days."
S ^TMP($J,"PSO",12)=""
S ^TMP($J,"PSO",13)=" The following PHARMACY PATIENT file (#55) entries"
S ^TMP($J,"PSO",14)=" contained corrupt ""PS"" nodes that were updated."
S ^TMP($J,"PSO",15)=""
S ^TMP($J,"PSO",16)=" DFN Old PS Node New PS Node"
S ^TMP($J,"PSO",17)=" ---------- ----------- -----------"
I PSOCNT=0 S ^TMP($J,"PSO",18)=" No corrupt PS Nodes found."
S PSOCNT=17
S PSODFN=0 F S PSODFN=$O(^XTMP($J,ZZ,PSODFN)) Q:PSODFN="" D
. S PSOCNT=PSOCNT+1
. S PSOPSOLD=$P(^XTMP($J,ZZ,PSODFN,"PS"),"|",2)
. S PSOPSNEW=$P(^XTMP($J,ZZ,PSODFN,"PS"),"|")
. S ^TMP($J,"PSO",PSOCNT)=" "_$J(PSODFN,10)_" "_$J(PSOPSOLD,11)_" "_$J(PSOPSNEW,11)
S PSOX="" F S PSOX=$O(^XUSEC("PSORPH",PSOX)) Q:'PSOX S XMY(PSOX)=""
S XMY(DUZ)=""
S XMTEXT="^TMP($J,""PSO""," N DIFROM D ^XMD
K PSOCNT,XMSUB,XMDUZ,XMY,XMTEXT,^TMP($J,"PSO")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7P517 4090 printed Dec 13, 2024@02:23:54 Page 2
PSO7P517 ;MHA - Post Install routine for PSO*7*517 ;1/25/18@14:30
+1 ;;7.0;OUTPATIENT PHARMACY;**517**;DEC 1997;Build 15
+2 ;This post-installation routine will loop through the PHARMACY PATIENT file (#55)
+3 ;and plus the ^PS(55,DFN,"PS") - DEFAULT PATIENT STATUS - node if it contains "^"
+4 ;delimiters, because this node should only contain one numeric piece.
+5 QUIT
+6 ;
EN ; Begin post-installation routine
+1 IF $GET(DUZ)=""
WRITE !,"Your DUZ is not defined. It must be defined to run this routine."
QUIT
+2 NEW PATCH,JOBN,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,Y,ZTQUEUED,ZTREQ,ZTSAVE,SBJM,ZZ
+3 SET JOBN="PSO*7.0*517 Post-Installation"
+4 SET PATCH="PSO*7.0*517"
SET ZZ="PSO7P517"
+5 SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
+6 DO BMES^XPDUTL("=============================================================")
+7 DO MES^XPDUTL("Queuing background job for "_JOBN_"...")
+8 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+9 DO MES^XPDUTL("A MailMan message will be sent to the installer upon Post")
+10 DO MES^XPDUTL("Install Completion. This may take an hour or more, depending")
+11 DO MES^XPDUTL("upon site size.")
+12 DO MES^XPDUTL("==============================================================")
+13 ;
+14 SET ZTRTN="ENQN^PSO7P517"
SET ZTIO=""
+15 SET (SBJM,ZTDESC)="Background job for "_JOBN
+16 SET ZTSAVE("JOBN")=""
SET ZTSAVE("ZTDTH")=""
SET ZTSAVE("DUZ")=""
SET ZTSAVE("SBJM")=""
SET ZTSAVE("ZZ")=""
+17 DO ^%ZTLOAD
+18 if $DATA(ZTSK)
Begin DoDot:1
+19 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+20 DO BMES^XPDUTL("")
End DoDot:1
+21 DO BMES^XPDUTL("")
+22 KILL XPDQUES
+23 QUIT
+24 ;
ENQN ;
+1 NEW PSOCNT,PSOCREAT,PSODFN,PSOEXPR,PSOPSNEW,PSOPSOLD,PSOSTART
+2 DO NOW^%DTC
SET PSOSTART=$EXTRACT(%,1,12)
SET PSOCREAT=$EXTRACT(%,1,7)
SET PSOEXPR=$$FMADD^XLFDT(PSOCREAT,60,0,0,0)
+3 KILL ^XTMP($JOB,ZZ),^TMP($JOB,"PSO")
+4 SET (PSOCNT,PSODFN)=0
FOR
SET PSODFN=$ORDER(^PS(55,PSODFN))
if 'PSODFN
QUIT
Begin DoDot:1
+5 IF $GET(^PS(55,PSODFN,"PS"))["^"
Begin DoDot:2
+6 SET PSOPSOLD=^PS(55,PSODFN,"PS")
+7 SET PSOPSNEW=+^PS(55,PSODFN,"PS")
+8 SET ^PS(55,PSODFN,"PS")=PSOPSNEW
+9 SET ^XTMP($JOB,ZZ,PSODFN,"PS")=PSOPSNEW_"|"_PSOPSOLD
+10 SET PSOCNT=PSOCNT+1
End DoDot:2
End DoDot:1
+11 DO STOP
+12 QUIT
+13 ;
STOP KILL DA,DIE,DR,NUM,CPS,CPSX,%
+1 DO XMAIL1
+2 DO XMAIL2
+3 if $DATA(^XTMP($JOB,ZZ))
SET ^XTMP($JOB,ZZ,0)=PSOEXPR_"^"_PSOCREAT
+4 QUIT
+5 ;
XMAIL1 ; Post-installation Notification for Installer
+1 KILL PSG,XMY
SET XMDUZ=.5
SET XMSUB="PATCH PSO*7.0*517 INSTALLATION COMPLETE"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+2 SET PSG(1,0)=" -- INSTALLER --"
+3 SET PSG(2,0)=" The post-install for PSO*7.0*517 completed "_Y_"."
+4 DO ^XMD
+5 QUIT
+6 ;
XMAIL2 ; Post-installation Notification for Users
+1 NEW PSOX,PSODFN,PSOPSNEW,PSOPSOLD
+2 SET XMSUB="PSO*7.0*517 Pharmacy Patient file (#55) PS Node Change"
+3 SET XMDUZ=.5
+4 SET ^TMP($JOB,"PSO",1)=" Patch PSO*7.0*517 post-installation routine has updated"
+5 SET ^TMP($JOB,"PSO",2)=" the ""PS"" node of "_PSOCNT_" patients on the PHARMACY"
+6 SET ^TMP($JOB,"PSO",3)=" PATIENT file (#55)."
+7 SET ^TMP($JOB,"PSO",4)=" "
+8 SET ^TMP($JOB,"PSO",5)=" The DEFAULT PATIENT STATUS node should contain only one piece"
+9 SET ^TMP($JOB,"PSO",6)=" of numeric data that corresponds to a Patient Status in the"
+10 SET ^TMP($JOB,"PSO",7)=" RX PATIENT STATUS file (#53)."
+11 SET ^TMP($JOB,"PSO",8)=" "
+12 SET ^TMP($JOB,"PSO",9)=" Information identifying patients with PS node changes"
+13 SET ^TMP($JOB,"PSO",10)=" will remain in ^XTMP("_$JOB_",""PSO7P517"",DFN,""PS"") for 60"
+14 SET ^TMP($JOB,"PSO",11)=" days."
+15 SET ^TMP($JOB,"PSO",12)=""
+16 SET ^TMP($JOB,"PSO",13)=" The following PHARMACY PATIENT file (#55) entries"
+17 SET ^TMP($JOB,"PSO",14)=" contained corrupt ""PS"" nodes that were updated."
+18 SET ^TMP($JOB,"PSO",15)=""
+19 SET ^TMP($JOB,"PSO",16)=" DFN Old PS Node New PS Node"
+20 SET ^TMP($JOB,"PSO",17)=" ---------- ----------- -----------"
+21 IF PSOCNT=0
SET ^TMP($JOB,"PSO",18)=" No corrupt PS Nodes found."
+22 SET PSOCNT=17
+23 SET PSODFN=0
FOR
SET PSODFN=$ORDER(^XTMP($JOB,ZZ,PSODFN))
if PSODFN=""
QUIT
Begin DoDot:1
+24 SET PSOCNT=PSOCNT+1
+25 SET PSOPSOLD=$PIECE(^XTMP($JOB,ZZ,PSODFN,"PS"),"|",2)
+26 SET PSOPSNEW=$PIECE(^XTMP($JOB,ZZ,PSODFN,"PS"),"|")
+27 SET ^TMP($JOB,"PSO",PSOCNT)=" "_$JUSTIFY(PSODFN,10)_" "_$JUSTIFY(PSOPSOLD,11)_" "_$JUSTIFY(PSOPSNEW,11)
End DoDot:1
+28 SET PSOX=""
FOR
SET PSOX=$ORDER(^XUSEC("PSORPH",PSOX))
if 'PSOX
QUIT
SET XMY(PSOX)=""
+29 SET XMY(DUZ)=""
+30 SET XMTEXT="^TMP($J,""PSO"","
NEW DIFROM
DO ^XMD
+31 KILL PSOCNT,XMSUB,XMDUZ,XMY,XMTEXT,^TMP($JOB,"PSO")
+32 QUIT
+33 ;
