| 1 | PSOPOST4 ;BIR/RTR-Copay conversion routine ;11/13/01
 | 
|---|
| 2 |  ;;7.0;OUTPATIENT PHARMACY;**71**;DEC 1997
 | 
|---|
| 3 |  ;mail message, and queue the job?
 | 
|---|
| 4 |  D BMES^XPDUTL("Queuing background conversion job...")
 | 
|---|
| 5 |  S ZTDTH=$H,ZTRTN="EN^PSOPOST4",ZTIO="",ZTDESC="Copay install background job" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
 | 
|---|
| 6 |  Q
 | 
|---|
| 7 | EN ;Set Service Connected field, if possible
 | 
|---|
| 8 |  N PSODATE,PSOBEG,PSOIN,PSOCPAT,PSOPST,PSOIB,PSODRG,PSORXPST,PSSTEXT,PSOXIN
 | 
|---|
| 9 |  I '$G(DT) S DT=$$DT^XLFDT
 | 
|---|
| 10 |  S X1=DT,X2=-365 D C^%DTC S PSOBEG=X
 | 
|---|
| 11 |  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
 | 
|---|
| 12 |  .S PSOCPAT=$P($G(^PSRX(PSOIN,0)),"^",2) Q:'PSOCPAT
 | 
|---|
| 13 |  .I $P($G(^PSRX(PSOIN,"IBQ")),"^")'="" Q
 | 
|---|
| 14 |  .S PSOPST=$P($G(^PSRX(PSOIN,0)),"^",3),PSODRG=$P($G(^(0)),"^",6),PSOIB=$P($G(^("IB")),"^")
 | 
|---|
| 15 |  .I PSOIB=2 S $P(^PSRX(PSOIN,"IBQ"),"^")=0 Q
 | 
|---|
| 16 |  .I '$G(PSODRG)!('$G(PSOPST)) Q
 | 
|---|
| 17 |  .I $P($G(^PSDRUG(PSODRG,0)),"^",3)["S"!($P($G(^(0)),"^",3)["I") Q
 | 
|---|
| 18 |  .I '$G(PSOIB) D
 | 
|---|
| 19 |  ..S PSORXPST=$P($G(^PS(53,PSOPST,0)),"^")
 | 
|---|
| 20 |  ..I PSORXPST["50" D
 | 
|---|
| 21 |  ...S PSORXPST=$TR(PSORXPST,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 | 
|---|
| 22 |  ...I PSORXPST["<"!(PSORXPST["LESS THAN") D
 | 
|---|
| 23 |  ....S PSOXIN=$$RXST^IBARXEU(PSOCPAT,PSODATE) I $P($G(PSOXIN),"^")=0 S $P(^PSRX(PSOIN,"IBQ"),"^")=1
 | 
|---|
| 24 | MAIL ;
 | 
|---|
| 25 |  I $G(DUZ) D
 | 
|---|
| 26 |  .S XMDUZ="Outpatient Pharmacy Copay Installation",XMSUB="Outpatient Pharmacy Copay Job",XMY(DUZ)=""
 | 
|---|
| 27 |  .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."
 | 
|---|
| 28 |  .S XMTEXT="PSSTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
 | 
|---|
| 29 |  S:$D(ZTQUEUED) ZTREQ="@"
 | 
|---|
| 30 |  Q
 | 
|---|