- 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 Feb 18, 2025@23:59:13 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 ;