- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSDDUT2.m
r613 r623 1 PSSDDUT2 ;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 ; 8 DEA ;(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 18 D 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 ;; 40 DEATBL ; 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 ; 45 TBL 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 64 SIG ;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 66 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 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) 70 EN K Z1,Z0 ;S:$G(POERR) PSOERR("SIG")="("_$E(SIG,2,999999999)_")" 71 Q 72 ; 73 DRUGW ;(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 ; 77 P ;(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 ; 96 S ;;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 108 EDIT ;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 ; 121 WRITE ;Calls EN^DDIOL to write text 122 D EN^DDIOL(.PSSHLP) K PSSHLP Q 123 Q 124 ; 125 PKIND 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 ; 133 CSDEA(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 ; 137 CLOZ ;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 ; 143 NONF ;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 ; 152 ATC ;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 ; 158 ADTM ;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 ; 164 LBLS ;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 169 NFH 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 171 STRTH S STR=" "_$P(X," ",2),PSSHLP(1)=STR,PSSHLP(1,"F")="" D WRITE K STR 172 Q 173 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") 174 Q 175 PSYS2 ;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 ; 179 NCINIT ; 180 K PSSNQM,PSSNQM2,PSSNQM3,PSSONDU,PSSONQM 181 NCINIT1 ; 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 ; 189 NCPDPDU ;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 ; 197 NCPDPQM ;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 202 NCPDPQM1 . ; 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 ; 209 NCPDPWRN ; 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 ; 1 PSSDDUT2 ;BIR/LDT - Pharmacy Data Management DD Utility ;10/30/97 9:41 2 ;;1.0; PHARMACY DATA MANAGEMENT; **3,21,61,81,95,127**;9/30/97;Build 41 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 ; 8 DEA ;(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 18 D 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 NARCOTICS ONLY) 36 ;;W NOT RENEWABLE 37 ;;F NON REFILLABLE 38 ;;E ELECTRONICALLY BILLABLE 39 ;; 40 SIG ;checks SIG for RXs (Replaces SIG^PSOHELP) 41 I $E(X)=" " D EN^DDIOL("Leading spaces are not allowed in the SIG! ","","$C(7),!") K X Q 42 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 43 .I $L(Z1)>32 D EN^DDIOL("MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.","","$C(7),!?5") K X Q 44 .D:$D(X)&($G(Z1)]"") S SIG=SIG_" "_Z1 45 ..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) 46 EN K Z1,Z0 ;S:$G(POERR) PSOERR("SIG")="("_$E(SIG,2,999999999)_")" 47 Q 48 ; 49 DRUGW ;(Replaces DRUGW^PSOUTLA) 50 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 51 Q 52 ; 53 P ;(Replaces ^PSODSRC) 54 S PSSHLP(1)="A TWO OR THREE POSITION CODE IDENTIFIES THE SOURCE OF SUPPLY AND WHETHER" 55 S PSSHLP(2)="THE DRUG IS STOCKED BY THE STATION SUPPLY DIVISION. THE FIRST" 56 S PSSHLP(3)="POSITION OF THE CODE IDENTIFIES SOURCE OF SUPPLY. THE CODES ARE:" 57 D WRITE 58 F II=0:1:10 S PSSHLP(II+1)=$P($T(S+II+1),";",3),PSSHLP(II+1,"F")="!?10" 59 S PSSHLP(1,"F")="!!?10" 60 D WRITE 61 S PSSHLP(1)="THE SECOND POSITION OF THE CODE INDICATES WHETHER THE ITEM IS" 62 S PSSHLP(2)="OR IS NOT AVAILABLE FROM SUPPLY WAREHOUSE STOCK. THE CODES ARE:" 63 S PSSHLP(3)="P POSTED STOCK" 64 S PSSHLP(3,"F")="!!?10" 65 S PSSHLP(4)="U UNPOSTED" 66 S PSSHLP(4,"F")="!?10" 67 S PSSHLP(5)="M BULK COMPOUND" 68 S PSSHLP(5,"F")="!?10" 69 S PSSHLP(6)="* USE CODE 0 ONLY WITH SECOND POSITION M." 70 D WRITE Q 71 ; 72 S ;;DESCRIPTION MEANINGS 73 ;;0 BULK COMPOUND ITEMS * 74 ;;1 VA SERVICING SUPPLY DEPOT 75 ;;2 OPEN MARKET 76 ;;3 GSA STORES DEPOT 77 ;;4 VA DECENTRALIZED CONTRACTS 78 ;;5 FEDERAL PRISON INDUSTRIES, INC. 79 ;;6 FEDERAL SUPPLY SCHEDULES 80 ;;7 VA SUPPLY DEPOT, HINES 81 ;;8 VA SUPPLY DEPOT, SOMERVILLE 82 ;;9 APPROPRIATE MARKETING DIVISION 83 ;;10 VA SUPPLY DEPOT, BELL 84 EDIT ;INPUT XFORM FOR DEA FIELD IN DRUG FILE (Replaces EDIT^PSODEA) 85 I X["F",X["B" D EN^DDIOL("Inappropriate F designation!","","$C(7),!") K X Q 86 I X["B",(+X<3!(X'["A")) D EN^DDIOL("The B designation is only valid for schedule 3, 4, 5 narcotics !","","$C(7),!") K X Q 87 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 88 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 89 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 90 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 91 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 92 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 93 I $E(X)="E" D EN^DDIOL("Inappropriate E designation! Can only modify other codes.","","$C(7),!") K X Q 94 Q 95 ; 96 WRITE ;Calls EN^DDIOL to write text 97 D EN^DDIOL(.PSSHLP) K PSSHLP Q 98 Q 99 ; 100 PKIND I +$P($G(^PSDRUG(DA,"ND")),"^",3) S PSSK=$P(^("ND"),"^",3) D 101 .S PSSK=$$GET1^DIQ(50.68,PSSK,19,"I") I PSSK S PSSK=$$CSDEA^PSSDDUT2(PSSK) D 102 ..I $L(PSSK)=1,$P(^PSDRUG(DA,0),"^",3)[PSSK Q 103 ..I $P(^PSDRUG(DA,0),"^",3)[$E(PSSK),$P(^PSDRUG(DA,0),"^",3)[$E(PSSK,2) Q 104 ..W !!,"The CS Federal Schedule associated with this drug in the VA Product file" 105 ..W !,"represents a DEA, Special Handling code of "_PSSK 106 Q 107 ; 108 CSDEA(CS) ; 109 Q:'CS "" 110 Q $S(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS) 111 ; 112 CLOZ ;DEL node of DRUG file 50, fields 17.2, 17.3, 17.4 113 S PSSHLP(1)="To delete this field use the Unmark Clozapine Drug option in the" 114 S PSSHLP(2)="Clozapine Pharmacy Manager menu." 115 D WRITE 116 Q 117 ; 118 NONF ;Non-Formulary Input Transform DRUG file 50, field 51 119 S PSSHLP(1)="This drug cannot be marked as a non-formulary item because it is" 120 S PSSHLP(2)="designated as a formulary alternative for the following drugs." 121 S PSSHLP(3)=" ",PSSHLP(1,"F")="!!" 122 D WRITE 123 F MM=0:0 S MM=$O(^PSDRUG("AFA",DA,MM)) Q:'MM S SHEMP=$P(^PSDRUG(MM,0),"^") D EN^DDIOL(SHEMP,"","!?3") 124 S X="" 125 Q 126 ; 127 ATC ;Executable help for field 212.2, DRUG file 50 128 S PSSHLP(1)="The mnemonic entered here must match the mnemonic entered into the" 129 S PSSHLP(2)="ATC for this drug EXACTLY, and cannot be numbers only." 130 D WRITE 131 Q 132 ; 133 ADTM ;ADMINISTRATION SCHEDULE file 51.1, field 1 Executable Help 134 S PSSHLP(1)="ALL TIMES MUST BE THE SAME LENGTH (2 OR 4 CHARACTERS), MUST BE" 135 S PSSHLP(2)="SEPARATED BY DASHES ('-'), AND BE IN ASCENDING ORDER" 136 D WRITE 137 Q 138 ; 139 LBLS ;PHARMACY SYSTEM file 59.7, field 61.2 Executable Help 140 S PSSHLP(1)="ANY NEW LABELS OLDER THAN THE NUMBER OF DAYS SPECIFIED HERE WILL" 141 S PSSHLP(2)="AUTOMATICALLY BE PURGED." 142 D WRITE 143 Q 144 NFH I '$D(DA(1)) D EN^DDIOL(" (This non-formulary item is "_$P(^PSDRUG($S($D(DA(1)):DA(1),1:DA),0),"^")_".)") 145 Q 146 STRTH S STR=" "_$P(X," ",2),PSSHLP(1)=STR,PSSHLP(1,"F")="" D WRITE K STR 147 Q 148 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") 149 Q 150 PSYS2 ;PSS*1.0*95 151 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")_")") 152 Q 153 ; 154 NCINIT ; 155 K PSSNQM,PSSNQM2,PSSNQM3,PSSONDU,PSSONQM 156 NCINIT1 ; 157 I $P($G(^PSDRUG(DA,"EPH")),"^",2)="" S $P(^PSDRUG(DA,"EPH"),"^",2)="EA",$P(^PSDRUG(DA,"EPH"),"^",3)=1 D 158 . S PSSHLP(1)=" Note: Defaulting the NCPDP DISPENSE UNIT to EACH and the" 159 . S PSSHLP(2)=" NCPDP QUANTITY MULTIPLIER to 1 (one)." S PSSHLP(1,"F")="!!" 160 . D WRITE S PSSHLP(2,"F")="!" D WRITE 161 S PSSONDU=$P(^PSDRUG(DA,"EPH"),"^",2),PSSONQM=$P(^PSDRUG(DA,"EPH"),"^",3) 162 Q 163 ; 164 NCPDPDU ;Drug file 50, field 82 165 S:X="" X="EA" 166 D NCINIT1:'$D(PSSONDU) 167 I $G(PSSONDU)'=X&($G(PSSONQM)'=1) D 168 . S PSSHLP(1)="Defaulting the NCPDP QUANTITY MULTIPLIER to 1 (one)." S PSSHLP(1,"F")="!!" D WRITE 169 . S $P(^PSDRUG(DA,"EPH"),"^",3)=1,PSSONDU=$P(^PSDRUG(DA,"EPH"),"^",2),PSSONQM=$P(^PSDRUG(DA,"EPH"),"^",3) 170 Q 171 ; 172 NCPDPQM ;Drug file 50, field 83 173 N ZXX S PSSNQM=0,(PSSNQM2,PSSNQM3)="" 174 I $G(X)<.001 K X S PSSNQM3=1 Q 175 S:$G(X)="" X=1 176 I +$G(X)'=1 D NCPDPWRN D 177 NCPDPQM1 . ; 178 . R !,"Ok to continue? (Y/N) ",ZXX:30 S ZXX=$TR(ZXX,"yn","YN") 179 . I ZXX="^" S X=1 W !!?5,"Warning: Defaulting NCPDP QUANTITY MULTIPLIER to 1 (one).",!! Q 180 . I ZXX'="Y"&(ZXX'="N") W !,"Y or N must be entered." G NCPDPQM1 181 . I ZXX'="Y"&(ZXX'="y") S PSSNQM=1,PSSNQM2=X K X 182 Q 183 ; 184 NCPDPWRN ; 185 S PSSHLP(2)="WARNING: For most drug products, the value for this field should be 1 (one)." 186 S PSSHLP(3)=" Answering NO for the following prompt will display more information" 187 S PSSHLP(4)=" on how this field is used." 188 S PSSHLP(2,"F")="!!" D WRITE 189 S PSSHLP(5,"F")="!" D WRITE 190 Q 191 ;
Note:
See TracChangeset
for help on using the changeset viewer.
