PSSMSTR ;BIR/PWC-Send Master Drug File to External Interface ;04/05/04
 ;;1.0;PHARMACY DATA MANAGEMENT;**82,193**;09/30/97;Build 17
 ;Reference to ^PS(59 supported by IA # 1976
 ;
 ;This routine will loop through the Drug file and send all drugs
 ;to each dispensing machine for each outpatient site file.
 ;It will only send to each site that has a dispensing machine running
 ;HL7 V.2.4 and has the Master File Update enabled.
 ;As part of Pharmacy Interface Automation Project (PIA), this routine
 ;is modified to send all drugs to an active Pharmacy Automated Dispensing
 ;Equipment (PADE), located at the point of care areas such as 
 ;Inpatient wards, Outpatient Clinics etc.
 ;Task this job out
 ;
EN ; Begin processing PSS Master File All send drugs via HL7
 W @IOF N ZTSAVE,ZTRTN,ZTDESC,ZTIO,ZTDTH,X,Y
 D KV
 S DIR("A")="Send Drug file to which External Interface below?"
 S DIR(0)="SO^1:Outpatient Interface (OPAI);2:Inpatient Interface (PADE)"
 S DIR("?",1)="  Option 1 is for sending to the Outpatient Pharmacy Automation Interface."
 S DIR("?",2)="  Option 2 is for sending to the Pharmacy Automated Dispensing Equipment (PADE)"
 S DIR("?",3)="  located at the point of care."
 S DIR("?",4)="  OR Enter '^' to quit."
 S DIR("?",5)=""
 S DIR("?")="*Caution: This is usually done on the initial setup of the dispensing equipment."
 D ^DIR Q:'Y
 W !!,"You selected to send the Drug file to the "_Y(0),!
 I Y=1 D  Q
 . S ZTRTN="BUILD^PSSMSTR",ZTDESC="MASTER DRUG FILE UPDATE",ZTIO=""
 . S ZTDTH=$H D NOW^%DTC S PSSDTM=% D ^%ZTLOAD
 ;*193 - PADE
 N SPNAM,PROT S SPNAM="PSS MFNM01 SERVER"
 S PROT=$O(^ORD(101,"B",SPNAM,0))
 I '$$SNDHL7() W !!,"*Drug transmission is not setup for PADE",!! H 2 G EN
 I 'PROT W !!,"Drug Update Protocol "_SPNAM_" is NOT Installed",!! H 2 G EN
EN1 ;
 W !!,?5,"This only sends your Drug selections as NEW additions to PADE"
 W !?5,"If you need to send drug updates, then use the PSS DRUG/ENTER EDIT option"
 W !
 D KV
 S DIR("A")="Send all or selected drugs to the PADE system?"
 S DIR(0)="SO^1:Send all drugs marked for a package;2:Send selected drugs"
 S DIR("?",1)="  Option 1 is for sending all the active drugs by package"
 S DIR("?",2)="  Option 2 is for sending selected drugs only"
 S DIR("?",3)="  OR Enter '^' to quit."
 S DIR("?",4)=""
 S DIR("?")="*Caution: Option 1 is usually done on the initial setup of the dispensing equipment."
 D ^DIR G:'Y EN
 N PSSPADE S PSSPADE=1
 G:Y=2 SDRG
 I '$D(^XUSEC("PSS PADE INIT",DUZ)) D  G EN1
 .W $C(7),!!,?9,"**You need the PSS PADE INIT key."
 .W !,?11,"Please contact your Pharmacy Coordinator for access",! H 2
 N PSSCPK S PSSCPK=""
 I '$D(IOINORM)!('$D(IOINHI)) N IORVOFF,IORVON,IOINHI,IOINORM D
 .S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS
 W !,"WARNING - With this option, you will be sending a large number of"
 W !,"drugs from your drug file to ""build"" a working database or drugs"
 W !,"on your PADE system. It is imperative to ",IORVON_IOINHI,"NOT",IOINORM_IORVOFF," RUN this option if you"
 W !,"already have a working formulary of drugs on your PADE system;"
 W !,"as resending may overwrite modifications to the fields that you"
 W !,"have made on your PADE system.",!!
 D KV ; CHECK FOR APPLICATION PACKAGE USAGE U,IV or Ward Stock
 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to continue"
 S DIR("?")="Enter Y for Yes or N for No." D ^DIR K DIR
 G:'Y EN
 D KV W !
 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to send drugs marked for UD package"
 S DIR("?")="Enter Y for Yes or N for No." D ^DIR K DIR
 G:$D(DIRUT) EN1
 S:Y PSSCPK="U"
 W !
 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to send drugs marked for IV package"
 S DIR("?",1)="This option will look for 'I' in the application package field"
 S DIR("?",2)="of the drug file (#50) in determining if the drug is marked for"
 S DIR("?",3)="this package. The system will NOT check to see if there is an"
 S DIR("?",4)="additive or solution associated with the drug in determining if"
 S DIR("?",5)="it will be sent."
 S DIR("?",6)=""
 S DIR("?")="Enter Y for Yes or N for No." D ^DIR K DIR
 G:$D(DIRUT) EN1
 S:Y PSSCPK=$G(PSSCPK)_"I"
 W !
 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to send drugs marked for Ward Stock package"
 S DIR("?",1)="This option will only look for 'W' in the application package field"
 S DIR("?",2)="of the drug file (#50) in determining if the drug is marked for"
 S DIR("?",3)="this package. It is possible for drugs to be used in the AR/WS"
 S DIR("?",4)="package but NOT marked with a 'W' in the application package field."
 S DIR("?",5)="Those drugs would not be sent with this option and must be added to"
 S DIR("?",6)="your PADE system manually."
 S DIR("?",7)=""
 S DIR("?")="Enter Y for Yes or N for No." D ^DIR K DIR
 G:$D(DIRUT) EN1
 G:PSSCPK=""&('Y) EN1
 S:Y PSSCPK=$G(PSSCPK)_"W"
EPD ;
 W !!,"Drug File Queued to be sent to PADE" H 2
 ;D PADE
 ;Q
 S ZTRTN="PADE^PSSMSTR",ZTDESC="MASTER DRUG FILE UPDATE TO PADE",ZTIO=""
 S ZTSAVE("PSSCPK")="",ZTSAVE("PSSPADE")="",ZTDTH=$H D NOW^%DTC S PSSDTM=% D ^%ZTLOAD
 Q
 ;
BUILD ;
 N XX,DVER,DMFU,DNSNAM,DNSPORT
 F XX=0:0 S XX=$O(^PSDRUG(XX)) Q:'XX  D
 . F YY=0:0 S YY=$O(^PS(59,YY)) Q:'YY  D
 .. S DVER=$$GET1^DIQ(59,YY_",",105,"I") Q:DVER'="2.4"  ;HL7 2.4
 .. S DMFU=$$GET1^DIQ(59,YY_",",105.2) Q:DMFU'="YES"    ;enable MFU
 .. S DNSNAM=$$GET1^DIQ(59,YY_",",2006)    ;DNS name of dispense machine
 .. S DNSPORT=$$GET1^DIQ(59,YY_",",2007)   ;Port # of dispense machine
 .. I DNSNAM'="" D DRG^PSSDGUPD(XX,"NEW",DNSNAM,DNSPORT)
 K XX,YY,DVER,DMFU,DNSNAM,DNSPORT
 Q
 ;
PADE ;
 N PSSG,PSSAP,PSSDRG,SPNAM,I S SPNAM="PSS MFNM01 SERVER"
 S PSSDRG=0,PSSAP=""
 F  S PSSDRG=$O(^PSDRUG(PSSDRG)) Q:'PSSDRG  D
 .Q:$G(^PSDRUG(PSSDRG,"I"))&($P($G(^("I")),"^")<DT)
 .S PSSAP=$P($G(^(2)),"^",3),PSSG=0 Q:PSSAP=""
 .F I=1:1:$L(PSSCPK) I PSSAP[$E(PSSCPK,I) S PSSG=1 Q
 .Q:'PSSG
 .D SPADE
 Q
 ;
SPADE ;
 N XX,VR,DNSNAM,DNSPORT,PSSD,PSSNM
 S XX=0 F  S XX=$O(^PS(58.7,XX)) Q:'XX  D
 .S PSSD=$G(^PS(58.7,XX,0))
 .Q:PSSD=""
 .S PSSNM=$P(PSSD,"^"),DNSNAM=$P(PSSD,"^",2),DNSPORT=$P(PSSD,"^",3)
 .Q:PSSNM=""!(DNSNAM="")!(DNSPORT="")  ;CHECK PADE, DNS NAME & PORT ARE DEFINED
 .S VR=$P(PSSD,"^",4) Q:VR&(VR<DT)  ;INACTIVE DATE CHECK
 .S VR=$P(PSSD,"^",5) Q:VR="X"!(VR="")  ;SEND DRUG UPDATE
 .D PROCESS1^PSSHLDFS(SPNAM,PSSDRG,"MAD",DNSNAM,DNSPORT)
 Q
SNDHL7() ; Check if at least one PADE vendor equipment is setup to accept 
 ; HL7 Drug messages.
 ;  Input  - None
 ;  Output - 1, send HL7 message
 ;           0, don't send message
 ;
 N XX,VR,FLG,SPNAM,DNSNAM,DNSPORT,PSSD,PSSNM
 S (FLG,XX)=0 F  S XX=$O(^PS(58.7,XX)) Q:'XX!(FLG)  D
 .S PSSD=$G(^PS(58.7,XX,0))
 .Q:PSSD=""
 .S PSSNM=$P(PSSD,"^"),DNSNAM=$P(PSSD,"^",2),DNSPORT=$P(PSSD,"^",3)
 .Q:PSSNM=""!(DNSNAM="")!(DNSPORT="")  ;CHECK PADE, DNS NAME & PORT ARE DEFINED
 .S VR=$P(PSSD,"^",4) Q:VR&(VR<DT)  ;INACTIVE DATE CHECK
 .S VR=$P(PSSD,"^",5) Q:VR="X"!(VR="")  ;SEND NONE
 .S FLG=$S(VR="U":1,VR="N":2,1:3)  ;SEND DRUG MESSAGES
 Q FLG
 ;
KV K DIR,DIRUT,DUOUT,DTOUT
 Q
 ;
SDRG ;
 W !!,?5,"You may select a single Drug or several Drugs",!!
 N PSSDRUG K DIC,DUOUT,DTOUT S DIC(0)="QEAM",DIC="^PSDRUG("
 S DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
 F  D ^DIC Q:Y<0  D
 . S PSSDRUG(+Y)=""
 K DA,DIC
 I $G(DUOUT)!($G(DTOUT))!('$O(PSSDRUG(""))) G EN
 N PSSDRG,SPNAM S SPNAM="PSS MFNM01 SERVER"
 S PSSDRG=0
 F  S PSSDRG=$O(PSSDRUG(PSSDRG)) Q:'PSSDRG  D SPADE
 Q
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSMSTR   7554     printed  Sep 23, 2025@20:08:52                                                                                                                                                                                                     Page 2
PSSMSTR   ;BIR/PWC-Send Master Drug File to External Interface ;04/05/04
 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**82,193**;09/30/97;Build 17
 +2       ;Reference to ^PS(59 supported by IA # 1976
 +3       ;
 +4       ;This routine will loop through the Drug file and send all drugs
 +5       ;to each dispensing machine for each outpatient site file.
 +6       ;It will only send to each site that has a dispensing machine running
 +7       ;HL7 V.2.4 and has the Master File Update enabled.
 +8       ;As part of Pharmacy Interface Automation Project (PIA), this routine
 +9       ;is modified to send all drugs to an active Pharmacy Automated Dispensing
 +10      ;Equipment (PADE), located at the point of care areas such as 
 +11      ;Inpatient wards, Outpatient Clinics etc.
 +12      ;Task this job out
 +13      ;
EN        ; Begin processing PSS Master File All send drugs via HL7
 +1        WRITE @IOF
           NEW ZTSAVE,ZTRTN,ZTDESC,ZTIO,ZTDTH,X,Y
 +2        DO KV
 +3        SET DIR("A")="Send Drug file to which External Interface below?"
 +4        SET DIR(0)="SO^1:Outpatient Interface (OPAI);2:Inpatient Interface (PADE)"
 +5        SET DIR("?",1)="  Option 1 is for sending to the Outpatient Pharmacy Automation Interface."
 +6        SET DIR("?",2)="  Option 2 is for sending to the Pharmacy Automated Dispensing Equipment (PADE)"
 +7        SET DIR("?",3)="  located at the point of care."
 +8        SET DIR("?",4)="  OR Enter '^' to quit."
 +9        SET DIR("?",5)=""
 +10       SET DIR("?")="*Caution: This is usually done on the initial setup of the dispensing equipment."
 +11       DO ^DIR
           if 'Y
               QUIT 
 +12       WRITE !!,"You selected to send the Drug file to the "_Y(0),!
 +13       IF Y=1
               Begin DoDot:1
 +14               SET ZTRTN="BUILD^PSSMSTR"
                   SET ZTDESC="MASTER DRUG FILE UPDATE"
                   SET ZTIO=""
 +15               SET ZTDTH=$HOROLOG
                   DO NOW^%DTC
                   SET PSSDTM=%
                   DO ^%ZTLOAD
               End DoDot:1
               QUIT 
 +16      ;*193 - PADE
 +17       NEW SPNAM,PROT
           SET SPNAM="PSS MFNM01 SERVER"
 +18       SET PROT=$ORDER(^ORD(101,"B",SPNAM,0))
 +19       IF '$$SNDHL7()
               WRITE !!,"*Drug transmission is not setup for PADE",!!
               HANG 2
               GOTO EN
 +20       IF 'PROT
               WRITE !!,"Drug Update Protocol "_SPNAM_" is NOT Installed",!!
               HANG 2
               GOTO EN
EN1       ;
 +1        WRITE !!,?5,"This only sends your Drug selections as NEW additions to PADE"
 +2        WRITE !?5,"If you need to send drug updates, then use the PSS DRUG/ENTER EDIT option"
 +3        WRITE !
 +4        DO KV
 +5        SET DIR("A")="Send all or selected drugs to the PADE system?"
 +6        SET DIR(0)="SO^1:Send all drugs marked for a package;2:Send selected drugs"
 +7        SET DIR("?",1)="  Option 1 is for sending all the active drugs by package"
 +8        SET DIR("?",2)="  Option 2 is for sending selected drugs only"
 +9        SET DIR("?",3)="  OR Enter '^' to quit."
 +10       SET DIR("?",4)=""
 +11       SET DIR("?")="*Caution: Option 1 is usually done on the initial setup of the dispensing equipment."
 +12       DO ^DIR
           if 'Y
               GOTO EN
 +13       NEW PSSPADE
           SET PSSPADE=1
 +14       if Y=2
               GOTO SDRG
 +15       IF '$DATA(^XUSEC("PSS PADE INIT",DUZ))
               Begin DoDot:1
 +16               WRITE $CHAR(7),!!,?9,"**You need the PSS PADE INIT key."
 +17               WRITE !,?11,"Please contact your Pharmacy Coordinator for access",!
                   HANG 2
               End DoDot:1
               GOTO EN1
 +18       NEW PSSCPK
           SET PSSCPK=""
 +19       IF '$DATA(IOINORM)!('$DATA(IOINHI))
               NEW IORVOFF,IORVON,IOINHI,IOINORM
               Begin DoDot:1
 +20               SET X="IORVOFF;IORVON;IOINHI;IOINORM"
                   DO ENDR^%ZISS
               End DoDot:1
 +21       WRITE !,"WARNING - With this option, you will be sending a large number of"
 +22       WRITE !,"drugs from your drug file to ""build"" a working database or drugs"
 +23       WRITE !,"on your PADE system. It is imperative to ",IORVON_IOINHI,"NOT",IOINORM_IORVOFF," RUN this option if you"
 +24       WRITE !,"already have a working formulary of drugs on your PADE system;"
 +25       WRITE !,"as resending may overwrite modifications to the fields that you"
 +26       WRITE !,"have made on your PADE system.",!!
 +27      ; CHECK FOR APPLICATION PACKAGE USAGE U,IV or Ward Stock
           DO KV
 +28       SET DIR(0)="Y"
           SET DIR("B")="NO"
           SET DIR("A")="Do you want to continue"
 +29       SET DIR("?")="Enter Y for Yes or N for No."
           DO ^DIR
           KILL DIR
 +30       if 'Y
               GOTO EN
 +31       DO KV
           WRITE !
 +32       SET DIR(0)="Y"
           SET DIR("B")="NO"
           SET DIR("A")="Do you want to send drugs marked for UD package"
 +33       SET DIR("?")="Enter Y for Yes or N for No."
           DO ^DIR
           KILL DIR
 +34       if $DATA(DIRUT)
               GOTO EN1
 +35       if Y
               SET PSSCPK="U"
 +36       WRITE !
 +37       SET DIR(0)="Y"
           SET DIR("B")="NO"
           SET DIR("A")="Do you want to send drugs marked for IV package"
 +38       SET DIR("?",1)="This option will look for 'I' in the application package field"
 +39       SET DIR("?",2)="of the drug file (#50) in determining if the drug is marked for"
 +40       SET DIR("?",3)="this package. The system will NOT check to see if there is an"
 +41       SET DIR("?",4)="additive or solution associated with the drug in determining if"
 +42       SET DIR("?",5)="it will be sent."
 +43       SET DIR("?",6)=""
 +44       SET DIR("?")="Enter Y for Yes or N for No."
           DO ^DIR
           KILL DIR
 +45       if $DATA(DIRUT)
               GOTO EN1
 +46       if Y
               SET PSSCPK=$GET(PSSCPK)_"I"
 +47       WRITE !
 +48       SET DIR(0)="Y"
           SET DIR("B")="NO"
           SET DIR("A")="Do you want to send drugs marked for Ward Stock package"
 +49       SET DIR("?",1)="This option will only look for 'W' in the application package field"
 +50       SET DIR("?",2)="of the drug file (#50) in determining if the drug is marked for"
 +51       SET DIR("?",3)="this package. It is possible for drugs to be used in the AR/WS"
 +52       SET DIR("?",4)="package but NOT marked with a 'W' in the application package field."
 +53       SET DIR("?",5)="Those drugs would not be sent with this option and must be added to"
 +54       SET DIR("?",6)="your PADE system manually."
 +55       SET DIR("?",7)=""
 +56       SET DIR("?")="Enter Y for Yes or N for No."
           DO ^DIR
           KILL DIR
 +57       if $DATA(DIRUT)
               GOTO EN1
 +58       if PSSCPK=""&('Y)
               GOTO EN1
 +59       if Y
               SET PSSCPK=$GET(PSSCPK)_"W"
EPD       ;
 +1        WRITE !!,"Drug File Queued to be sent to PADE"
           HANG 2
 +2       ;D PADE
 +3       ;Q
 +4        SET ZTRTN="PADE^PSSMSTR"
           SET ZTDESC="MASTER DRUG FILE UPDATE TO PADE"
           SET ZTIO=""
 +5        SET ZTSAVE("PSSCPK")=""
           SET ZTSAVE("PSSPADE")=""
           SET ZTDTH=$HOROLOG
           DO NOW^%DTC
           SET PSSDTM=%
           DO ^%ZTLOAD
 +6        QUIT 
 +7       ;
BUILD     ;
 +1        NEW XX,DVER,DMFU,DNSNAM,DNSPORT
 +2        FOR XX=0:0
               SET XX=$ORDER(^PSDRUG(XX))
               if 'XX
                   QUIT 
               Begin DoDot:1
 +3                FOR YY=0:0
                       SET YY=$ORDER(^PS(59,YY))
                       if 'YY
                           QUIT 
                       Begin DoDot:2
 +4       ;HL7 2.4
                           SET DVER=$$GET1^DIQ(59,YY_",",105,"I")
                           if DVER'="2.4"
                               QUIT 
 +5       ;enable MFU
                           SET DMFU=$$GET1^DIQ(59,YY_",",105.2)
                           if DMFU'="YES"
                               QUIT 
 +6       ;DNS name of dispense machine
                           SET DNSNAM=$$GET1^DIQ(59,YY_",",2006)
 +7       ;Port # of dispense machine
                           SET DNSPORT=$$GET1^DIQ(59,YY_",",2007)
 +8                        IF DNSNAM'=""
                               DO DRG^PSSDGUPD(XX,"NEW",DNSNAM,DNSPORT)
                       End DoDot:2
               End DoDot:1
 +9        KILL XX,YY,DVER,DMFU,DNSNAM,DNSPORT
 +10       QUIT 
 +11      ;
PADE      ;
 +1        NEW PSSG,PSSAP,PSSDRG,SPNAM,I
           SET SPNAM="PSS MFNM01 SERVER"
 +2        SET PSSDRG=0
           SET PSSAP=""
 +3        FOR 
               SET PSSDRG=$ORDER(^PSDRUG(PSSDRG))
               if 'PSSDRG
                   QUIT 
               Begin DoDot:1
 +4                if $GET(^PSDRUG(PSSDRG,"I"))&($PIECE($GET(^("I")),"^")<DT)
                       QUIT 
 +5                SET PSSAP=$PIECE($GET(^(2)),"^",3)
                   SET PSSG=0
                   if PSSAP=""
                       QUIT 
 +6                FOR I=1:1:$LENGTH(PSSCPK)
                       IF PSSAP[$EXTRACT(PSSCPK,I)
                           SET PSSG=1
                           QUIT 
 +7                if 'PSSG
                       QUIT 
 +8                DO SPADE
               End DoDot:1
 +9        QUIT 
 +10      ;
SPADE     ;
 +1        NEW XX,VR,DNSNAM,DNSPORT,PSSD,PSSNM
 +2        SET XX=0
           FOR 
               SET XX=$ORDER(^PS(58.7,XX))
               if 'XX
                   QUIT 
               Begin DoDot:1
 +3                SET PSSD=$GET(^PS(58.7,XX,0))
 +4                if PSSD=""
                       QUIT 
 +5                SET PSSNM=$PIECE(PSSD,"^")
                   SET DNSNAM=$PIECE(PSSD,"^",2)
                   SET DNSPORT=$PIECE(PSSD,"^",3)
 +6       ;CHECK PADE, DNS NAME & PORT ARE DEFINED
                   if PSSNM=""!(DNSNAM="")!(DNSPORT="")
                       QUIT 
 +7       ;INACTIVE DATE CHECK
                   SET VR=$PIECE(PSSD,"^",4)
                   if VR&(VR<DT)
                       QUIT 
 +8       ;SEND DRUG UPDATE
                   SET VR=$PIECE(PSSD,"^",5)
                   if VR="X"!(VR="")
                       QUIT 
 +9                DO PROCESS1^PSSHLDFS(SPNAM,PSSDRG,"MAD",DNSNAM,DNSPORT)
               End DoDot:1
 +10       QUIT 
SNDHL7()  ; Check if at least one PADE vendor equipment is setup to accept 
 +1       ; HL7 Drug messages.
 +2       ;  Input  - None
 +3       ;  Output - 1, send HL7 message
 +4       ;           0, don't send message
 +5       ;
 +6        NEW XX,VR,FLG,SPNAM,DNSNAM,DNSPORT,PSSD,PSSNM
 +7        SET (FLG,XX)=0
           FOR 
               SET XX=$ORDER(^PS(58.7,XX))
               if 'XX!(FLG)
                   QUIT 
               Begin DoDot:1
 +8                SET PSSD=$GET(^PS(58.7,XX,0))
 +9                if PSSD=""
                       QUIT 
 +10               SET PSSNM=$PIECE(PSSD,"^")
                   SET DNSNAM=$PIECE(PSSD,"^",2)
                   SET DNSPORT=$PIECE(PSSD,"^",3)
 +11      ;CHECK PADE, DNS NAME & PORT ARE DEFINED
                   if PSSNM=""!(DNSNAM="")!(DNSPORT="")
                       QUIT 
 +12      ;INACTIVE DATE CHECK
                   SET VR=$PIECE(PSSD,"^",4)
                   if VR&(VR<DT)
                       QUIT 
 +13      ;SEND NONE
                   SET VR=$PIECE(PSSD,"^",5)
                   if VR="X"!(VR="")
                       QUIT 
 +14      ;SEND DRUG MESSAGES
                   SET FLG=$SELECT(VR="U":1,VR="N":2,1:3)
               End DoDot:1
 +15       QUIT FLG
 +16      ;
KV         KILL DIR,DIRUT,DUOUT,DTOUT
 +1        QUIT 
 +2       ;
SDRG      ;
 +1        WRITE !!,?5,"You may select a single Drug or several Drugs",!!
 +2        NEW PSSDRUG
           KILL DIC,DUOUT,DTOUT
           SET DIC(0)="QEAM"
           SET DIC="^PSDRUG("
 +3        SET DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
 +4        FOR 
               DO ^DIC
               if Y<0
                   QUIT 
               Begin DoDot:1
 +5                SET PSSDRUG(+Y)=""
               End DoDot:1
 +6        KILL DA,DIC
 +7        IF $GET(DUOUT)!($GET(DTOUT))!('$ORDER(PSSDRUG("")))
               GOTO EN
 +8        NEW PSSDRG,SPNAM
           SET SPNAM="PSS MFNM01 SERVER"
 +9        SET PSSDRG=0
 +10       FOR 
               SET PSSDRG=$ORDER(PSSDRUG(PSSDRG))
               if 'PSSDRG
                   QUIT 
               DO SPADE
 +11       QUIT 
 +12      ;