Routine: PSOFIXIB

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOFIXIB   628     printed  Apr 09, 2024@21:27:38                                                                                                                                                                                                     Page 2

PSOFIXIB  ;BHAM ISC/RTR - REMOVE IB NODES FROM EXEMPT PRESCRIPTIONS ;8/4/93

 +1       ;;6.0;OUTPATIENT PHARMACY;**23**;AUGUST 1993

 +2        DO WAIT^DICD

           WRITE "Checking Prescriptions."

 +3        SET SDATE=2921028

           SET FILL=""

           SET (PN,RX)=0

FOR

               SET SDATE=$ORDER(^PSRX("AD",SDATE))

               if 'SDATE

                   QUIT

               Begin DoDot:1

 +4                FOR

                       SET RX=$ORDER(^PSRX("AD",SDATE,RX))

                       if 'RX

                           QUIT

FOR

                           SET FILL=$ORDER(^PSRX("AD",SDATE,RX,FILL))

                           if FILL=""

                               QUIT

                           SET DFN=+$PIECE($GET(^PSRX(RX,0)),"^",2)

                           IF DFN

                               SET X=$$RXST^IBARXEU(DFN)

                               if +X=1

                                   Begin DoDot:2

 +5                                    WRITE "."

                                       IF 'FILL

                                           IF $DATA(^PSRX(RX,"IB"))

                                               KILL ^PSRX(RX,"IB")

                                               SET PN=PN+1

                                               QUIT

 +6                                    IF FILL

                                           IF $DATA(^PSRX(RX,1,FILL,"IB"))

                                               KILL ^PSRX(RX,1,FILL,"IB")

                                               SET PN=PN+1

                                   End DoDot:2

               End DoDot:1

 +7        WRITE !!,"Finished.  "_PN_" Prescriptions Found.",!

           KILL PN,FILL,SDATE,RX,SUS,DFN,X

           QUIT

PSOFIXIB.m