PSSDDUT2 ;BIR/LDT - Pharmacy Data Management DD Utility ; 8/21/07 8:43am
;;1.0;PHARMACY DATA MANAGEMENT;**3,21,61,81,95,127,126,139,131**;9/30/97;Build 16
;
;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
;;E ELECTRONICALLY BILLABLE
;;N NUTRITIONAL SUPPLEMENT
;;U SENSITIVE DRUG
;;
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 $E(X)="E" D EN^DDIOL("Inappropriate E designation! Can only modify other codes.","","$C(7),!") K X Q
Q
;
WRITE ;Calls EN^DDIOL to write text
D EN^DDIOL(.PSSHLP) K PSSHLP Q
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"
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)<.001 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 ;
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
;
PSSDDUT2 ;BIR/LDT - Pharmacy Data Management DD Utility ; 8/21/07 8:43am
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**3,21,61,81,95,127,126,139,131**;9/30/97;Build 16
+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 ;;E ELECTRONICALLY BILLABLE
+21 ;;N NUTRITIONAL SUPPLEMENT
+22 ;;U SENSITIVE DRUG
+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 IF $EXTRACT(X)="E"
DO EN^DDIOL("Inappropriate E designation! Can only modify other codes.","","$C(7),!")
KILL X
QUIT
+11 QUIT
+12 ;
WRITE ;Calls EN^DDIOL to write text
+1 DO EN^DDIOL(.PSSHLP)
KILL PSSHLP
QUIT
+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 DO WRITE
+4 QUIT
+5 ;
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)<.001
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 ;
+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 ;
