| 1 | PSOBMST ;BIR/LAW-black line resolver ;03/6/98
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**2,71,193**;DEC 1997
|
|---|
| 3 | ;master program launched by psob
|
|---|
| 4 | S PSOBMST="",PSOBP1=+PSOBR1,PSOBR1=+$P(PSOBR1,"^",2),PSOBP2=+PSOBR2,PSOBR2=+$P(PSOBR2,"^",2),(NEW1,NEW11)="",PSOBRX=PSOBR1
|
|---|
| 5 | F ZI=PSOBP1-1:0 S ZI=$O(^PS(52.9,PSOBIO,1,ZI)) Q:('ZI)!(PSOBP2<ZI) S (PSOBX,PSOBX1)="",P=$S($P(^(ZI,0),"^",2)="P":U,1:",") D J D PRF:(P=U)&(ZI'=PSOBP1),LBL:(P'=U)&(PSOBX'="") S PSOBRX=0
|
|---|
| 6 | D ^%ZISC K CC,EXDT,I,II,IOP,J,JJ,K,L,LBL,NEW1,NEW11,P,PI,POP,PPL,PSCAP,PSOSITE,PSOBIO,PSOBMST,PSOBP1,PSOBP2,PSOBR1,PSOBR2,PSOBRX,PSOBX,PSOBLALL,PSOBX1,REF,RX,WARN,X,Y,ZI,ZY,%ZIS,PSODIV,PDUZ,PSOBXPRT,BBB,BBBB,PBXRF S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 7 | J Q:'$D(^PS(52.9,PSOBIO,1,ZI,2)) F J=PSOBRX:0 S J=$O(^PS(52.9,PSOBIO,1,ZI,2,J)) Q:('J)!((ZI=PSOBP2)&(J=PSOBR2)) D SET
|
|---|
| 8 | Q
|
|---|
| 9 | SET I ($L(PSOBX)+$L(^PS(52.9,PSOBIO,1,ZI,2,J,0))+1)<245 S PSOBX=PSOBX_+^(0)_P S:$P(^(0),"^",2) PSOBXPRT($P(^(0),"^"))=$P(^(0),"^",2) S:$P(^(0),"^",3)'="" PBXRF($P(^(0),"^"))=$P(^(0),"^",3)
|
|---|
| 10 | E S PSOBX1=PSOBX1_+^PS(52.9,PSOBIO,1,ZI,2,J,0)_P S:$P(^(0),"^",2) PSOBXPRT($P(^(0),"^"))=$P(^(0),"^",2) S:$P(^(0),"^",3)'="" PBXRF($P(^(0),"^"))=$P(^(0),"^",3)
|
|---|
| 11 | Q
|
|---|
| 12 | PRF Q:(ZI=PSOBP2)&((PSOBR2=0)!($D(^PS(52.9,PSOBIO,1,ZI,2,PSOBR2,0)))) S:PSOBX'="" NEW1="^"_PSOBX S:PSOBX1'="" NEW11="^"_PSOBX1
|
|---|
| 13 | S DFN=$P(^PS(52.9,PSOBIO,1,ZI,0),"^"),PSODTCUT=$P(^(0),"^",4),PSOPRPAS=$P(^(0),"^",6),PFIO=IO,%ZIS="",IOP=PFIO D ^%ZIS D START^PSOPRF S (NEW1,NEW11)="" K DFN,PSODTCUT,PSOPRPAS,IOP Q
|
|---|
| 14 | LBL S PPL=PSOBX,PSOSITE=$P(^PS(52.9,PSOBIO,1,ZI,0),"^",7),REPRINT=1 S:$P(^(0),"^",5)'="" COPIES=$P(^(0),"^",5) S:$P(^(0),"^",6)'="" SIDE=$P(^(0),"^",6) I $D(^(1)),^(1)'="" S RXY=^(1)
|
|---|
| 15 | S IOP=IO,%ZIS="" D ^%ZIS K IOP D EN01
|
|---|
| 16 | F L=1:1 S LBL=$P(PPL,",",L) Q:(LBL="")&(L'<$L(PPL,",")) D UPDT
|
|---|
| 17 | I $G(PSOBX1)'="" S PSOBX=PSOBX1 S PSOBX1="" G LBL
|
|---|
| 18 | K PPL,PSOSITE,REPRINT,RXP,RXY,COPIES,SIDE Q
|
|---|
| 19 | UPDT ;
|
|---|
| 20 | S BBB=0 F BBBB=0:0 S BBBB=$O(^PSRX(LBL,1,BBBB)) Q:'BBBB S BBB=BBBB S:BBBB>5 BBB=BBBB+1
|
|---|
| 21 | S K=1,II=0 F JJ=0:0 S JJ=$O(^PSRX(LBL,"A",JJ)) Q:'JJ S II=JJ,K=K+1
|
|---|
| 22 | S II=II+1 S:'($D(^PSRX(LBL,"A",0))#2) ^(0)="^52.3DA^^^" S ^(0)=$P(^(0),"^",1,2)_"^"_II_"^"_K,^PSRX(LBL,"A",II,0)=DT_"^W^"_PDUZ_"^"_$S($G(PSOBXPRT(LBL)):6,$D(PBXRF(LBL)):PBXRF(LBL),1:BBB)_"^"_"GROUP REPRINT" D Q
|
|---|
| 23 | .I $G(PBXRF(LBL))>5,'$G(PSOBXPRT(LBL)) S $P(^PSRX(LBL,"A",II,0),"^",4)=($G(PBXRF(LBL))+1)
|
|---|
| 24 | EN01 I $D(PSOIOS),PSOIOS]"" D DEVBAR
|
|---|
| 25 | I $G(PSOBAR0)]"",$G(PSOBAR1)]"",$D(^PS(59,PSOSITE,1)) S PSOBARS=1
|
|---|
| 26 | K PSOCPN,PSOLBLCP
|
|---|
| 27 | I $G(PSODISP) D ^PSOLBL4
|
|---|
| 28 | G:'$D(PPL)!($P(PSOPAR,"^",30)=2) OUT
|
|---|
| 29 | F PI=1:1 Q:$P(PPL,",",PI)="" S RX=$P(PPL,",",PI) D
|
|---|
| 30 | .S PSOBLALL=1,RXRP(RX)=1_"^"_$G(COPIES)_"^"_$S($G(SIDE):1,1:0)
|
|---|
| 31 | .S:$G(PSOBXPRT(RX)) RXPR(RX)=PSOBXPRT(RX)
|
|---|
| 32 | .S:$D(PBXRF(RX)) RXFL(RX)=PBXRF(RX) D C^PSOLBL
|
|---|
| 33 | .K RXRP(+$G(PSOBLRX)),RXPR(+$G(PSOBLRX)),RXFL(+$G(PSOBLRX))
|
|---|
| 34 | .K PSOBLRX,RXP
|
|---|
| 35 | OUT K PSOCPN,PSOLBLCP,RXRP,RXPR,RXFL,PSOBLRX,RXP,RX
|
|---|
| 36 | Q
|
|---|
| 37 | DEVBAR ;get the barcode parameters
|
|---|
| 38 | N DA,DR,DPTR,DPTRS,DPTRS1,DIQ,DIC
|
|---|
| 39 | S DIC="^%ZIS(1,",DA=PSOIOS,DR="3",DIQ="DPTR",DIQ(0)="I" D EN^DIQ1
|
|---|
| 40 | S DPTRS=$G(DPTR(3.5,DA,3,DIQ(0)))
|
|---|
| 41 | S DIC="^%ZIS(2,",DA=DPTRS,DR="61;60",DIQ="DPTRS1",DIQ(0)="I" D EN^DIQ1
|
|---|
| 42 | S PSOBAR0="" I $G(DPTRS1(3.2,DA,61,DIQ(0)))'="" S PSOBAR0=$G(DPTRS1(3.2,DA,61,DIQ(0)))
|
|---|
| 43 | S PSOBAR1="" I $G(DPTRS1(3.2,DA,60,DIQ(0)))'="" S PSOBAR1=$G(DPTRS1(3.2,DA,60,DIQ(0)))
|
|---|
| 44 | Q
|
|---|
