9 lines
620 B
Mathematica
9 lines
620 B
Mathematica
PSOFIXIB ;BHAM ISC/RTR - REMOVE IB NODES FROM EXEMPT PRESCRIPTIONS ;8/4/93
|
|
;;6.0;OUTPATIENT PHARMACY;**23**;AUGUST 1993
|
|
D WAIT^DICD W "Checking Prescriptions."
|
|
S SDATE=2921028,FILL="",(PN,RX)=0 F S SDATE=$O(^PSRX("AD",SDATE)) Q:'SDATE D
|
|
.F S RX=$O(^PSRX("AD",SDATE,RX)) Q:'RX F S FILL=$O(^PSRX("AD",SDATE,RX,FILL)) Q:FILL="" S DFN=+$P($G(^PSRX(RX,0)),"^",2) I DFN S X=$$RXST^IBARXEU(DFN) D:+X=1
|
|
..W "." I 'FILL,$D(^PSRX(RX,"IB")) K ^PSRX(RX,"IB") S PN=PN+1 Q
|
|
..I FILL,$D(^PSRX(RX,1,FILL,"IB")) K ^PSRX(RX,1,FILL,"IB") S PN=PN+1
|
|
W !!,"Finished. "_PN_" Prescriptions Found.",! K PN,FILL,SDATE,RX,SUS,DFN,X Q
|