- 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 ---[H[J[2J[HPSDAPU 392 printed Feb 18, 2025@23:11:31 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