source: FOIAVistA/tag/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSDDUT2.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1PSSDDUT2 ;BIR/LDT - Pharmacy Data Management DD Utility ; 8/21/07 8:43am
2 ;;1.0; PHARMACY DATA MANAGEMENT; **3,21,61,81,95,127,126**;9/30/97;Build 11
3 ;
4 ;Reference to ^DIC(42 supported by DBIA #10039
5 ;Reference to ^DD(59.723 supported by DBIA #2159
6 ;Reference to ^PSNDF(50.68 supported by DBIA 3735
7 ;
8DEA ;(Replaces ^PSODEA)
9 S PSSHLP(1)="THE SPECIAL HANDLING CODE IS A 2 TO 6 POSTION FIELD. IF APPLICABLE,"
10 S PSSHLP(2)="A SCHEDULE CODE MUST APPEAR IN THE FIRST POSITION. FOR EXAMPLE,"
11 S PSSHLP(3)="A SCHEDULE 3 NARCOTIC WILL BE CODED '3A', A SCHEDULE 3 NON-NARCOTIC WILL BE"
12 S PSSHLP(4)="CODED '3C' AND A SCHEDULE 2 DEPRESSANT WILL BE CODED '2L'."
13 S PSSHLP(5)="THE CODES ARE:"
14 D WRITE
15 F II=1:1 Q:$P($T(D+II),";",3)="" S PSSHLP(II)=$P($T(D+II),";",3,99)
16 S PSSHLP(1,"F")="!!" D WRITE
17 D PKIND,WRITE
18D K II Q
19 ;;0 MANUFACTURED IN PHARMACY
20 ;;1 SCHEDULE 1 ITEM
21 ;;2 SCHEDULE 2 ITEM
22 ;;3 SCHEDULE 3 ITEM
23 ;;4 SCHEDULE 4 ITEM
24 ;;5 SCHEDULE 5 ITEM
25 ;;6 LEGEND ITEM
26 ;;9 OVER-THE-COUNTER
27 ;;L DEPRESSANTS AND STIMULANTS
28 ;;A NARCOTICS AND ALCOHOLS
29 ;;P DATED DRUGS
30 ;;I INVESTIGATIONAL DRUGS
31 ;;M BULK COMPOUND ITEMS
32 ;;C CONTROLLED SUBSTANCES - NON NARCOTIC
33 ;;R RESTRICTED ITEMS
34 ;;S SUPPLY ITEMS
35 ;;B ALLOW REFILL (SCH. 3, 4, 5 ONLY)
36 ;;W NOT RENEWABLE
37 ;;F NON REFILLABLE
38 ;;E ELECTRONICALLY BILLABLE
39 ;;
40DEATBL ; More Help regarding DEA Codes
41 K PSSHLP
42 F II=1:1 Q:$P($T(TBL+II),";",3)="" S PSSHLP(II)=$P($T(TBL+II),";",3,99)
43 S PSSHLP(1,"F")="!!" D WRITE
44 ;
45TBL K II Q
46 ;; DEA CODE TABLE
47 ;; CODE ALLOW RENEWS ALLOW REFILLS
48 ;; 1 NO NO
49 ;; 2 NO NO
50 ;; 2A NO NO
51 ;; 3 YES YES
52 ;; 3A YES NO
53 ;; 3AB YES YES
54 ;; 4 YES YES
55 ;; 4A YES NO
56 ;; 4AB YES YES
57 ;; 5 YES YES
58 ;; 5A YES NO
59 ;; 5AB YES YES
60 ;; ADDING W TO A SCHED. 3,4,OR 5 CODE DISALLOWS RENEWS.
61 ;; ADDING F TO A SCHED. 3,4,OR 5 CODE DISALLOWS REFILLS
62 ;; IF A CODE IS NOT LISTED IN THE ABOVE TABLE
63 ;; IT HAS NO EFFECT ON RENEW OR REFILL
64SIG ;checks SIG for RXs (Replaces SIG^PSOHELP)
65 I $E(X)=" " D EN^DDIOL("Leading spaces are not allowed in the SIG! ","","$C(7),!") K X Q
66SIGONE 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
67 .I $L(Z1)>32 D EN^DDIOL("MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.","","$C(7),!?5") K X Q
68 .D:$D(X)&($G(Z1)]"") S SIG=SIG_" "_Z1
69 ..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)
70EN K Z1,Z0 ;S:$G(POERR) PSOERR("SIG")="("_$E(SIG,2,999999999)_")"
71 Q
72 ;
73DRUGW ;(Replaces DRUGW^PSOUTLA)
74 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
75 Q
76 ;
77P ;(Replaces ^PSODSRC)
78 S PSSHLP(1)="A TWO OR THREE POSITION CODE IDENTIFIES THE SOURCE OF SUPPLY AND WHETHER"
79 S PSSHLP(2)="THE DRUG IS STOCKED BY THE STATION SUPPLY DIVISION. THE FIRST"
80 S PSSHLP(3)="POSITION OF THE CODE IDENTIFIES SOURCE OF SUPPLY. THE CODES ARE:"
81 D WRITE
82 F II=0:1:10 S PSSHLP(II+1)=$P($T(S+II+1),";",3),PSSHLP(II+1,"F")="!?10"
83 S PSSHLP(1,"F")="!!?10"
84 D WRITE
85 S PSSHLP(1)="THE SECOND POSITION OF THE CODE INDICATES WHETHER THE ITEM IS"
86 S PSSHLP(2)="OR IS NOT AVAILABLE FROM SUPPLY WAREHOUSE STOCK. THE CODES ARE:"
87 S PSSHLP(3)="P POSTED STOCK"
88 S PSSHLP(3,"F")="!!?10"
89 S PSSHLP(4)="U UNPOSTED"
90 S PSSHLP(4,"F")="!?10"
91 S PSSHLP(5)="M BULK COMPOUND"
92 S PSSHLP(5,"F")="!?10"
93 S PSSHLP(6)="* USE CODE 0 ONLY WITH SECOND POSITION M."
94 D WRITE Q
95 ;
96S ;;DESCRIPTION MEANINGS
97 ;;0 BULK COMPOUND ITEMS *
98 ;;1 VA SERVICING SUPPLY DEPOT
99 ;;2 OPEN MARKET
100 ;;3 GSA STORES DEPOT
101 ;;4 VA DECENTRALIZED CONTRACTS
102 ;;5 FEDERAL PRISON INDUSTRIES, INC.
103 ;;6 FEDERAL SUPPLY SCHEDULES
104 ;;7 VA SUPPLY DEPOT, HINES
105 ;;8 VA SUPPLY DEPOT, SOMERVILLE
106 ;;9 APPROPRIATE MARKETING DIVISION
107 ;;10 VA SUPPLY DEPOT, BELL
108EDIT ;INPUT XFORM FOR DEA FIELD IN DRUG FILE (Replaces EDIT^PSODEA)
109 I X["F",X["B" D EN^DDIOL("Inappropriate F designation!","","$C(7),!") K X Q
110 ;;DEA CHANGE PSS*1*126
111 I X["B",(+X<3) D EN^DDIOL("The B designation is only valid for schedule 3, 4, 5 !","","$C(7),!") K X Q
112 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
113 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
114 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
115 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
116 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
117 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
118 I $E(X)="E" D EN^DDIOL("Inappropriate E designation! Can only modify other codes.","","$C(7),!") K X Q
119 Q
120 ;
121WRITE ;Calls EN^DDIOL to write text
122 D EN^DDIOL(.PSSHLP) K PSSHLP Q
123 Q
124 ;
125PKIND I +$P($G(^PSDRUG(DA,"ND")),"^",3) S PSSK=$P(^("ND"),"^",3) D
126 .S PSSK=$$GET1^DIQ(50.68,PSSK,19,"I") I PSSK S PSSK=$$CSDEA^PSSDDUT2(PSSK) D
127 ..I $L(PSSK)=1,$P(^PSDRUG(DA,0),"^",3)[PSSK Q
128 ..I $P(^PSDRUG(DA,0),"^",3)[$E(PSSK),$P(^PSDRUG(DA,0),"^",3)[$E(PSSK,2) Q
129 ..W !!,"The CS Federal Schedule associated with this drug in the VA Product file"
130 ..W !,"represents a DEA, Special Handling code of "_PSSK
131 Q
132 ;
133CSDEA(CS) ;
134 Q:'CS ""
135 Q $S(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS)
136 ;
137CLOZ ;DEL node of DRUG file 50, fields 17.2, 17.3, 17.4
138 S PSSHLP(1)="To delete this field use the Unmark Clozapine Drug option in the"
139 S PSSHLP(2)="Clozapine Pharmacy Manager menu."
140 D WRITE
141 Q
142 ;
143NONF ;Non-Formulary Input Transform DRUG file 50, field 51
144 S PSSHLP(1)="This drug cannot be marked as a non-formulary item because it is"
145 S PSSHLP(2)="designated as a formulary alternative for the following drugs."
146 S PSSHLP(3)=" ",PSSHLP(1,"F")="!!"
147 D WRITE
148 F MM=0:0 S MM=$O(^PSDRUG("AFA",DA,MM)) Q:'MM S SHEMP=$P(^PSDRUG(MM,0),"^") D EN^DDIOL(SHEMP,"","!?3")
149 S X=""
150 Q
151 ;
152ATC ;Executable help for field 212.2, DRUG file 50
153 S PSSHLP(1)="The mnemonic entered here must match the mnemonic entered into the"
154 S PSSHLP(2)="ATC for this drug EXACTLY, and cannot be numbers only."
155 D WRITE
156 Q
157 ;
158ADTM ;ADMINISTRATION SCHEDULE file 51.1, field 1 Executable Help
159 S PSSHLP(1)="ALL TIMES MUST BE THE SAME LENGTH (2 OR 4 CHARACTERS), MUST BE"
160 S PSSHLP(2)="SEPARATED BY DASHES ('-'), AND BE IN ASCENDING ORDER"
161 D WRITE
162 Q
163 ;
164LBLS ;PHARMACY SYSTEM file 59.7, field 61.2 Executable Help
165 S PSSHLP(1)="ANY NEW LABELS OLDER THAN THE NUMBER OF DAYS SPECIFIED HERE WILL"
166 S PSSHLP(2)="AUTOMATICALLY BE PURGED."
167 D WRITE
168 Q
169NFH I '$D(DA(1)) D EN^DDIOL(" (This non-formulary item is "_$P(^PSDRUG($S($D(DA(1)):DA(1),1:DA),0),"^")_".)")
170 Q
171STRTH S STR=" "_$P(X," ",2),PSSHLP(1)=STR,PSSHLP(1,"F")="" D WRITE K STR
172 Q
173PSYS1 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")
174 Q
175PSYS2 ;PSS*1.0*95
176 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")_")")
177 Q
178 ;
179NCINIT ;
180 K PSSNQM,PSSNQM2,PSSNQM3,PSSONDU,PSSONQM
181NCINIT1 ;
182 I $P($G(^PSDRUG(DA,"EPH")),"^",2)="" S $P(^PSDRUG(DA,"EPH"),"^",2)="EA",$P(^PSDRUG(DA,"EPH"),"^",3)=1 D
183 . S PSSHLP(1)=" Note: Defaulting the NCPDP DISPENSE UNIT to EACH and the"
184 . S PSSHLP(2)=" NCPDP QUANTITY MULTIPLIER to 1 (one)." S PSSHLP(1,"F")="!!"
185 . D WRITE S PSSHLP(2,"F")="!" D WRITE
186 S PSSONDU=$P(^PSDRUG(DA,"EPH"),"^",2),PSSONQM=$P(^PSDRUG(DA,"EPH"),"^",3)
187 Q
188 ;
189NCPDPDU ;Drug file 50, field 82
190 S:X="" X="EA"
191 D NCINIT1:'$D(PSSONDU)
192 I $G(PSSONDU)'=X&($G(PSSONQM)'=1) D
193 . S PSSHLP(1)="Defaulting the NCPDP QUANTITY MULTIPLIER to 1 (one)." S PSSHLP(1,"F")="!!" D WRITE
194 . S $P(^PSDRUG(DA,"EPH"),"^",3)=1,PSSONDU=$P(^PSDRUG(DA,"EPH"),"^",2),PSSONQM=$P(^PSDRUG(DA,"EPH"),"^",3)
195 Q
196 ;
197NCPDPQM ;Drug file 50, field 83
198 N ZXX S PSSNQM=0,(PSSNQM2,PSSNQM3)=""
199 I $G(X)<.001 K X S PSSNQM3=1 Q
200 S:$G(X)="" X=1
201 I +$G(X)'=1 D NCPDPWRN D
202NCPDPQM1 . ;
203 . R !,"Ok to continue? (Y/N) ",ZXX:30 S ZXX=$TR(ZXX,"yn","YN")
204 . I ZXX="^" S X=1 W !!?5,"Warning: Defaulting NCPDP QUANTITY MULTIPLIER to 1 (one).",!! Q
205 . I ZXX'="Y"&(ZXX'="N") W !,"Y or N must be entered." G NCPDPQM1
206 . I ZXX'="Y"&(ZXX'="y") S PSSNQM=1,PSSNQM2=X K X
207 Q
208 ;
209NCPDPWRN ;
210 S PSSHLP(2)="WARNING: For most drug products, the value for this field should be 1 (one)."
211 S PSSHLP(3)=" Answering NO for the following prompt will display more information"
212 S PSSHLP(4)=" on how this field is used."
213 S PSSHLP(2,"F")="!!" D WRITE
214 S PSSHLP(5,"F")="!" D WRITE
215 Q
216 ;
Note: See TracBrowser for help on using the repository browser.