PSOPOST6 ;BIR/RTR-Update comples orders to CPRS ;03/29/02
;;7.0;OUTPATIENT PHARMACY;**101**;DEC 1997
;External reference to XPD(9.7 supported by DBIA 2197
;
K ZTDTH
N PSOBACKZ S PSOBACKZ=0
I $D(ZTQUEUED) S ZTDTH=$H,PSOBACKZ=1
I $G(ZTDTH)="" D
.W !!,"This background job will find all Outpatient Pharmacy orders that have complex",!,"Dosing instructions, and will send an update to CPRS for the orders. This will"
.W !,"fix the problem of some Sigs being truncated when displayed in CPRS. A mail",!,"message will be generated to this patch installer upon completion.",!
W ! S ZTRTN="START^PSOPOST6",ZTIO="",ZTDESC="Patch PSO*7*101 background job" D ^%ZTLOAD I '$D(ZTSK) D S XPDABORT=2
.W !!,"The status of this install will remain 'Start of Install'. Please reinstall",!,"this patch and queue the background job at that time.",!
.I '$G(PSOBACKZ) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
Q
START ;
N Y,PSOTMSTA,PSOTMSTB,PSOCOMCT,PSOTEXTO,PSOCOMIN,PSOCOMDT,PSOPXIN,PSOCXT,PSOCXZ
D NOW^%DTC S Y=% D DD^%DT S PSOTMSTA=$G(Y)
S (PSOCOMCT,PSOCOMIN)=0
S PSOCOMDT=$O(^XPD(9.7,"B","PSO*7.0*46","")) I PSOCOMDT S PSOCOMIN=$E($P($G(^XPD(9.7,PSOCOMDT,1)),"^"),1,7)
I '$G(PSOCOMIN) S PSOCOMIN=3010429
;go back 30 days from POE install, in case of back issue dates
S X1=PSOCOMIN,X2=-31 D C^%DTC S PSOCOMIN=X
F S PSOCOMIN=$O(^PSRX("AC",PSOCOMIN)) Q:PSOCOMIN="" S PSOPXIN="" F S PSOPXIN=$O(^PSRX("AC",PSOCOMIN,PSOPXIN)) Q:PSOPXIN="" I $O(^PSRX(PSOPXIN,6,1)) D
.I '$P($G(^PSRX(PSOPXIN,"OR1")),"^",2) Q
.S PSOCXT=0,PSOCXZ=""
.F S PSOCXZ=$O(^PSRX(PSOPXIN,6,PSOCXZ)) Q:PSOCXZ=""!(PSOCXT>1) I $G(^PSRX(PSOPXIN,6,PSOCXZ,0))'="" S PSOCXT=PSOCXT+1
.S PSOROPCH="PATCH"
.I PSOCXT>1 S PSOCOMCT=PSOCOMCT+1 D EN^PSOHLSN1(PSOPXIN,"RO")
MAIL ;Send mail message
K PSOROPCH
D NOW^%DTC S Y=% D DD^%DT S PSOTMSTB=$G(Y)
S XMDUZ="PATCH PSO*7*101 INSTALLATION",XMSUB="OUTPATIENT COMPLEX ORDERS SEARCH",XMY(DUZ)=""
K PSOTEXTO
S PSOTEXTO(1)="The background job for patch PSO*7*101 is complete.",PSOTEXTO(2)="It started on "_$G(PSOTMSTA),PSOTEXTO(3)="It finished on "_$G(PSOTMSTB),PSOTEXTO(4)=" ",PSOTEXTO(5)="The total number of orders updated was "_$G(PSOCOMCT)_"."
S XMTEXT="PSOTEXTO(" N DIFROM D ^XMD
K XMDUZ,XMSUB,XMTEXT
S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPOST6 2317 printed Apr 09, 2024@21:38:50 Page 2
PSOPOST6 ;BIR/RTR-Update comples orders to CPRS ;03/29/02
+1 ;;7.0;OUTPATIENT PHARMACY;**101**;DEC 1997
+2 ;External reference to XPD(9.7 supported by DBIA 2197
+3 ;
+4 KILL ZTDTH
+5 NEW PSOBACKZ
SET PSOBACKZ=0
+6 IF $DATA(ZTQUEUED)
SET ZTDTH=$HOROLOG
SET PSOBACKZ=1
+7 IF $GET(ZTDTH)=""
Begin DoDot:1
+8 WRITE !!,"This background job will find all Outpatient Pharmacy orders that have complex",!,"Dosing instructions, and will send an update to CPRS for the orders. This will"
+9 WRITE !,"fix the problem of some Sigs being truncated when displayed in CPRS. A mail",!,"message will be generated to this patch installer upon completion.",!
End DoDot:1
+10 WRITE !
SET ZTRTN="START^PSOPOST6"
SET ZTIO=""
SET ZTDESC="Patch PSO*7*101 background job"
DO ^%ZTLOAD
IF '$DATA(ZTSK)
Begin DoDot:1
+11 WRITE !!,"The status of this install will remain 'Start of Install'. Please reinstall",!,"this patch and queue the background job at that time.",!
+12 IF '$GET(PSOBACKZ)
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
End DoDot:1
SET XPDABORT=2
+13 QUIT
START ;
+1 NEW Y,PSOTMSTA,PSOTMSTB,PSOCOMCT,PSOTEXTO,PSOCOMIN,PSOCOMDT,PSOPXIN,PSOCXT,PSOCXZ
+2 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOTMSTA=$GET(Y)
+3 SET (PSOCOMCT,PSOCOMIN)=0
+4 SET PSOCOMDT=$ORDER(^XPD(9.7,"B","PSO*7.0*46",""))
IF PSOCOMDT
SET PSOCOMIN=$EXTRACT($PIECE($GET(^XPD(9.7,PSOCOMDT,1)),"^"),1,7)
+5 IF '$GET(PSOCOMIN)
SET PSOCOMIN=3010429
+6 ;go back 30 days from POE install, in case of back issue dates
+7 SET X1=PSOCOMIN
SET X2=-31
DO C^%DTC
SET PSOCOMIN=X
+8 FOR
SET PSOCOMIN=$ORDER(^PSRX("AC",PSOCOMIN))
if PSOCOMIN=""
QUIT
SET PSOPXIN=""
FOR
SET PSOPXIN=$ORDER(^PSRX("AC",PSOCOMIN,PSOPXIN))
if PSOPXIN=""
QUIT
IF $ORDER(^PSRX(PSOPXIN,6,1))
Begin DoDot:1
+9 IF '$PIECE($GET(^PSRX(PSOPXIN,"OR1")),"^",2)
QUIT
+10 SET PSOCXT=0
SET PSOCXZ=""
+11 FOR
SET PSOCXZ=$ORDER(^PSRX(PSOPXIN,6,PSOCXZ))
if PSOCXZ=""!(PSOCXT>1)
QUIT
IF $GET(^PSRX(PSOPXIN,6,PSOCXZ,0))'=""
SET PSOCXT=PSOCXT+1
+12 SET PSOROPCH="PATCH"
+13 IF PSOCXT>1
SET PSOCOMCT=PSOCOMCT+1
DO EN^PSOHLSN1(PSOPXIN,"RO")
End DoDot:1
MAIL ;Send mail message
+1 KILL PSOROPCH
+2 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOTMSTB=$GET(Y)
+3 SET XMDUZ="PATCH PSO*7*101 INSTALLATION"
SET XMSUB="OUTPATIENT COMPLEX ORDERS SEARCH"
SET XMY(DUZ)=""
+4 KILL PSOTEXTO
+5 SET PSOTEXTO(1)="The background job for patch PSO*7*101 is complete."
SET PSOTEXTO(2)="It started on "_$GET(PSOTMSTA)
SET PSOTEXTO(3)="It finished on "_$GET(PSOTMSTB)
SET PSOTEXTO(4)=" "
SET PSOTEXTO(5)="The total number of orders updated was "_$GET(PSOCOMCT)_"."
+6 SET XMTEXT="PSOTEXTO("
NEW DIFROM
DO ^XMD
+7 KILL XMDUZ,XMSUB,XMTEXT
+8 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+9 QUIT
