| [613] | 1 | PSOCMOPC ;BIR/HTW-Utility for CMOP/OP Edit ;8/30/96
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**2,30,43**;DEC 1997
|
|---|
| 3 | ;External reference to ^PS(55 supported by DBIA 2228
|
|---|
| 4 | ;External reference to ^PSDRUG supported by DBIA 221
|
|---|
| 5 | EN(XDA) N A,A1,CMOP,PSOA,PSOB,PSOCK,T,T1,DA
|
|---|
| 6 | ;
|
|---|
| 7 | S DA=XDA
|
|---|
| 8 | D ^PSOCMOPA
|
|---|
| 9 | ; Q:If not in suspense file, set status to 0 - active
|
|---|
| 10 | I '$G(CMOP("52.5")) D Q
|
|---|
| 11 | . S:+$P($G(PSOLST(ORN)),"^",2) ^PSRX($P(PSOLST(ORN),"^",2),"STA")=0
|
|---|
| 12 | ;
|
|---|
| 13 | D CHECK
|
|---|
| 14 | I $G(CMOP("S"))']"",($G(CMOP)) D ACT D G QUIT
|
|---|
| 15 | .K ^PS(52.5,"AC",$P(^PSRX(XDA,0),"^",2),$P(^PS(52.5,CMOP("52.5"),0),"^",2),CMOP("52.5"))
|
|---|
| 16 | .S DIE="^PS(52.5,",DR="3////Q",DA=CMOP("52.5") D ^DIE K DIE
|
|---|
| 17 | .S T=$P(^PSRX(XDA,3),"^")
|
|---|
| 18 | .S T1=$E(T,4,5)_"-"_$E(T,6,7)_"-"_$E(T,2,3)
|
|---|
| 19 | .S $P(^PSRX(XDA,"A",0),"^",3)=A,$P(^PSRX(XDA,"A",0),"^",4)=A1
|
|---|
| 20 | .D NOW^%DTC
|
|---|
| 21 | .S ^PSRX(XDA,"A",PSOB,0)=%_"^S^"_DUZ_"^"_$S($G(CMOP("L"))<6:$G(CMOP("L")),1:$G(CMOP("L"))+1)_"^ Placed on Suspense for CMOP until "_T1
|
|---|
| 22 | .K T,T1,%
|
|---|
| 23 | UNSUS ; If Rx is suspended and is not CMOP, ensure is not suspended as CMOP
|
|---|
| 24 | I $G(CMOP("S"))["Q",('$G(CMOP)) D G QUIT
|
|---|
| 25 | .S DIE="^PS(52.5,",DR="3////@",DA=CMOP("52.5") D ^DIE K DIE,DR
|
|---|
| 26 | .S ^PS(52.5,"AC",$P(^PSRX(XDA,0),"^",2),$P(^PS(52.5,DA,0),"^",2),DA)=""
|
|---|
| 27 | .D ACT
|
|---|
| 28 | .S T=$P(^PSRX(XDA,3),"^")
|
|---|
| 29 | .S T1=$E(T,4,5)_"-"_$E(T,6,7)_"-"_$E(T,2,3)
|
|---|
| 30 | .S $P(^PSRX(XDA,"A",0),"^",3)=A,$P(^PSRX(XDA,"A",0),"^",4)=A1
|
|---|
| 31 | .D NOW^%DTC
|
|---|
| 32 | .S ^PSRX(XDA,"A",PSOB,0)=%_"^S^"_DUZ_"^"_$S($G(CMOP("L"))<6:$G(CMOP("L")),1:$G(CMOP("L"))+1)_"^ Removed from CMOP Suspense, returned to OP Suspense. "_T1
|
|---|
| 33 | .S DA=XDA
|
|---|
| 34 | QUIT K A,A1,CMOP,PSOA,PSOB,PSOCK,T,T1,XDA Q
|
|---|
| 35 | ACT ; If no act node, make one .... determine last entry
|
|---|
| 36 | S:'$D(^PSRX(XDA,"A",0)) ^(0)="^52.3XDA^^"
|
|---|
| 37 | S PSOA="" F S PSOA=$O(^PSRX(XDA,"A",PSOA)) Q:PSOA']"" S PSOB=PSOA+1
|
|---|
| 38 | S A=$P(^PSRX(XDA,"A",0),"^",3),A1=$P(^PSRX(XDA,"A",0),"^",4),A=A+1,A1=A1+1
|
|---|
| 39 | K PSOA
|
|---|
| 40 | Q
|
|---|
| 41 | CHECK S CMOP=0 Q:'$G(PSXSYS)
|
|---|
| 42 | ; Q:Partial or Reprint
|
|---|
| 43 | S PSOCMSUS=$O(^PS(52.5,"B",XDA,0))
|
|---|
| 44 | I $G(PSOCMSUS) I $P($G(^PS(52.5,PSOCMSUS,0)),"^",5)!($P($G(^(0)),"^",12)) K PSOCMSUS Q
|
|---|
| 45 | K PSOCMSUS
|
|---|
| 46 | ; Q:Do not Mail
|
|---|
| 47 | S PSOCMPAT=+$P($G(^PSRX(XDA,0)),"^",2),PSOCMDT=$P($G(^PS(55,PSOCMPAT,0)),"^",5),PSOCMMAI=$P($G(^PS(55,PSOCMPAT,0)),"^",3)
|
|---|
| 48 | I $G(PSOCMMAI)>1,$S($G(PSOCMDT)=""!($G(PSOCMDT)>DT):1,1:0) D KMAIL Q
|
|---|
| 49 | D KMAIL
|
|---|
| 50 | ; Get drug IEN and check if CMOP
|
|---|
| 51 | S PSOCK=$P($G(^PSRX(XDA,0)),"^",6) Q:'$D(^PSDRUG("AQ",PSOCK))
|
|---|
| 52 | I $P($G(^PSDRUG(+$G(PSOCK),2)),"^",3)'["O" Q
|
|---|
| 53 | Q:$G(PSOFROM)="PARTIAL"
|
|---|
| 54 | ; Q:If tradename
|
|---|
| 55 | Q:$G(^PSRX(XDA,"TN"))]""
|
|---|
| 56 | ; Q: If Cancelled, Expired, Deleted
|
|---|
| 57 | Q:$P($G(^PSRX(XDA,"STA")),"^")>10
|
|---|
| 58 | ; Q: If pending
|
|---|
| 59 | Q:$P($G(^PSRX(XDA,"STA")),"^")=4
|
|---|
| 60 | ; Q:If not "Mail"
|
|---|
| 61 | S PSOMW=$S($G(CMOP("L"))>0:$P(^PSRX(XDA,1,CMOP("L"),0),"^",2),1:$P(^PSRX(XDA,0),"^",11)) I $G(PSOMW)="W" K CMOP("L") Q
|
|---|
| 62 | ; Q:If fill was CMOPed and other than '3' 'not dispensed'
|
|---|
| 63 | Q:'$$FILTRAN^PSOCMOP(XDA,CMOP("L"))
|
|---|
| 64 | S CMOP=1
|
|---|
| 65 | Q
|
|---|
| 66 | KMAIL K PSOCMPAT,PSOCMDT,PSOCMMAI Q
|
|---|
