PSSDDUT2 ;BIR/LDT - Pharmacy Data Management DD Utility ;1/20/16 2:45pm
;;1.0;PHARMACY DATA MANAGEMENT;**3,21,61,81,95,127,126,139,131,143,188,189,192,218,187**;9/30/97;Build 27
;
;Reference to ^DIC(42 supported by DBIA #10039
;Reference to ^DD(59.723 supported by DBIA #2159
;Reference to ^PSNDF(50.68 supported by DBIA 3735
;
DEA ;(Replaces ^PSODEA)
S PSSHLP(1)="THE SPECIAL HANDLING CODE IS A 2 TO 6 POSTION FIELD. IF APPLICABLE,"
S PSSHLP(2)="A SCHEDULE CODE MUST APPEAR IN THE FIRST POSITION. FOR EXAMPLE,"
S PSSHLP(3)="A SCHEDULE 3 NARCOTIC WILL BE CODED '3A', A SCHEDULE 3 NON-NARCOTIC WILL BE"
S PSSHLP(4)="CODED '3C' AND A SCHEDULE 2 DEPRESSANT WILL BE CODED '2L'."
S PSSHLP(5)="THE CODES ARE:"
D WRITE
F II=1:1 Q:$P($T(D+II),";",3)="" S PSSHLP(II)=$P($T(D+II),";",3,99)
S PSSHLP(1,"F")="!!" D WRITE
D PKIND,WRITE
D K II Q
;;0 MANUFACTURED IN PHARMACY
;;1 SCHEDULE 1 ITEM
;;2 SCHEDULE 2 ITEM
;;3 SCHEDULE 3 ITEM
;;4 SCHEDULE 4 ITEM
;;5 SCHEDULE 5 ITEM
;;6 LEGEND ITEM
;;9 OVER-THE-COUNTER
;;L DEPRESSANTS AND STIMULANTS
;;A NARCOTICS AND ALCOHOLS
;;P DATED DRUGS
;;I INVESTIGATIONAL DRUGS
;;M BULK COMPOUND ITEMS
;;C CONTROLLED SUBSTANCES - NON NARCOTIC
;;R RESTRICTED ITEMS
;;S SUPPLY ITEMS
;;B ALLOW REFILL (SCH. 3, 4, 5 ONLY)
;;W NOT RENEWABLE
;;F NON REFILLABLE
;;N NUTRITIONAL SUPPLEMENT
;;K NOT RENEWABLE (BY TELEPHONE)
;;D NOT PARKABLE
;;
DEATBL ; More Help regarding DEA Codes
K PSSHLP
F II=1:1 Q:$P($T(TBL+II),";",3)="" S PSSHLP(II)=$P($T(TBL+II),";",3,99)
S PSSHLP(1,"F")="!!" D WRITE
;
TBL K II Q
;; DEA CODE TABLE
;; CODE ALLOW RENEWS ALLOW REFILLS
;; 1 NO NO
;; 2 NO NO
;; 2A NO NO
;; 3 YES YES
;; 3A YES NO
;; 3AB YES YES
;; 4 YES YES
;; 4A YES NO
;; 4AB YES YES
;; 5 YES YES
;; 5A YES NO
;; 5AB YES YES
;; ADDING W TO A SCHED. 3,4,OR 5 CODE DISALLOWS RENEWS.
;; ADDING F TO A SCHED. 3,4,OR 5 CODE DISALLOWS REFILLS
;; IF A CODE IS NOT LISTED IN THE ABOVE TABLE
;; IT HAS NO EFFECT ON RENEW OR REFILL
SIG ;checks SIG for RXs (Replaces SIG^PSOHELP)
I $E(X)=" " D EN^DDIOL("Leading spaces are not allowed in the SIG! ","","$C(7),!") K X Q
SIGONE S SIG="" Q:$L(X)<1 F Z0=1:1:$L(X," ") G:Z0="" EN S Z1=$P(X," ",Z0) D G:'$D(X) EN
.I $L(Z1)>32 D EN^DDIOL("MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.","","$C(7),!?5") K X Q
.D:$D(X)&($G(Z1)]"") S SIG=SIG_" "_Z1
..S Y=$O(^PS(51,"B",Z1,0)) Q:'Y!($P($G(^PS(51,+Y,0)),"^",4)>1) S Z1=$P(^PS(51,Y,0),"^",2) Q:'$D(^(9)) S Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9)
EN K Z1,Z0 ;S:$G(POERR) PSOERR("SIG")="("_$E(SIG,2,999999999)_")"
Q
;
DRUGW ;(Replaces DRUGW^PSOUTLA)
F Z0=1:1 Q:$P(X,",",Z0,99)="" S Z1=$P(X,",",Z0) D:$D(^PS(54,Z1,0)) EN^DDIOL($P(^(0),"^"),"","!,?35") I '$D(^(0)) D EN^DDIOL("NO SUCH WARNING LABEL","","?35") K X Q
Q
;
P ;(Replaces ^PSODSRC)
S PSSHLP(1)="A TWO OR THREE POSITION CODE IDENTIFIES THE SOURCE OF SUPPLY AND WHETHER"
S PSSHLP(2)="THE DRUG IS STOCKED BY THE STATION SUPPLY DIVISION. THE FIRST"
S PSSHLP(3)="POSITION OF THE CODE IDENTIFIES SOURCE OF SUPPLY. THE CODES ARE:"
D WRITE
F II=0:1:10 S PSSHLP(II+1)=$P($T(S+II+1),";",3),PSSHLP(II+1,"F")="!?10"
S PSSHLP(1,"F")="!!?10"
D WRITE
S PSSHLP(1)="THE SECOND POSITION OF THE CODE INDICATES WHETHER THE ITEM IS"
S PSSHLP(2)="OR IS NOT AVAILABLE FROM SUPPLY WAREHOUSE STOCK. THE CODES ARE:"
S PSSHLP(3)="P POSTED STOCK"
S PSSHLP(3,"F")="!!?10"
S PSSHLP(4)="U UNPOSTED"
S PSSHLP(4,"F")="!?10"
S PSSHLP(5)="M BULK COMPOUND"
S PSSHLP(5,"F")="!?10"
S PSSHLP(6)="* USE CODE 0 ONLY WITH SECOND POSITION M."
D WRITE Q
;
S ;;DESCRIPTION MEANINGS
;;0 BULK COMPOUND ITEMS *
;;1 VA SERVICING SUPPLY DEPOT
;;2 OPEN MARKET
;;3 GSA STORES DEPOT
;;4 VA DECENTRALIZED CONTRACTS
;;5 FEDERAL PRISON INDUSTRIES, INC.
;;6 FEDERAL SUPPLY SCHEDULES
;;7 VA SUPPLY DEPOT, HINES
;;8 VA SUPPLY DEPOT, SOMERVILLE
;;9 APPROPRIATE MARKETING DIVISION
;;10 VA SUPPLY DEPOT, BELL
EDIT ;INPUT XFORM FOR DEA FIELD IN DRUG FILE (Replaces EDIT^PSODEA)
I X["F",X["B" D EN^DDIOL("Inappropriate F designation!","","$C(7),!") K X Q
;;DEA CHANGE PSS*1*126
I X["B",(+X<3) D EN^DDIOL("The B designation is only valid for schedule 3, 4, 5 !","","$C(7),!") K X Q
I X["A"&(X["C"),+X=2!(+X=3) D EN^DDIOL("The A & C designation is not valid for schedule 2 or 3 narcotics!","","$C(7),!") K X Q
I $E(X)=1,X[2!(X[3)!(X[4)!(X[5) D EN^DDIOL("It contains other inappropriate schedule 2-5 narcotics!","","$C(7),!") K X Q
I $E(X)=2,X[1!(X[3)!(X[4)!(X[5) D EN^DDIOL("It contains other inappropriate schedule 1,3-5 narcotics!","","$C(7),!") K X Q
I $E(X)=3,X[1!(X[2)!(X[4)!(X[5) D EN^DDIOL("It contains other inappropriate schedule 1-2,4-5 narcotics!","","$C(7),!") K X Q
I $E(X)=4,X[1!(X[2)!(X[3)!(X[5) D EN^DDIOL("It contains other inappropriate schedule 1-3,5 narcotics!","","$C(7),!") K X Q
I $E(X)=5,X[1!(X[2)!(X[3)!(X[4) D EN^DDIOL("It contains other inappropriate schedule 1-4 narcotics!","","$C(7),!") K X Q
;
I X["E"!(X["U") D
.I X["E" D EN^DDIOL("Note: Adding E has no ePharmacy impact. Use the ePharmacy Billable fields.","","$C(7),!")
.I X["U" D EN^DDIOL("Note: Adding U has no ePharmacy impact. Use the Sensitive Diagnosis Drug field.","","$C(7),!")
.Q
;
Q
;
WRITE ;Calls EN^DDIOL to write text
D EN^DDIOL(.PSSHLP) K PSSHLP
Q
;
PKIND I +$P($G(^PSDRUG(DA,"ND")),"^",3) S PSSK=$P(^("ND"),"^",3) D
.S PSSK=$$GET1^DIQ(50.68,PSSK,19,"I") I PSSK S PSSK=$$CSDEA^PSSDDUT2(PSSK) D
..I $L(PSSK)=1,$P(^PSDRUG(DA,0),"^",3)[PSSK Q
..I $P(^PSDRUG(DA,0),"^",3)[$E(PSSK),$P(^PSDRUG(DA,0),"^",3)[$E(PSSK,2) Q
..W !!,"The CS Federal Schedule associated with this drug in the VA Product file"
..W !,"represents a DEA, Special Handling code of "_PSSK
Q
;
CSDEA(CS) ;
Q:'CS ""
Q $S(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS)
;
CLOZ ;DEL node of DRUG file 50, fields 17.2, 17.3, 17.4
S PSSHLP(1)="To delete this field use the Unmark Clozapine Drug option in the"
S PSSHLP(2)="Clozapine Pharmacy Manager menu."
D WRITE
Q
;
NONF ;Non-Formulary Input Transform DRUG file 50, field 51
S PSSHLP(1)="This drug cannot be marked as a non-formulary item because it is"
S PSSHLP(2)="designated as a formulary alternative for the following drugs."
S PSSHLP(3)=" ",PSSHLP(1,"F")="!!"
D WRITE
F MM=0:0 S MM=$O(^PSDRUG("AFA",DA,MM)) Q:'MM S SHEMP=$P(^PSDRUG(MM,0),"^") D EN^DDIOL(SHEMP,"","!?3")
S X=""
Q
;
ATC ;Executable help for field 212.2, DRUG file 50
S PSSHLP(1)="The mnemonic entered here must match the mnemonic entered into the"
S PSSHLP(2)="ATC for this drug EXACTLY, and cannot be numbers only."
D WRITE
Q
;
ADTM ;ADMINISTRATION SCHEDULE file 51.1, field 1 Executable Help
S PSSHLP(1)="All times must be the same length (2 or 4 characters), must be"
S PSSHLP(2)="separated by dashes ('-'), and be in ascending order"
S PSSHLP(3)=""
S PSSHLP(4)="This is the set of administration times for this Schedule."
S PSSHLP(5)=""
S PSSHLP(6)="If the Schedule Type is CONTINUOUS the number of administration"
S PSSHLP(7)="times cannot conflict with the frequency of the schedule. For"
S PSSHLP(8)="example, a schedule frequency of 720 minutes must have two"
S PSSHLP(9)="administration times and a schedule frequency of 360 must have a"
S PSSHLP(10)="four administration times."
S PSSHLP(11)=""
S PSSHLP(12)="If the Schedule Type is CONTINUOUS and is an Odd Schedule (A"
S PSSHLP(13)="schedule whose frequency is not evenly divisible by or into"
S PSSHLP(14)="1440 minutes or 1 day). Administration Times are not allowed."
S PSSHLP(15)="For example Q5H, Q17H - these are not evenly divisible by 1440."
S PSSHLP(16)=""
S PSSHLP(17)="If the Schedule Type is CONTINUOUS with a non-odd frequency of"
S PSSHLP(18)="greater than of 1 day (1440 minutes) then more than one"
S PSSHLP(19)="administration time is not allowed. For example schedules of"
S PSSHLP(20)="Q72H, Q3Day, and Q5Day."
D WRITE
Q
;
LBLS ;PHARMACY SYSTEM file 59.7, field 61.2 Executable Help
S PSSHLP(1)="ANY NEW LABELS OLDER THAN THE NUMBER OF DAYS SPECIFIED HERE WILL"
S PSSHLP(2)="AUTOMATICALLY BE PURGED."
D WRITE
Q
NFH I '$D(DA(1)) D EN^DDIOL(" (This non-formulary item is "_$P(^PSDRUG($S($D(DA(1)):DA(1),1:DA),0),"^")_".)")
Q
STRTH S STR=" "_$P(X," ",2),PSSHLP(1)=STR,PSSHLP(1,"F")="" D WRITE K STR
Q
PSYS1 D EN^DDIOL("(""From"" ward is "_$S('$D(^PS(59.7,D0,22,D1,0)):"UNKNOWN",'$D(^DIC(42,+^(0),0)):"UNKNOWN",$P(^(0),"^")]"":$P(^(0),"^"),1:"UNKNOWN")_")","","!?3")
Q
PSYS2 ;PSS*1.0*95
D EN^DDIOL("(""From"" service is "_$S('$D(^PS(59.7,D0,23,D1,0)):"UNKNOWN",$P(^(0),"^")]"":$P($P(";"_$P(^DD(59.723,.01,0),"^",3),";"_$P(^PS(59.7,D0,23,D1,0),"^")_":",2),";"),1:"UNKNOWN")_")")
Q
;
NCINIT ;
K PSSNQM,PSSNQM2,PSSNQM3,PSSONDU,PSSONQM
NCINIT1 ;
I $P($G(^PSDRUG(DA,"EPH")),"^",2)="" S $P(^PSDRUG(DA,"EPH"),"^",2)="EA",$P(^PSDRUG(DA,"EPH"),"^",3)=1 D
. S PSSHLP(1)=" Note: Defaulting the NCPDP DISPENSE UNIT to EACH and the"
. S PSSHLP(2)=" NCPDP QUANTITY MULTIPLIER to 1 (one)." S PSSHLP(1,"F")="!!"
. D WRITE S PSSHLP(2,"F")="!" D WRITE
S PSSONDU=$P(^PSDRUG(DA,"EPH"),"^",2),PSSONQM=$P(^PSDRUG(DA,"EPH"),"^",3)
Q
;
NCPDPDU ;Drug file 50, field 82
S:X="" X="EA"
D NCINIT1:'$D(PSSONDU)
I $G(PSSONDU)'=X&($G(PSSONQM)'=1) D
. S PSSHLP(1)="Defaulting the NCPDP QUANTITY MULTIPLIER to 1 (one)." S PSSHLP(1,"F")="!!" D WRITE
. S $P(^PSDRUG(DA,"EPH"),"^",3)=1,PSSONDU=$P(^PSDRUG(DA,"EPH"),"^",2),PSSONQM=$P(^PSDRUG(DA,"EPH"),"^",3)
Q
;
NCPDPQM ;Drug file 50, field 83
N ZXX S PSSNQM=0,(PSSNQM2,PSSNQM3)=""
I $G(X)<.00001 K X S PSSNQM3=1 Q
S:$G(X)="" X=1
I +$G(X)'=1 D NCPDPWRN D
NCPDPQM1 . ;
. R !,"Ok to continue? (Y/N) ",ZXX:30 S ZXX=$TR(ZXX,"yn","YN")
. I ZXX="^" S X=1 W !!?5,"Warning: Defaulting NCPDP QUANTITY MULTIPLIER to 1 (one).",!! Q
. I ZXX'="Y"&(ZXX'="N") W !,"Y or N must be entered." G NCPDPQM1
. I ZXX'="Y"&(ZXX'="y") S PSSNQM=1,PSSNQM2=X K X
Q
;
NCPDPWRN ;Message called from NCPDPQM
S PSSHLP(2)="WARNING: For most drug products, the value for this field should be 1 (one)."
S PSSHLP(3)=" Answering NO for the following prompt will display more information"
S PSSHLP(4)=" on how this field is used."
S PSSHLP(2,"F")="!!" D WRITE
S PSSHLP(5,"F")="!" D WRITE
Q
;
MXDAYSUP ; INPUT TRANSFORM for Drug file (#50), MAXIMUM DAYS SUPPLY Field (#66)
; Input: X - Maximum Days Supply Entered by user
; DA - DRUG file (#50) IEN
Q:'$D(^PSDRUG(+$G(DA),0))
S X=+$G(X)
; - DAY SUPPLY must be between 1 and 365 (inclusive)
I (X<1)!(X>365) D Q
. D EN^DDIOL("Type a number between 1 and 365, 0 decimal digits.","","!!") K X W !
;
; - Checking against NDF Maximum
N VAPRDIEN S VAPRDIEN=+$$GET1^DIQ(50,DA,22,"I")
I VAPRDIEN D I '$D(X) Q
. N NDFMAXDS
. S NDFMAXDS=$$GET1^DIQ(50.68,VAPRDIEN,32)
. I NDFMAXDS,NDFMAXDS<X D
. . D EN^DDIOL("Cannot be greater than NDF Maximum Days Supply: "_NDFMAXDS,"","!!") K X W !
;
; - Controlled Substances have different upper limits (not 365)
N DEASPHLG S DEASPHLG=$$GET1^DIQ(50,DA,3)
I DEASPHLG["2",X>30 D Q
. D EN^DDIOL("Schedule 2 controlled substances have a maximum days supply limit of 30 days","","!!") K X W !
I (DEASPHLG["3")!(DEASPHLG["4")!(DEASPHLG["5"),X>90 D Q
. D EN^DDIOL("Schedule 3-5 controlled substances have a maximum days supply limit of 90 days","","!!") K X W !
;
; - Clozapine Drug (Not controlled by this field)
I ($P($G(^PSDRUG(DA,"CLOZ1")),"^")="PSOCLO1") D Q
. D EN^DDIOL("Maximum Days Supply for this drug is controlled by the Clozapine functionality","","!!") K X W !
;
I X<$$MXDAYSUP^PSSUTIL1(DA) D
. W ! D EN^DDIOL("Note: Decreasing the MAXIMUM DAYS SUPPLY field will only affect new","","!")
. D EN^DDIOL(" prescriptions, including renewals and copies. Orders that are pending","","!")
. D EN^DDIOL(" or unreleased when the MAXIMUM DAYS SUPPLY field is decreased are not","","!")
. D EN^DDIOL(" affected by the decrease, so prescriptions with a DAYS SUPPLY above the","","!")
. D EN^DDIOL(" new MAXIMUM DAYS SUPPLY may need to be edited manually before they are","","!")
. D EN^DDIOL(" finished or released.","","!")
. W ! N DIR,X,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR
Q
;
IVSOLVOL ; IV Solution VOLUME field INPUT TRANSFORM
N OI
I X[""""!($A(X)=45)!(X'?.N0.1".".N)!(X>9999)!(X<.01) K X Q
I $$GET1^DIQ(52.7,DA,17,"I") S OI=+$$GET1^DIQ(52.7,DA,9,"I") I $$CKDUPSOL(OI,DA,+X,1) K X Q
S X=X_" ML" D EN^DDIOL(" ML","","?0")
Q
;
UIVFOE ; USED IN THE IV FLUID ORDER ENTRY field INPUT TRANSFORM
I X D
. N OI
. S OI=$$GET1^DIQ(52.7,DA,9,"I") I $$CKDUPSOL(OI,DA,+$$GET1^DIQ(52.7,DA,2),1) K X
Q
;
CKDUPSOL(OI,IVSOL,IVVOL,DSPMSG) ; Check if there's an ACTIVE Duplicate IV Solution Marked to be Used in the IV Order Dialog
; Input: OI - PHARMACY ORDERABLE ITEM (#50.7) Pointer
; IVSOL - IV SOLUTIONS (#52.7) Pointer
; IVVOL - IV Solution Volume
; DSPMSG - Display Message? (1:Yes/0:No)
;Output: DUPSOL - Duplicate IV Solution IEN
N DUPSOL,OTHSOL,OTHVOL,DRUG
S (DUPSOL,OTHSOL)=0
;
; Invalid IV Solution
I '$D(^PS(52.7,+$G(IVSOL),0)) Q 0
;
; IV Solution is INACTIVE, no issues
I $$GET1^DIQ(52.7,IVSOL,8,"I"),$$GET1^DIQ(52.7,IVSOL,8,"I")'>DT Q 0
;
; Dispense Drug might not be matched to an Orderable Item yet
S DRUG=+$$GET1^DIQ(52.7,IVSOL,1,"I")
;
I +$G(OI) D
. F S OTHSOL=$O(^PS(52.7,"AOI",OI,OTHSOL)) Q:'OTHSOL!DUPSOL D
. . I $$DUPVOL(IVSOL,OTHSOL) S DUPSOL=OTHSOL
E D
. F S OTHSOL=$O(^PS(52.7,"AC",DRUG,OTHSOL)) Q:'OTHSOL!DUPSOL D
. . I $$DUPVOL(IVSOL,OTHSOL) S DUPSOL=OTHSOL
I $G(DSPMSG),DUPSOL D
. W !!,"The following IV Solution with the same volume is already linked to"
. W:$G(OI) !,"the Orderable Item ",$$GET1^DIQ(50.7,OI,.01)
. W:'$G(OI) !,"this dispense drug."
. W !
. W:$G(OI) !,"Dispense Drug: ",$$GET1^DIQ(52.7,DUPSOL,1)
. W !," IV Solution: ",$$GET1^DIQ(52.7,DUPSOL,.01)
. W !
. W !,"Only one Active IV Solution with a specific volume can be linked to an"
. W !,"Orderable Item or Dispense Drug when the IV Solution is marked to be used"
. W !,"in the CPRS IV Fluid Order Entry."
. W !,$C(7)
Q DUPSOL
;
DUPVOL(IVSOL1,IVSOL2) ; Check 2 IV Solutions to see if they have Duplicate Volumes
; Cannot check against itself
I (IVSOL1=IVSOL2) Q 0
; Not Used in the IV Order Dialog
I '$$GET1^DIQ(52.7,IVSOL2,17,"I") Q 0
; Other IV Solution is INACTIVE
I $$GET1^DIQ(52.7,IVSOL2,8,"I"),$$GET1^DIQ(52.7,IVSOL2,8,"I")'>DT Q 0
; IV Solution Volume
S OTHVOL=$$GET1^DIQ(52.7,IVSOL2,2)
; IV Solutions have different volumes
I (+IVVOL'=+OTHVOL) Q 0
; Capturing the Duplicate IV Solution IEN
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDDUT2 15444 printed Apr 09, 2024@21:36:05 Page 2
PSSDDUT2 ;BIR/LDT - Pharmacy Data Management DD Utility ;1/20/16 2:45pm
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**3,21,61,81,95,127,126,139,131,143,188,189,192,218,187**;9/30/97;Build 27
+2 ;
+3 ;Reference to ^DIC(42 supported by DBIA #10039
+4 ;Reference to ^DD(59.723 supported by DBIA #2159
+5 ;Reference to ^PSNDF(50.68 supported by DBIA 3735
+6 ;
DEA ;(Replaces ^PSODEA)
+1 SET PSSHLP(1)="THE SPECIAL HANDLING CODE IS A 2 TO 6 POSTION FIELD. IF APPLICABLE,"
+2 SET PSSHLP(2)="A SCHEDULE CODE MUST APPEAR IN THE FIRST POSITION. FOR EXAMPLE,"
+3 SET PSSHLP(3)="A SCHEDULE 3 NARCOTIC WILL BE CODED '3A', A SCHEDULE 3 NON-NARCOTIC WILL BE"
+4 SET PSSHLP(4)="CODED '3C' AND A SCHEDULE 2 DEPRESSANT WILL BE CODED '2L'."
+5 SET PSSHLP(5)="THE CODES ARE:"
+6 DO WRITE
+7 FOR II=1:1
if $PIECE($TEXT(D+II),";",3)=""
QUIT
SET PSSHLP(II)=$PIECE($TEXT(D+II),";",3,99)
+8 SET PSSHLP(1,"F")="!!"
DO WRITE
+9 DO PKIND
DO WRITE
D KILL II
QUIT
+1 ;;0 MANUFACTURED IN PHARMACY
+2 ;;1 SCHEDULE 1 ITEM
+3 ;;2 SCHEDULE 2 ITEM
+4 ;;3 SCHEDULE 3 ITEM
+5 ;;4 SCHEDULE 4 ITEM
+6 ;;5 SCHEDULE 5 ITEM
+7 ;;6 LEGEND ITEM
+8 ;;9 OVER-THE-COUNTER
+9 ;;L DEPRESSANTS AND STIMULANTS
+10 ;;A NARCOTICS AND ALCOHOLS
+11 ;;P DATED DRUGS
+12 ;;I INVESTIGATIONAL DRUGS
+13 ;;M BULK COMPOUND ITEMS
+14 ;;C CONTROLLED SUBSTANCES - NON NARCOTIC
+15 ;;R RESTRICTED ITEMS
+16 ;;S SUPPLY ITEMS
+17 ;;B ALLOW REFILL (SCH. 3, 4, 5 ONLY)
+18 ;;W NOT RENEWABLE
+19 ;;F NON REFILLABLE
+20 ;;N NUTRITIONAL SUPPLEMENT
+21 ;;K NOT RENEWABLE (BY TELEPHONE)
+22 ;;D NOT PARKABLE
+23 ;;
DEATBL ; More Help regarding DEA Codes
+1 KILL PSSHLP
+2 FOR II=1:1
if $PIECE($TEXT(TBL+II),";",3)=""
QUIT
SET PSSHLP(II)=$PIECE($TEXT(TBL+II),";",3,99)
+3 SET PSSHLP(1,"F")="!!"
DO WRITE
+4 ;
TBL KILL II
QUIT
+1 ;; DEA CODE TABLE
+2 ;; CODE ALLOW RENEWS ALLOW REFILLS
+3 ;; 1 NO NO
+4 ;; 2 NO NO
+5 ;; 2A NO NO
+6 ;; 3 YES YES
+7 ;; 3A YES NO
+8 ;; 3AB YES YES
+9 ;; 4 YES YES
+10 ;; 4A YES NO
+11 ;; 4AB YES YES
+12 ;; 5 YES YES
+13 ;; 5A YES NO
+14 ;; 5AB YES YES
+15 ;; ADDING W TO A SCHED. 3,4,OR 5 CODE DISALLOWS RENEWS.
+16 ;; ADDING F TO A SCHED. 3,4,OR 5 CODE DISALLOWS REFILLS
+17 ;; IF A CODE IS NOT LISTED IN THE ABOVE TABLE
+18 ;; IT HAS NO EFFECT ON RENEW OR REFILL
SIG ;checks SIG for RXs (Replaces SIG^PSOHELP)
+1 IF $EXTRACT(X)=" "
DO EN^DDIOL("Leading spaces are not allowed in the SIG! ","","$C(7),!")
KILL X
QUIT
SIGONE SET SIG=""
if $LENGTH(X)<1
QUIT
FOR Z0=1:1:$LENGTH(X," ")
if Z0=""
GOTO EN
SET Z1=$PIECE(X," ",Z0)
Begin DoDot:1
+1 IF $LENGTH(Z1)>32
DO EN^DDIOL("MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.","","$C(7),!?5")
KILL X
QUIT
+2 if $DATA(X)&($GET(Z1)]"")
Begin DoDot:2
+3 SET Y=$ORDER(^PS(51,"B",Z1,0))
if 'Y!($PIECE($GET(^PS(51,+Y,0)),"^",4)>1)
QUIT
SET Z1=$PIECE(^PS(51,Y,0),"^",2)
if '$DATA(^(9))
QUIT
SET Y=$PIECE(X," ",Z0-1)
SET Y=$EXTRACT(Y,$LENGTH(Y))
if Y>1
SET Z1=^(9)
End DoDot:2
SET SIG=SIG_" "_Z1
End DoDot:1
if '$DATA(X)
GOTO EN
EN ;S:$G(POERR) PSOERR("SIG")="("_$E(SIG,2,999999999)_")"
KILL Z1,Z0
+1 QUIT
+2 ;
DRUGW ;(Replaces DRUGW^PSOUTLA)
+1 FOR Z0=1:1
if $PIECE(X,",",Z0,99)=""
QUIT
SET Z1=$PIECE(X,",",Z0)
if $DATA(^PS(54,Z1,0))
DO EN^DDIOL($PIECE(^(0),"^"),"","!,?35")
IF '$DATA(^(0))
DO EN^DDIOL("NO SUCH WARNING LABEL","","?35")
KILL X
QUIT
+2 QUIT
+3 ;
P ;(Replaces ^PSODSRC)
+1 SET PSSHLP(1)="A TWO OR THREE POSITION CODE IDENTIFIES THE SOURCE OF SUPPLY AND WHETHER"
+2 SET PSSHLP(2)="THE DRUG IS STOCKED BY THE STATION SUPPLY DIVISION. THE FIRST"
+3 SET PSSHLP(3)="POSITION OF THE CODE IDENTIFIES SOURCE OF SUPPLY. THE CODES ARE:"
+4 DO WRITE
+5 FOR II=0:1:10
SET PSSHLP(II+1)=$PIECE($TEXT(S+II+1),";",3)
SET PSSHLP(II+1,"F")="!?10"
+6 SET PSSHLP(1,"F")="!!?10"
+7 DO WRITE
+8 SET PSSHLP(1)="THE SECOND POSITION OF THE CODE INDICATES WHETHER THE ITEM IS"
+9 SET PSSHLP(2)="OR IS NOT AVAILABLE FROM SUPPLY WAREHOUSE STOCK. THE CODES ARE:"
+10 SET PSSHLP(3)="P POSTED STOCK"
+11 SET PSSHLP(3,"F")="!!?10"
+12 SET PSSHLP(4)="U UNPOSTED"
+13 SET PSSHLP(4,"F")="!?10"
+14 SET PSSHLP(5)="M BULK COMPOUND"
+15 SET PSSHLP(5,"F")="!?10"
+16 SET PSSHLP(6)="* USE CODE 0 ONLY WITH SECOND POSITION M."
+17 DO WRITE
QUIT
+18 ;
S ;;DESCRIPTION MEANINGS
+1 ;;0 BULK COMPOUND ITEMS *
+2 ;;1 VA SERVICING SUPPLY DEPOT
+3 ;;2 OPEN MARKET
+4 ;;3 GSA STORES DEPOT
+5 ;;4 VA DECENTRALIZED CONTRACTS
+6 ;;5 FEDERAL PRISON INDUSTRIES, INC.
+7 ;;6 FEDERAL SUPPLY SCHEDULES
+8 ;;7 VA SUPPLY DEPOT, HINES
+9 ;;8 VA SUPPLY DEPOT, SOMERVILLE
+10 ;;9 APPROPRIATE MARKETING DIVISION
+11 ;;10 VA SUPPLY DEPOT, BELL
EDIT ;INPUT XFORM FOR DEA FIELD IN DRUG FILE (Replaces EDIT^PSODEA)
+1 IF X["F"
IF X["B"
DO EN^DDIOL("Inappropriate F designation!","","$C(7),!")
KILL X
QUIT
+2 ;;DEA CHANGE PSS*1*126
+3 IF X["B"
IF (+X<3)
DO EN^DDIOL("The B designation is only valid for schedule 3, 4, 5 !","","$C(7),!")
KILL X
QUIT
+4 IF X["A"&(X["C")
IF +X=2!(+X=3)
DO EN^DDIOL("The A & C designation is not valid for schedule 2 or 3 narcotics!","","$C(7),!")
KILL X
QUIT
+5 IF $EXTRACT(X)=1
IF X[2!(X[3)!(X[4)!(X[5)
DO EN^DDIOL("It contains other inappropriate schedule 2-5 narcotics!","","$C(7),!")
KILL X
QUIT
+6 IF $EXTRACT(X)=2
IF X[1!(X[3)!(X[4)!(X[5)
DO EN^DDIOL("It contains other inappropriate schedule 1,3-5 narcotics!","","$C(7),!")
KILL X
QUIT
+7 IF $EXTRACT(X)=3
IF X[1!(X[2)!(X[4)!(X[5)
DO EN^DDIOL("It contains other inappropriate schedule 1-2,4-5 narcotics!","","$C(7),!")
KILL X
QUIT
+8 IF $EXTRACT(X)=4
IF X[1!(X[2)!(X[3)!(X[5)
DO EN^DDIOL("It contains other inappropriate schedule 1-3,5 narcotics!","","$C(7),!")
KILL X
QUIT
+9 IF $EXTRACT(X)=5
IF X[1!(X[2)!(X[3)!(X[4)
DO EN^DDIOL("It contains other inappropriate schedule 1-4 narcotics!","","$C(7),!")
KILL X
QUIT
+10 ;
+11 IF X["E"!(X["U")
Begin DoDot:1
+12 IF X["E"
DO EN^DDIOL("Note: Adding E has no ePharmacy impact. Use the ePharmacy Billable fields.","","$C(7),!")
+13 IF X["U"
DO EN^DDIOL("Note: Adding U has no ePharmacy impact. Use the Sensitive Diagnosis Drug field.","","$C(7),!")
+14 QUIT
End DoDot:1
+15 ;
+16 QUIT
+17 ;
WRITE ;Calls EN^DDIOL to write text
+1 DO EN^DDIOL(.PSSHLP)
KILL PSSHLP
+2 QUIT
+3 ;
PKIND IF +$PIECE($GET(^PSDRUG(DA,"ND")),"^",3)
SET PSSK=$PIECE(^("ND"),"^",3)
Begin DoDot:1
+1 SET PSSK=$$GET1^DIQ(50.68,PSSK,19,"I")
IF PSSK
SET PSSK=$$CSDEA^PSSDDUT2(PSSK)
Begin DoDot:2
+2 IF $LENGTH(PSSK)=1
IF $PIECE(^PSDRUG(DA,0),"^",3)[PSSK
QUIT
+3 IF $PIECE(^PSDRUG(DA,0),"^",3)[$EXTRACT(PSSK)
IF $PIECE(^PSDRUG(DA,0),"^",3)[$EXTRACT(PSSK,2)
QUIT
+4 WRITE !!,"The CS Federal Schedule associated with this drug in the VA Product file"
+5 WRITE !,"represents a DEA, Special Handling code of "_PSSK
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
CSDEA(CS) ;
+1 if 'CS
QUIT ""
+2 QUIT $SELECT(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS)
+3 ;
CLOZ ;DEL node of DRUG file 50, fields 17.2, 17.3, 17.4
+1 SET PSSHLP(1)="To delete this field use the Unmark Clozapine Drug option in the"
+2 SET PSSHLP(2)="Clozapine Pharmacy Manager menu."
+3 DO WRITE
+4 QUIT
+5 ;
NONF ;Non-Formulary Input Transform DRUG file 50, field 51
+1 SET PSSHLP(1)="This drug cannot be marked as a non-formulary item because it is"
+2 SET PSSHLP(2)="designated as a formulary alternative for the following drugs."
+3 SET PSSHLP(3)=" "
SET PSSHLP(1,"F")="!!"
+4 DO WRITE
+5 FOR MM=0:0
SET MM=$ORDER(^PSDRUG("AFA",DA,MM))
if 'MM
QUIT
SET SHEMP=$PIECE(^PSDRUG(MM,0),"^")
DO EN^DDIOL(SHEMP,"","!?3")
+6 SET X=""
+7 QUIT
+8 ;
ATC ;Executable help for field 212.2, DRUG file 50
+1 SET PSSHLP(1)="The mnemonic entered here must match the mnemonic entered into the"
+2 SET PSSHLP(2)="ATC for this drug EXACTLY, and cannot be numbers only."
+3 DO WRITE
+4 QUIT
+5 ;
ADTM ;ADMINISTRATION SCHEDULE file 51.1, field 1 Executable Help
+1 SET PSSHLP(1)="All times must be the same length (2 or 4 characters), must be"
+2 SET PSSHLP(2)="separated by dashes ('-'), and be in ascending order"
+3 SET PSSHLP(3)=""
+4 SET PSSHLP(4)="This is the set of administration times for this Schedule."
+5 SET PSSHLP(5)=""
+6 SET PSSHLP(6)="If the Schedule Type is CONTINUOUS the number of administration"
+7 SET PSSHLP(7)="times cannot conflict with the frequency of the schedule. For"
+8 SET PSSHLP(8)="example, a schedule frequency of 720 minutes must have two"
+9 SET PSSHLP(9)="administration times and a schedule frequency of 360 must have a"
+10 SET PSSHLP(10)="four administration times."
+11 SET PSSHLP(11)=""
+12 SET PSSHLP(12)="If the Schedule Type is CONTINUOUS and is an Odd Schedule (A"
+13 SET PSSHLP(13)="schedule whose frequency is not evenly divisible by or into"
+14 SET PSSHLP(14)="1440 minutes or 1 day). Administration Times are not allowed."
+15 SET PSSHLP(15)="For example Q5H, Q17H - these are not evenly divisible by 1440."
+16 SET PSSHLP(16)=""
+17 SET PSSHLP(17)="If the Schedule Type is CONTINUOUS with a non-odd frequency of"
+18 SET PSSHLP(18)="greater than of 1 day (1440 minutes) then more than one"
+19 SET PSSHLP(19)="administration time is not allowed. For example schedules of"
+20 SET PSSHLP(20)="Q72H, Q3Day, and Q5Day."
+21 DO WRITE
+22 QUIT
+23 ;
LBLS ;PHARMACY SYSTEM file 59.7, field 61.2 Executable Help
+1 SET PSSHLP(1)="ANY NEW LABELS OLDER THAN THE NUMBER OF DAYS SPECIFIED HERE WILL"
+2 SET PSSHLP(2)="AUTOMATICALLY BE PURGED."
+3 DO WRITE
+4 QUIT
NFH IF '$DATA(DA(1))
DO EN^DDIOL(" (This non-formulary item is "_$PIECE(^PSDRUG($SELECT($DATA(DA(1)):DA(1),1:DA),0),"^")_".)")
+1 QUIT
STRTH SET STR=" "_$PIECE(X," ",2)
SET PSSHLP(1)=STR
SET PSSHLP(1,"F")=""
DO WRITE
KILL STR
+1 QUIT
PSYS1 DO EN^DDIOL("(""From"" ward is "_$SELECT('$DATA(^PS(59.7,D0,22,D1,0)):"UNKNOWN",'$DATA(^DIC(42,+^(0),0)):"UNKNOWN",$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")_")","","!?3")
+1 QUIT
PSYS2 ;PSS*1.0*95
+1 DO EN^DDIOL("(""From"" service is "_$SELECT('$DATA(^PS(59.7,D0,23,D1,0)):"UNKNOWN",$PIECE(^(0),"^")]"":$PIECE($PIECE(";"_$PIECE(^DD(59.723,.01,0),"^",3),";"_$PIECE(^PS(59.7,D0,23,D1,0),"^")_":",2),";"),1:"UNKNOWN")_")")
+2 QUIT
+3 ;
NCINIT ;
+1 KILL PSSNQM,PSSNQM2,PSSNQM3,PSSONDU,PSSONQM
NCINIT1 ;
+1 IF $PIECE($GET(^PSDRUG(DA,"EPH")),"^",2)=""
SET $PIECE(^PSDRUG(DA,"EPH"),"^",2)="EA"
SET $PIECE(^PSDRUG(DA,"EPH"),"^",3)=1
Begin DoDot:1
+2 SET PSSHLP(1)=" Note: Defaulting the NCPDP DISPENSE UNIT to EACH and the"
+3 SET PSSHLP(2)=" NCPDP QUANTITY MULTIPLIER to 1 (one)."
SET PSSHLP(1,"F")="!!"
+4 DO WRITE
SET PSSHLP(2,"F")="!"
DO WRITE
End DoDot:1
+5 SET PSSONDU=$PIECE(^PSDRUG(DA,"EPH"),"^",2)
SET PSSONQM=$PIECE(^PSDRUG(DA,"EPH"),"^",3)
+6 QUIT
+7 ;
NCPDPDU ;Drug file 50, field 82
+1 if X=""
SET X="EA"
+2 if '$DATA(PSSONDU)
DO NCINIT1
+3 IF $GET(PSSONDU)'=X&($GET(PSSONQM)'=1)
Begin DoDot:1
+4 SET PSSHLP(1)="Defaulting the NCPDP QUANTITY MULTIPLIER to 1 (one)."
SET PSSHLP(1,"F")="!!"
DO WRITE
+5 SET $PIECE(^PSDRUG(DA,"EPH"),"^",3)=1
SET PSSONDU=$PIECE(^PSDRUG(DA,"EPH"),"^",2)
SET PSSONQM=$PIECE(^PSDRUG(DA,"EPH"),"^",3)
End DoDot:1
+6 QUIT
+7 ;
NCPDPQM ;Drug file 50, field 83
+1 NEW ZXX
SET PSSNQM=0
SET (PSSNQM2,PSSNQM3)=""
+2 IF $GET(X)<.00001
KILL X
SET PSSNQM3=1
QUIT
+3 if $GET(X)=""
SET X=1
+4 IF +$GET(X)'=1
DO NCPDPWRN
Begin DoDot:1
NCPDPQM1 ;
+1 READ !,"Ok to continue? (Y/N) ",ZXX:30
SET ZXX=$TRANSLATE(ZXX,"yn","YN")
+2 IF ZXX="^"
SET X=1
WRITE !!?5,"Warning: Defaulting NCPDP QUANTITY MULTIPLIER to 1 (one).",!!
QUIT
+3 IF ZXX'="Y"&(ZXX'="N")
WRITE !,"Y or N must be entered."
GOTO NCPDPQM1
+4 IF ZXX'="Y"&(ZXX'="y")
SET PSSNQM=1
SET PSSNQM2=X
KILL X
End DoDot:1
+5 QUIT
+6 ;
NCPDPWRN ;Message called from NCPDPQM
+1 SET PSSHLP(2)="WARNING: For most drug products, the value for this field should be 1 (one)."
+2 SET PSSHLP(3)=" Answering NO for the following prompt will display more information"
+3 SET PSSHLP(4)=" on how this field is used."
+4 SET PSSHLP(2,"F")="!!"
DO WRITE
+5 SET PSSHLP(5,"F")="!"
DO WRITE
+6 QUIT
+7 ;
MXDAYSUP ; INPUT TRANSFORM for Drug file (#50), MAXIMUM DAYS SUPPLY Field (#66)
+1 ; Input: X - Maximum Days Supply Entered by user
+2 ; DA - DRUG file (#50) IEN
+3 if '$DATA(^PSDRUG(+$GET(DA),0))
QUIT
+4 SET X=+$GET(X)
+5 ; - DAY SUPPLY must be between 1 and 365 (inclusive)
+6 IF (X<1)!(X>365)
Begin DoDot:1
+7 DO EN^DDIOL("Type a number between 1 and 365, 0 decimal digits.","","!!")
KILL X
WRITE !
End DoDot:1
QUIT
+8 ;
+9 ; - Checking against NDF Maximum
+10 NEW VAPRDIEN
SET VAPRDIEN=+$$GET1^DIQ(50,DA,22,"I")
+11 IF VAPRDIEN
Begin DoDot:1
+12 NEW NDFMAXDS
+13 SET NDFMAXDS=$$GET1^DIQ(50.68,VAPRDIEN,32)
+14 IF NDFMAXDS
IF NDFMAXDS<X
Begin DoDot:2
+15 DO EN^DDIOL("Cannot be greater than NDF Maximum Days Supply: "_NDFMAXDS,"","!!")
KILL X
WRITE !
End DoDot:2
End DoDot:1
IF '$DATA(X)
QUIT
+16 ;
+17 ; - Controlled Substances have different upper limits (not 365)
+18 NEW DEASPHLG
SET DEASPHLG=$$GET1^DIQ(50,DA,3)
+19 IF DEASPHLG["2"
IF X>30
Begin DoDot:1
+20 DO EN^DDIOL("Schedule 2 controlled substances have a maximum days supply limit of 30 days","","!!")
KILL X
WRITE !
End DoDot:1
QUIT
+21 IF (DEASPHLG["3")!(DEASPHLG["4")!(DEASPHLG["5")
IF X>90
Begin DoDot:1
+22 DO EN^DDIOL("Schedule 3-5 controlled substances have a maximum days supply limit of 90 days","","!!")
KILL X
WRITE !
End DoDot:1
QUIT
+23 ;
+24 ; - Clozapine Drug (Not controlled by this field)
+25 IF ($PIECE($GET(^PSDRUG(DA,"CLOZ1")),"^")="PSOCLO1")
Begin DoDot:1
+26 DO EN^DDIOL("Maximum Days Supply for this drug is controlled by the Clozapine functionality","","!!")
KILL X
WRITE !
End DoDot:1
QUIT
+27 ;
+28 IF X<$$MXDAYSUP^PSSUTIL1(DA)
Begin DoDot:1
+29 WRITE !
DO EN^DDIOL("Note: Decreasing the MAXIMUM DAYS SUPPLY field will only affect new","","!")
+30 DO EN^DDIOL(" prescriptions, including renewals and copies. Orders that are pending","","!")
+31 DO EN^DDIOL(" or unreleased when the MAXIMUM DAYS SUPPLY field is decreased are not","","!")
+32 DO EN^DDIOL(" affected by the decrease, so prescriptions with a DAYS SUPPLY above the","","!")
+33 DO EN^DDIOL(" new MAXIMUM DAYS SUPPLY may need to be edited manually before they are","","!")
+34 DO EN^DDIOL(" finished or released.","","!")
+35 WRITE !
NEW DIR,X,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
End DoDot:1
+36 QUIT
+37 ;
IVSOLVOL ; IV Solution VOLUME field INPUT TRANSFORM
+1 NEW OI
+2 IF X[""""!($ASCII(X)=45)!(X'?.N0.1".".N)!(X>9999)!(X<.01)
KILL X
QUIT
+3 IF $$GET1^DIQ(52.7,DA,17,"I")
SET OI=+$$GET1^DIQ(52.7,DA,9,"I")
IF $$CKDUPSOL(OI,DA,+X,1)
KILL X
QUIT
+4 SET X=X_" ML"
DO EN^DDIOL(" ML","","?0")
+5 QUIT
+6 ;
UIVFOE ; USED IN THE IV FLUID ORDER ENTRY field INPUT TRANSFORM
+1 IF X
Begin DoDot:1
+2 NEW OI
+3 SET OI=$$GET1^DIQ(52.7,DA,9,"I")
IF $$CKDUPSOL(OI,DA,+$$GET1^DIQ(52.7,DA,2),1)
KILL X
End DoDot:1
+4 QUIT
+5 ;
CKDUPSOL(OI,IVSOL,IVVOL,DSPMSG) ; Check if there's an ACTIVE Duplicate IV Solution Marked to be Used in the IV Order Dialog
+1 ; Input: OI - PHARMACY ORDERABLE ITEM (#50.7) Pointer
+2 ; IVSOL - IV SOLUTIONS (#52.7) Pointer
+3 ; IVVOL - IV Solution Volume
+4 ; DSPMSG - Display Message? (1:Yes/0:No)
+5 ;Output: DUPSOL - Duplicate IV Solution IEN
+6 NEW DUPSOL,OTHSOL,OTHVOL,DRUG
+7 SET (DUPSOL,OTHSOL)=0
+8 ;
+9 ; Invalid IV Solution
+10 IF '$DATA(^PS(52.7,+$GET(IVSOL),0))
QUIT 0
+11 ;
+12 ; IV Solution is INACTIVE, no issues
+13 IF $$GET1^DIQ(52.7,IVSOL,8,"I")
IF $$GET1^DIQ(52.7,IVSOL,8,"I")'>DT
QUIT 0
+14 ;
+15 ; Dispense Drug might not be matched to an Orderable Item yet
+16 SET DRUG=+$$GET1^DIQ(52.7,IVSOL,1,"I")
+17 ;
+18 IF +$GET(OI)
Begin DoDot:1
+19 FOR
SET OTHSOL=$ORDER(^PS(52.7,"AOI",OI,OTHSOL))
if 'OTHSOL!DUPSOL
QUIT
Begin DoDot:2
+20 IF $$DUPVOL(IVSOL,OTHSOL)
SET DUPSOL=OTHSOL
End DoDot:2
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 FOR
SET OTHSOL=$ORDER(^PS(52.7,"AC",DRUG,OTHSOL))
if 'OTHSOL!DUPSOL
QUIT
Begin DoDot:2
+23 IF $$DUPVOL(IVSOL,OTHSOL)
SET DUPSOL=OTHSOL
End DoDot:2
End DoDot:1
+24 IF $GET(DSPMSG)
IF DUPSOL
Begin DoDot:1
+25 WRITE !!,"The following IV Solution with the same volume is already linked to"
+26 if $GET(OI)
WRITE !,"the Orderable Item ",$$GET1^DIQ(50.7,OI,.01)
+27 if '$GET(OI)
WRITE !,"this dispense drug."
+28 WRITE !
+29 if $GET(OI)
WRITE !,"Dispense Drug: ",$$GET1^DIQ(52.7,DUPSOL,1)
+30 WRITE !," IV Solution: ",$$GET1^DIQ(52.7,DUPSOL,.01)
+31 WRITE !
+32 WRITE !,"Only one Active IV Solution with a specific volume can be linked to an"
+33 WRITE !,"Orderable Item or Dispense Drug when the IV Solution is marked to be used"
+34 WRITE !,"in the CPRS IV Fluid Order Entry."
+35 WRITE !,$CHAR(7)
End DoDot:1
+36 QUIT DUPSOL
+37 ;
DUPVOL(IVSOL1,IVSOL2) ; Check 2 IV Solutions to see if they have Duplicate Volumes
+1 ; Cannot check against itself
+2 IF (IVSOL1=IVSOL2)
QUIT 0
+3 ; Not Used in the IV Order Dialog
+4 IF '$$GET1^DIQ(52.7,IVSOL2,17,"I")
QUIT 0
+5 ; Other IV Solution is INACTIVE
+6 IF $$GET1^DIQ(52.7,IVSOL2,8,"I")
IF $$GET1^DIQ(52.7,IVSOL2,8,"I")'>DT
QUIT 0
+7 ; IV Solution Volume
+8 SET OTHVOL=$$GET1^DIQ(52.7,IVSOL2,2)
+9 ; IV Solutions have different volumes
+10 IF (+IVVOL'=+OTHVOL)
QUIT 0
+11 ; Capturing the Duplicate IV Solution IEN
+12 QUIT 1
