source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPOST4.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1PSOPOST4 ;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
7EN ;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
24MAIL ;
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
Note: See TracBrowser for help on using the repository browser.