PSO126EN.m

PSO126EN ;BIR/PW-ENVIRONMENTAL CHECK FOR PATCH 126 ;12/09/02

 ;;7.0;OUTPATIENT PHARMACY;**126**;DEC 1997

CHK525 ;check for .01 holes in 52.5

 K XPDQUIT,PSXQUIT

 W !,"Checking the RX SUSPENSE file (#52.5) for entries with missing #.01 fields",! H 4

 S IEN=0 F I=0:1 W:'(I#100) "." S IEN=$O(^PS(52.5,IEN)) Q:IEN'>0  I +$G(^PS(52.5,IEN,0))'>0 S PSXQUIT=1 W !,IEN

 I $G(PSXQUIT) D

 . S XPDQUIT=1

 . W !!,"The RX SUSPENSE file (#52.5) has been found to have entries without a #.01 field."

 . W !,"Please call NVS to clear this problem."

 . K DIR S DIR(0)="E",DIR("A")="<CR> - to continue" D ^DIR K DIR

 I '$G(XPDQUIT) W !,"No problems with the file were found. Continuing with the installation.",! H 4

 Q

PSO126EN  ;BIR/PW-ENVIRONMENTAL CHECK FOR PATCH 126 ;12/09/02

 +1       ;;7.0;OUTPATIENT PHARMACY;**126**;DEC 1997

CHK525    ;check for .01 holes in 52.5

 +1        KILL XPDQUIT,PSXQUIT

 +2        WRITE !,"Checking the RX SUSPENSE file (#52.5) for entries with missing #.01 fields",!

           HANG 4

 +3        SET IEN=0

           FOR I=0:1

               IF '(I#100)

                   WRITE "."

               SET IEN=$ORDER(^PS(52.5,IEN))

               IF IEN'>0

                   QUIT 

               IF +$GET(^PS(52.5,IEN,0))'>0

                   SET PSXQUIT=1

                   WRITE !,IEN

 +4        IF $GET(PSXQUIT)

               Begin DoDot:1

 +5                SET XPDQUIT=1

 +6                WRITE !!,"The RX SUSPENSE file (#52.5) has been found to have entries without a #.01 field."

 +7                WRITE !,"Please call NVS to clear this problem."

 +8                KILL DIR

                   SET DIR(0)="E"

                   SET DIR("A")="<CR> - to continue"

                   DO ^DIR

                   KILL DIR

               End DoDot:1

 +9        IF '$GET(XPDQUIT)

               WRITE !,"No problems with the file were found. Continuing with the installation.",!

               HANG 4

 +10       QUIT