PSO146PS ;BIR/RTR-Patch 146 Post Install routine ;08/16/03
;;7.0;OUTPATIENT PHARMACY;**146**;DEC 1997
;
S ZTDTH=@XPDGREF@("PSOQ146")
S ZTRTN="START^PSO146PS",ZTDESC="Post Init for patch PSO*7*146",ZTIO="" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
I $D(ZTSK)&('$D(ZTQUEUED)) D BMES^XPDUTL("Task Queued!")
Q
START ;
I '$G(DT) S DT=$$DT^XLFDT
N PSOTTEXT,PSOTPSTZ,PSOTPLLZ,PSOTPFLG,PSOTDFN,PSOTDFNX
D NOW^%DTC S Y=% X ^DD("DD") S PSOTTEXT(3)="The job started at "_$G(Y) K Y
;Update Rx Patient Status entry
S PSOTPFLG=0
F PSOTPLLZ=0:0 S PSOTPLLZ=$O(^PS(53,PSOTPLLZ)) Q:'PSOTPLLZ D
.S PSOTPSTZ=$P($G(^PS(53,PSOTPLLZ,0)),"^") I PSOTPSTZ'="",$$UP^XLFSTR(PSOTPSTZ)="NON-VA" S $P(^PS(53,PSOTPLLZ,0),"^",6)=5,PSOTPFLG=PSOTPFLG+1
I '$G(PSOTPFLG) S PSOTTEXT(6)="Could not find a NON-VA entry in the RX PATIENT STATUS file." S PSOTTEXT(7)="Please contact National Vista Support!"
I $G(PSOTPFLG)>1 S PSOTTEXT(6)="Found multiple entries of NON-VA in the RX PATIENT STATUS file." S PSOTTEXT(7)="Please contact National Vista Support!"
;Disable Enter/Edit option
K DIC,X S DIC(0)="X",DIC=19,X="PSO TPB PATIENT ENTER/EDIT" D ^DIC K DIC
I +Y>0 K DA,DIE,DR S DA=+Y,DIE="^DIC(19,",DR="2////"_"TEMPORARILY OUT OF ORDER - POST INSTALL RUNNING" D ^DIE K DIE,DA,DR
;Date of death check
F PSOTDFN=0:0 S PSOTDFN=$O(^PS(52.91,PSOTDFN)) Q:'PSOTDFN I '$P($G(^PS(52.91,PSOTDFN,0)),"^",3)!($P($G(^(0)),"^",3)>DT) D
.K PSOTDFNX S PSOTDFNX=$$GET1^DIQ(2,PSOTDFN,.351,"I")
.I $G(PSOTDFNX) K DA,DIE,DR S DA=PSOTDFN,DIE="^PS(52.91,",DR="2////"_DT_";3////"_5 D ^DIE K DIE,DA,DR
K DIC,X S DIC(0)="X",DIC=19,X="PSO TPB PATIENT ENTER/EDIT" D ^DIC K DIC
I +Y>0 K DA,DR,DIE S DA=+Y,DIE="^DIC(19,",DR="2////"_"@" D ^DIE K DIE,DR,DA
K DIC,X S DIC(0)="X",DIC=19,X="PSO TPB RX ENTRY" D ^DIC K DIC
I +Y>0 K DA,DR,DIE S DA=+Y,DIE="^DIC(19,",DR="2////"_"@" D ^DIE K DIE,DR,DA
S ZTDTH=$H,ZTIO="",ZTRTN="^PSOTPHL1",ZTDESC="TPB PATIENT HL7 EXTRACT" D ^%ZTLOAD K ZTDTH,ZTIO,ZTRTN,ZTDESC
MAIL ;Send mail message
I '$G(DUZ) Q
S PSOTTEXT(1)="The Post-Init for patch PSO*7.0*146 is complete."
S PSOTTEXT(2)=" "
S PSOTTEXT(5)=" "
D NOW^%DTC S Y=% X ^DD("DD") S PSOTTEXT(4)="The job ended at "_$G(Y)
S XMDUZ="Patch PSO*7*146 Post Install",XMSUB="Patch PSO*7*146 Post Install Complete",XMY(DUZ)=""
S XMTEXT="PSOTTEXT(" N DIFROM D ^XMD
K PSOTTEXT,XMTEXT,XMSUB,XMDUZ,XMY
S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO146PS 2407 printed Sep 23, 2025@19:58:45 Page 2
PSO146PS ;BIR/RTR-Patch 146 Post Install routine ;08/16/03
+1 ;;7.0;OUTPATIENT PHARMACY;**146**;DEC 1997
+2 ;
+3 SET ZTDTH=@XPDGREF@("PSOQ146")
+4 SET ZTRTN="START^PSO146PS"
SET ZTDESC="Post Init for patch PSO*7*146"
SET ZTIO=""
DO ^%ZTLOAD
KILL ZTDTH,ZTRTN,ZTIO,ZTDESC
+5 IF $DATA(ZTSK)&('$DATA(ZTQUEUED))
DO BMES^XPDUTL("Task Queued!")
+6 QUIT
START ;
+1 IF '$GET(DT)
SET DT=$$DT^XLFDT
+2 NEW PSOTTEXT,PSOTPSTZ,PSOTPLLZ,PSOTPFLG,PSOTDFN,PSOTDFNX
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PSOTTEXT(3)="The job started at "_$GET(Y)
KILL Y
+4 ;Update Rx Patient Status entry
+5 SET PSOTPFLG=0
+6 FOR PSOTPLLZ=0:0
SET PSOTPLLZ=$ORDER(^PS(53,PSOTPLLZ))
if 'PSOTPLLZ
QUIT
Begin DoDot:1
+7 SET PSOTPSTZ=$PIECE($GET(^PS(53,PSOTPLLZ,0)),"^")
IF PSOTPSTZ'=""
IF $$UP^XLFSTR(PSOTPSTZ)="NON-VA"
SET $PIECE(^PS(53,PSOTPLLZ,0),"^",6)=5
SET PSOTPFLG=PSOTPFLG+1
End DoDot:1
+8 IF '$GET(PSOTPFLG)
SET PSOTTEXT(6)="Could not find a NON-VA entry in the RX PATIENT STATUS file."
SET PSOTTEXT(7)="Please contact National Vista Support!"
+9 IF $GET(PSOTPFLG)>1
SET PSOTTEXT(6)="Found multiple entries of NON-VA in the RX PATIENT STATUS file."
SET PSOTTEXT(7)="Please contact National Vista Support!"
+10 ;Disable Enter/Edit option
+11 KILL DIC,X
SET DIC(0)="X"
SET DIC=19
SET X="PSO TPB PATIENT ENTER/EDIT"
DO ^DIC
KILL DIC
+12 IF +Y>0
KILL DA,DIE,DR
SET DA=+Y
SET DIE="^DIC(19,"
SET DR="2////"_"TEMPORARILY OUT OF ORDER - POST INSTALL RUNNING"
DO ^DIE
KILL DIE,DA,DR
+13 ;Date of death check
+14 FOR PSOTDFN=0:0
SET PSOTDFN=$ORDER(^PS(52.91,PSOTDFN))
if 'PSOTDFN
QUIT
IF '$PIECE($GET(^PS(52.91,PSOTDFN,0)),"^",3)!($PIECE($GET(^(0)),"^",3)>DT)
Begin DoDot:1
+15 KILL PSOTDFNX
SET PSOTDFNX=$$GET1^DIQ(2,PSOTDFN,.351,"I")
+16 IF $GET(PSOTDFNX)
KILL DA,DIE,DR
SET DA=PSOTDFN
SET DIE="^PS(52.91,"
SET DR="2////"_DT_";3////"_5
DO ^DIE
KILL DIE,DA,DR
End DoDot:1
+17 KILL DIC,X
SET DIC(0)="X"
SET DIC=19
SET X="PSO TPB PATIENT ENTER/EDIT"
DO ^DIC
KILL DIC
+18 IF +Y>0
KILL DA,DR,DIE
SET DA=+Y
SET DIE="^DIC(19,"
SET DR="2////"_"@"
DO ^DIE
KILL DIE,DR,DA
+19 KILL DIC,X
SET DIC(0)="X"
SET DIC=19
SET X="PSO TPB RX ENTRY"
DO ^DIC
KILL DIC
+20 IF +Y>0
KILL DA,DR,DIE
SET DA=+Y
SET DIE="^DIC(19,"
SET DR="2////"_"@"
DO ^DIE
KILL DIE,DR,DA
+21 SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTRTN="^PSOTPHL1"
SET ZTDESC="TPB PATIENT HL7 EXTRACT"
DO ^%ZTLOAD
KILL ZTDTH,ZTIO,ZTRTN,ZTDESC
MAIL ;Send mail message
+1 IF '$GET(DUZ)
QUIT
+2 SET PSOTTEXT(1)="The Post-Init for patch PSO*7.0*146 is complete."
+3 SET PSOTTEXT(2)=" "
+4 SET PSOTTEXT(5)=" "
+5 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PSOTTEXT(4)="The job ended at "_$GET(Y)
+6 SET XMDUZ="Patch PSO*7*146 Post Install"
SET XMSUB="Patch PSO*7*146 Post Install Complete"
SET XMY(DUZ)=""
+7 SET XMTEXT="PSOTTEXT("
NEW DIFROM
DO ^XMD
+8 KILL PSOTTEXT,XMTEXT,XMSUB,XMDUZ,XMY
+9 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+10 QUIT
