PSDAPU.m

PSDAPU ;BIR/JPW-Mark/Unmark Drugs for CS Appl. Pkg. Use ; 8 Aug 94

 ;;3.0; CONTROLLED SUBSTANCES ;**2**;13 Feb 97

 S PSIUX="N^CONTROLLED SUBSTANCES"

 K DIC F  W ! S DIC=50,DIC("A")="Select DRUG: ",DIC(0)="QEAMZ" D ^DIC K DIC Q:Y<0  S PSIUDA=+Y D FLAG

END K DIC,DTOUT,DUOUT,PSIUA,PSIUDA,PSIUX,X,Y

 Q

FLAG ; flag drugs

 S X="PSSGIU" X ^%ZOSF("TEST") I $T D EN^PSSGIU Q

 D EN^PSGIU

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSDAPU   392     printed  Oct 16, 2024@17:45:57                                                                                                                                                                                                       Page 2

PSDAPU    ;BIR/JPW-Mark/Unmark Drugs for CS Appl. Pkg. Use ; 8 Aug 94

 +1       ;;3.0; CONTROLLED SUBSTANCES ;**2**;13 Feb 97

 +2        SET PSIUX="N^CONTROLLED SUBSTANCES"

 +3        KILL DIC

           FOR 

               WRITE !

               SET DIC=50

               SET DIC("A")="Select DRUG: "

               SET DIC(0)="QEAMZ"

               DO ^DIC

               KILL DIC

               if Y<0

                   QUIT 

               SET PSIUDA=+Y

               DO FLAG

END        KILL DIC,DTOUT,DUOUT,PSIUA,PSIUDA,PSIUX,X,Y

 +1        QUIT 

FLAG      ; flag drugs

 +1        SET X="PSSGIU"

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               DO EN^PSSGIU

               QUIT 

 +2        DO EN^PSGIU

 +3        QUIT