- PSOELPST ;BIR/RTR-Status update ;11/27/01
- ;;7.0;OUTPATIENT PHARMACY;**86**;DEC 1997
- ;External reference to STATUS^ORQOR2 supported by DBIA 3458
- ;External reference to ^OR(100 supported by DBIA 3463
- ;CPRS/Outpatient status update
- ;PSOCPRS = CPRS number (Placer)
- ;PSORXNUM = Outpatient number (52 ien)
- I '$G(XPDENV) Q
- N PSOPACRF
- S DIC=9.4,DIC(0)="Z",X="OUTPATIENT PHARMACY" D ^DIC K DIC I +Y'>0 W !!,"A problem was found when trying to identify a valid Outpatient Pharmacy",!,"package reference from the PACKAGE (#9.4) file." D S XPDQUIT=2 Q
- .W !,"This Patch cannot be installed until this problem is resolved.",!
- .K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
- S PSOPACRF=+Y
- W !,"This patch queues a job to find Outpatient Pharmacy orders that are expired or",!,"Discontinued, but are Active in CPRS. This patch will update the order in CPRS",!,"with the appropriate status."
- W ! K ZTDTH S ZTRTN="EN^PSOELPST",ZTDESC="Pharmacy/CPRS status clean up",ZTIO="",ZTSAVE("PSOPACRF")="" D ^%ZTLOAD I '$G(ZTSK) D S XPDQUIT=2
- .W !!,"Since this job was not queued, the patch will not be installed.",! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
- Q
- EN ;
- N PSOCPRS,PSORXNUM,PSOXCOM,PSOXDT,PSOIJ,PSOJJ,PSOREAS,PSOACRL,PSOPHR,PSOALC,PSOADT,PSONAT,PSOCOMM,PSOZDUZ,PSOELSTA,PSOELSTP,PSOETEXT,PSOECT,PSOCSTAT
- I '$G(DT) S DT=$$DT^XLFDT
- D NOW^%DTC S PSOELSTA=%
- S PSOECT=0
- S PSOCPRS="" F S PSOCPRS=$O(^PSRX("APL",PSOCPRS)) Q:PSOCPRS="" S PSORXNUM="" F S PSORXNUM=$O(^PSRX("APL",PSOCPRS,PSORXNUM)) Q:PSORXNUM="" D
- .I PSOCPRS'=$P($G(^PSRX(PSORXNUM,"OR1")),"^",2) Q
- .I '$D(^PSRX(PSORXNUM,0)) Q
- .I +$$STATUS^ORQOR2(PSOCPRS)'=6 Q
- .I PSORXNUM'=$P($G(^OR(100,PSOCPRS,4)),"^") Q
- .I PSOPACRF'=$P($G(^OR(100,PSOCPRS,0)),"^",14) Q
- .S PSOCSTAT=$P($G(^PSRX(PSORXNUM,"STA")),"^")
- .I PSOCSTAT=11 D Q
- ..I $P(^PSRX(PSORXNUM,0),"^",19)=2 S $P(^(0),"^",19)=1
- ..S PSOXCOM="Prescription past expiration date" D EN^PSOHLSN1(PSORXNUM,"SC","ZE",PSOXCOM) S PSOECT=PSOECT+1
- ..S PSOXDT=$S($P($G(^PSRX(PSORXNUM,2)),"^",6):$E($P($G(^(2)),"^",6),1,7),1:DT)_".2200"
- ..I $D(^OR(100,PSOCPRS,3)) S $P(^(3),"^")=PSOXDT
- .I PSOCSTAT=12!(PSOCSTAT=14)!(PSOCSTAT=15) D
- ..S (PSOIJ,PSOJJ,PSOPHR,PSOADT)=0 F S PSOIJ=$O(^PSRX(PSORXNUM,"A",PSOIJ)) Q:'PSOIJ S PSOREAS=$P($G(^(PSOIJ,0)),"^",2) I PSOREAS="C"!(PSOREAS="L") S PSOJJ=PSOIJ
- ..I PSOJJ S PSOACRL=$G(^PSRX(PSORXNUM,"A",PSOJJ,0)) D
- ...S PSOPHR=$P(PSOACRL,"^",3),PSOALC=$P(PSOACRL,"^",5),PSOADT=$P(PSOACRL,"^"),(PSONAT,PSOCOMM)=""
- ...I PSOALC["Renewed" S PSOCOMM="Renewed by Pharmacy"
- ...I PSOALC["Auto Discontinued" S PSOPHR="",PSONAT="A",PSOCOMM=$E($P(PSOALC,".",2),2,99) S:PSOCOMM="" PSOCOMM=PSOALC
- ...I PSOALC["Discontinued During" S PSOCOMM="Discontinued by Pharmacy"
- ..I 'PSOJJ S PSOCOMM="Discontinued by Pharmacy",PSONAT=""
- ..S PSOZDUZ=$G(DUZ) S:$G(PSOPHR) DUZ=PSOPHR D EN^PSOHLSN1(PSORXNUM,"OD",$S(PSOCSTAT=15:"RP",1:""),PSOCOMM,PSONAT) S PSOECT=PSOECT+1 S DUZ=PSOZDUZ
- ..I '$G(PSOADT) S PSOADT=DT_".2200"
- ..I $D(^OR(100,PSOCPRS,6)) S $P(^(6),"^",3)=$E(PSOADT,1,12)
- ..I $D(^OR(100,PSOCPRS,3)) S $P(^(3),"^")=$E(PSOADT,1,12)
- MAIL ;Send mail message upon job completion
- K PSOPACRF
- I $G(DUZ) D
- .S XMDUZ="Patch PSO*7*86 Patch Install",XMSUB="Outpatient/CPRS Status clean-up",XMY(DUZ)=""
- .D NOW^%DTC S PSOELSTP=%
- .S PSOETEXT(1)="The tasked job for patch PSO*7*86 is complete."
- .S PSOETEXT(2)="The total number of mismatched statuses found were "_+$G(PSOECT)_"."
- .S Y=$G(PSOELSTA) D DD^%DT S PSOELSTA=$G(Y)
- .S Y=$G(PSOELSTP) D DD^%DT S PSOELSTP=$G(Y)
- .S PSOETEXT(3)="The job started on "_$G(PSOELSTA)_"."
- .S PSOETEXT(4)="The job ended on "_$G(PSOELSTP)_"."
- .S XMTEXT="PSOETEXT(" N DIFROM D ^XMD K Y,XMDUZ,XMTEXT,XMSUB
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- PSOELPST ;BIR/RTR-Status update ;11/27/01
- +1 ;;7.0;OUTPATIENT PHARMACY;**86**;DEC 1997
- +2 ;External reference to STATUS^ORQOR2 supported by DBIA 3458
- +3 ;External reference to ^OR(100 supported by DBIA 3463
- +4 ;CPRS/Outpatient status update
- +5 ;PSOCPRS = CPRS number (Placer)
- +6 ;PSORXNUM = Outpatient number (52 ien)
- +7 IF '$GET(XPDENV)
- QUIT
- +8 NEW PSOPACRF
- +9 SET DIC=9.4
- SET DIC(0)="Z"
- SET X="OUTPATIENT PHARMACY"
- DO ^DIC
- KILL DIC
- IF +Y'>0
- WRITE !!,"A problem was found when trying to identify a valid Outpatient Pharmacy",!,"package reference from the PACKAGE (#9.4) file."
- Begin DoDot:1
- +10 WRITE !,"This Patch cannot be installed until this problem is resolved.",!
- +11 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- SET XPDQUIT=2
- QUIT
- +12 SET PSOPACRF=+Y
- +13 WRITE !,"This patch queues a job to find Outpatient Pharmacy orders that are expired or",!,"Discontinued, but are Active in CPRS. This patch will update the order in CPRS",!,"with the appropriate status."
- +14 WRITE !
- KILL ZTDTH
- SET ZTRTN="EN^PSOELPST"
- SET ZTDESC="Pharmacy/CPRS status clean up"
- SET ZTIO=""
- SET ZTSAVE("PSOPACRF")=""
- DO ^%ZTLOAD
- IF '$GET(ZTSK)
- Begin DoDot:1
- +15 WRITE !!,"Since this job was not queued, the patch will not be installed.",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- SET XPDQUIT=2
- +16 QUIT
- EN ;
- +1 NEW PSOCPRS,PSORXNUM,PSOXCOM,PSOXDT,PSOIJ,PSOJJ,PSOREAS,PSOACRL,PSOPHR,PSOALC,PSOADT,PSONAT,PSOCOMM,PSOZDUZ,PSOELSTA,PSOELSTP,PSOETEXT,PSOECT,PSOCSTAT
- +2 IF '$GET(DT)
- SET DT=$$DT^XLFDT
- +3 DO NOW^%DTC
- SET PSOELSTA=%
- +4 SET PSOECT=0
- +5 SET PSOCPRS=""
- FOR
- SET PSOCPRS=$ORDER(^PSRX("APL",PSOCPRS))
- IF PSOCPRS=""
- QUIT
- SET PSORXNUM=""
- FOR
- SET PSORXNUM=$ORDER(^PSRX("APL",PSOCPRS,PSORXNUM))
- IF PSORXNUM=""
- QUIT
- Begin DoDot:1
- +6 IF PSOCPRS'=$PIECE($GET(^PSRX(PSORXNUM,"OR1")),"^",2)
- QUIT
- +7 IF '$DATA(^PSRX(PSORXNUM,0))
- QUIT
- +8 IF +$$STATUS^ORQOR2(PSOCPRS)'=6
- QUIT
- +9 IF PSORXNUM'=$PIECE($GET(^OR(100,PSOCPRS,4)),"^")
- QUIT
- +10 IF PSOPACRF'=$PIECE($GET(^OR(100,PSOCPRS,0)),"^",14)
- QUIT
- +11 SET PSOCSTAT=$PIECE($GET(^PSRX(PSORXNUM,"STA")),"^")
- +12 IF PSOCSTAT=11
- Begin DoDot:2
- +13 IF $PIECE(^PSRX(PSORXNUM,0),"^",19)=2
- SET $PIECE(^(0),"^",19)=1
- +14 SET PSOXCOM="Prescription past expiration date"
- DO EN^PSOHLSN1(PSORXNUM,"SC","ZE",PSOXCOM)
- SET PSOECT=PSOECT+1
- +15 SET PSOXDT=$SELECT($PIECE($GET(^PSRX(PSORXNUM,2)),"^",6):$EXTRACT($PIECE($GET(^(2)),"^",6),1,7),1:DT)_".2200"
- +16 IF $DATA(^OR(100,PSOCPRS,3))
- SET $PIECE(^(3),"^")=PSOXDT
- End DoDot:2
- QUIT
- +17 IF PSOCSTAT=12!(PSOCSTAT=14)!(PSOCSTAT=15)
- Begin DoDot:2
- +18 SET (PSOIJ,PSOJJ,PSOPHR,PSOADT)=0
- FOR
- SET PSOIJ=$ORDER(^PSRX(PSORXNUM,"A",PSOIJ))
- IF 'PSOIJ
- QUIT
- SET PSOREAS=$PIECE($GET(^(PSOIJ,0)),"^",2)
- IF PSOREAS="C"!(PSOREAS="L")
- SET PSOJJ=PSOIJ
- +19 IF PSOJJ
- SET PSOACRL=$GET(^PSRX(PSORXNUM,"A",PSOJJ,0))
- Begin DoDot:3
- +20 SET PSOPHR=$PIECE(PSOACRL,"^",3)
- SET PSOALC=$PIECE(PSOACRL,"^",5)
- SET PSOADT=$PIECE(PSOACRL,"^")
- SET (PSONAT,PSOCOMM)=""
- +21 IF PSOALC["Renewed"
- SET PSOCOMM="Renewed by Pharmacy"
- +22 IF PSOALC["Auto Discontinued"
- SET PSOPHR=""
- SET PSONAT="A"
- SET PSOCOMM=$EXTRACT($PIECE(PSOALC,".",2),2,99)
- IF PSOCOMM=""
- SET PSOCOMM=PSOALC
- +23 IF PSOALC["Discontinued During"
- SET PSOCOMM="Discontinued by Pharmacy"
- End DoDot:3
- +24 IF 'PSOJJ
- SET PSOCOMM="Discontinued by Pharmacy"
- SET PSONAT=""
- +25 SET PSOZDUZ=$GET(DUZ)
- IF $GET(PSOPHR)
- SET DUZ=PSOPHR
- DO EN^PSOHLSN1(PSORXNUM,"OD",$SELECT(PSOCSTAT=15:"RP",1:""),PSOCOMM,PSONAT)
- SET PSOECT=PSOECT+1
- SET DUZ=PSOZDUZ
- +26 IF '$GET(PSOADT)
- SET PSOADT=DT_".2200"
- +27 IF $DATA(^OR(100,PSOCPRS,6))
- SET $PIECE(^(6),"^",3)=$EXTRACT(PSOADT,1,12)
- +28 IF $DATA(^OR(100,PSOCPRS,3))
- SET $PIECE(^(3),"^")=$EXTRACT(PSOADT,1,12)
- End DoDot:2
- End DoDot:1
- MAIL ;Send mail message upon job completion
- +1 KILL PSOPACRF
- +2 IF $GET(DUZ)
- Begin DoDot:1
- +3 SET XMDUZ="Patch PSO*7*86 Patch Install"
- SET XMSUB="Outpatient/CPRS Status clean-up"
- SET XMY(DUZ)=""
- +4 DO NOW^%DTC
- SET PSOELSTP=%
- +5 SET PSOETEXT(1)="The tasked job for patch PSO*7*86 is complete."
- +6 SET PSOETEXT(2)="The total number of mismatched statuses found were "_+$GET(PSOECT)_"."
- +7 SET Y=$GET(PSOELSTA)
- DO DD^%DT
- SET PSOELSTA=$GET(Y)
- +8 SET Y=$GET(PSOELSTP)
- DO DD^%DT
- SET PSOELSTP=$GET(Y)
- +9 SET PSOETEXT(3)="The job started on "_$GET(PSOELSTA)_"."
- +10 SET PSOETEXT(4)="The job ended on "_$GET(PSOELSTP)_"."
- +11 SET XMTEXT="PSOETEXT("
- NEW DIFROM
- DO ^XMD
- KILL Y,XMDUZ,XMTEXT,XMSUB
- End DoDot:1
- +12 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +13 QUIT
