- 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 Apr 23, 2025@18:37:04 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
