Routine: PSOPOST4

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

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="@"

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

PSOPOST4.m