PSOPOST4 ;BIR/RTR-Copay conversion routine ;11/13/01
;;7.0;OUTPATIENT PHARMACY;**71**;DEC 1997
;mail message, and queue the job?
D BMES^XPDUTL("Queuing background conversion job...")
S ZTDTH=$H,ZTRTN="EN^PSOPOST4",ZTIO="",ZTDESC="Copay install background job" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
Q
EN ;Set Service Connected field, if possible
N PSODATE,PSOBEG,PSOIN,PSOCPAT,PSOPST,PSOIB,PSODRG,PSORXPST,PSSTEXT,PSOXIN
I '$G(DT) S DT=$$DT^XLFDT
S X1=DT,X2=-365 D C^%DTC S PSOBEG=X
F PSODATE=PSOBEG:0 S PSODATE=$O(^PSRX("AC",PSODATE)) Q:'PSODATE!(PSODATE'<DT) S PSOIN="" F S PSOIN=$O(^PSRX("AC",PSODATE,PSOIN)) Q:'PSOIN D
.S PSOCPAT=$P($G(^PSRX(PSOIN,0)),"^",2) Q:'PSOCPAT
.I $P($G(^PSRX(PSOIN,"IBQ")),"^")'="" Q
.S PSOPST=$P($G(^PSRX(PSOIN,0)),"^",3),PSODRG=$P($G(^(0)),"^",6),PSOIB=$P($G(^("IB")),"^")
.I PSOIB=2 S $P(^PSRX(PSOIN,"IBQ"),"^")=0 Q
.I '$G(PSODRG)!('$G(PSOPST)) Q
.I $P($G(^PSDRUG(PSODRG,0)),"^",3)["S"!($P($G(^(0)),"^",3)["I") Q
.I '$G(PSOIB) D
..S PSORXPST=$P($G(^PS(53,PSOPST,0)),"^")
..I PSORXPST["50" D
...S PSORXPST=$TR(PSORXPST,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
...I PSORXPST["<"!(PSORXPST["LESS THAN") D
....S PSOXIN=$$RXST^IBARXEU(PSOCPAT,PSODATE) I $P($G(PSOXIN),"^")=0 S $P(^PSRX(PSOIN,"IBQ"),"^")=1
MAIL ;
I $G(DUZ) D
.S XMDUZ="Outpatient Pharmacy Copay Installation",XMSUB="Outpatient Pharmacy Copay Job",XMY(DUZ)=""
.S PSSTEXT(1)="The background job for the Outpatient Pharmacy Copay patch (PSO*7*71)",PSSTEXT(2)="is now complete. The SERVICE CONNECTED field in the PRESCRIPTION file",PSSTEXT(3)="has been populated for all applicable prescriptions."
.S XMTEXT="PSSTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPOST4 1749 printed Sep 23, 2025@20:09:19 Page 2
PSOPOST4 ;BIR/RTR-Copay conversion routine ;11/13/01
+1 ;;7.0;OUTPATIENT PHARMACY;**71**;DEC 1997
+2 ;mail message, and queue the job?
+3 DO BMES^XPDUTL("Queuing background conversion job...")
+4 SET ZTDTH=$HOROLOG
SET ZTRTN="EN^PSOPOST4"
SET ZTIO=""
SET ZTDESC="Copay install background job"
DO ^%ZTLOAD
KILL ZTDTH,ZTRTN,ZTIO,ZTDESC
+5 QUIT
EN ;Set Service Connected field, if possible
+1 NEW PSODATE,PSOBEG,PSOIN,PSOCPAT,PSOPST,PSOIB,PSODRG,PSORXPST,PSSTEXT,PSOXIN
+2 IF '$GET(DT)
SET DT=$$DT^XLFDT
+3 SET X1=DT
SET X2=-365
DO C^%DTC
SET PSOBEG=X
+4 FOR PSODATE=PSOBEG:0
SET PSODATE=$ORDER(^PSRX("AC",PSODATE))
if 'PSODATE!(PSODATE'<DT)
QUIT
SET PSOIN=""
FOR
SET PSOIN=$ORDER(^PSRX("AC",PSODATE,PSOIN))
if 'PSOIN
QUIT
Begin DoDot:1
+5 SET PSOCPAT=$PIECE($GET(^PSRX(PSOIN,0)),"^",2)
if 'PSOCPAT
QUIT
+6 IF $PIECE($GET(^PSRX(PSOIN,"IBQ")),"^")'=""
QUIT
+7 SET PSOPST=$PIECE($GET(^PSRX(PSOIN,0)),"^",3)
SET PSODRG=$PIECE($GET(^(0)),"^",6)
SET PSOIB=$PIECE($GET(^("IB")),"^")
+8 IF PSOIB=2
SET $PIECE(^PSRX(PSOIN,"IBQ"),"^")=0
QUIT
+9 IF '$GET(PSODRG)!('$GET(PSOPST))
QUIT
+10 IF $PIECE($GET(^PSDRUG(PSODRG,0)),"^",3)["S"!($PIECE($GET(^(0)),"^",3)["I")
QUIT
+11 IF '$GET(PSOIB)
Begin DoDot:2
+12 SET PSORXPST=$PIECE($GET(^PS(53,PSOPST,0)),"^")
+13 IF PSORXPST["50"
Begin DoDot:3
+14 SET PSORXPST=$TRANSLATE(PSORXPST,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+15 IF PSORXPST["<"!(PSORXPST["LESS THAN")
Begin DoDot:4
+16 SET PSOXIN=$$RXST^IBARXEU(PSOCPAT,PSODATE)
IF $PIECE($GET(PSOXIN),"^")=0
SET $PIECE(^PSRX(PSOIN,"IBQ"),"^")=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
MAIL ;
+1 IF $GET(DUZ)
Begin DoDot:1
+2 SET XMDUZ="Outpatient Pharmacy Copay Installation"
SET XMSUB="Outpatient Pharmacy Copay Job"
SET XMY(DUZ)=""
+3 SET PSSTEXT(1)="The background job for the Outpatient Pharmacy Copay patch (PSO*7*71)"
SET PSSTEXT(2)="is now complete. The SERVICE CONNECTED field in the PRESCRIPTION file"
SET PSSTEXT(3)="has been populated for all applicable prescriptions."
+4 SET XMTEXT="PSSTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
End DoDot:1
+5 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
