source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOFIXIB.m@ 1801

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

initial load of WorldVistAEHR

File size: 620 bytes
RevLine 
[613]1PSOFIXIB ;BHAM ISC/RTR - REMOVE IB NODES FROM EXEMPT PRESCRIPTIONS ;8/4/93
2 ;;6.0;OUTPATIENT PHARMACY;**23**;AUGUST 1993
3 D WAIT^DICD W "Checking Prescriptions."
4 S SDATE=2921028,FILL="",(PN,RX)=0 F S SDATE=$O(^PSRX("AD",SDATE)) Q:'SDATE D
5 .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
6 ..W "." I 'FILL,$D(^PSRX(RX,"IB")) K ^PSRX(RX,"IB") S PN=PN+1 Q
7 ..I FILL,$D(^PSRX(RX,1,FILL,"IB")) K ^PSRX(RX,1,FILL,"IB") S PN=PN+1
8 W !!,"Finished. "_PN_" Prescriptions Found.",! K PN,FILL,SDATE,RX,SUS,DFN,X Q
Note: See TracBrowser for help on using the repository browser.