source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSDEE.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 9.6 KB
Line 
1PSSDEE ;BIR/WRT-MASTER DRUG ENTER/EDIT ROUTINE ;01/21/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**3,5,15,16,20,22,28,32,34,33,38,57,47,68,61,82,90,110**;9/30/97
3 ;
4 ;Reference to ^PS(59 supported by DBIA #1976
5 ;Reference to REACT1^PSNOUT supported by DBIA #2080
6 ;Reference to $$UP^XLFSTR(X) supported by DBIA #10104
7 ;Reference to $$PSJDF^PSNAPIS(P1,P3) supported by DBIA #2531
8 ;
9BEGIN S PSSFLAG=0 D ^PSSDEE2 S PSSZ=1 F PSSXX=1:1 K DA D ASK Q:PSSFLAG
10DONE D ^PSSDEE2 K PSSFLAG Q
11ASK W ! S DIC="^PSDRUG(",DIC(0)="QEALMNTV",DLAYGO=50,DIC("T")="" D ^DIC K DIC I Y<0 S PSSFLAG=1 Q
12 S (FLG1,FLG2,FLG3,FLG4,FLG5,FLG6,FLG7,FLAG,FLGKY,FLGOI)=0 K ^TMP($J,"ADD"),^TMP($J,"SOL")
13 S DA=+Y,DISPDRG=DA L +^PSDRUG(DISPDRG):0 I '$T W !,$C(7),"Another person is editing this one." Q
14 S PSSHUIDG=1,PSSNEW=$P(Y,"^",3) D USE,NOPE,COMMON,DEA,MF K PSSHUIDG
15 ; if any outpatient site has a dispense machine running HL7 V.2.4, then
16 ; run the new routine and create message
17 N XX,DNSNAM,DNSPORT,DVER,DMFU S XX=""
18 F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX D
19 .S DVER=$$GET1^DIQ(59,XX_",",105,"I"),DMFU=$$GET1^DIQ(59,XX_",",105.2)
20 .S DNSNAM=$$GET1^DIQ(59,XX_",",2006),DNSPORT=$$GET1^DIQ(59,XX_",",2007)
21 .D:DVER="2.4"&(DNSNAM'="")&(DMFU="YES") DRG^PSSDGUPD(DISPDRG,PSSNEW,DNSNAM,DNSPORT)
22 D DRG^PSSHUIDG(DISPDRG,PSSNEW) L -^PSDRUG(DISPDRG) K FLG3,PSSNEW
23 Q
24COMMON S DIE="^PSDRUG(",DR="[PSSCOMMON]" D ^DIE Q:$D(Y)!($D(DTOUT)) W:'$D(Y) !,"PRICE PER DISPENSE UNIT: " S:'$D(^PSDRUG(DA,660)) $P(^PSDRUG(DA,660),"^",6)="" W:'$D(Y) $P(^PSDRUG(DA,660),"^",6)
25 D DEA,CK,ASKND,OIKILL^PSSDEE1,COMMON1
26 Q
27COMMON1 W !,"Just a reminder...you are editing ",$P(^PSDRUG(DISPDRG,0),"^"),"." S (PSSVVDA,DA)=DISPDRG D DOSN^PSSDOS S DA=PSSVVDA K PSSVVDA D USE,APP,ORDITM^PSSDEE1
28 Q
29CK D DSPY^PSSDEE1 S FLGNDF=0
30 Q
31ASKND S %=-1 I $D(^XUSEC("PSNMGR",DUZ)) D MESSAGE^PSSDEE1 W !!,"Do you wish to match/rematch to NATIONAL DRUG file" S %=1 S:FLGMTH=1 %=2 D YN^DICN
32 I %=0 W !,"If you answer ""yes"", you will attempt to match to NDF." G ASKND
33 I %=2 K X,Y Q
34 I %<0 K X,Y Q
35 I %=1 D RSET^PSSDEE1,EN1^PSSUTIL(DISPDRG,1) S X="PSNOUT" X ^%ZOSF("TEST") I D REACT1^PSNOUT S DA=DISPDRG I $D(^PSDRUG(DA,"ND")),$P(^PSDRUG(DA,"ND"),"^",2)]"" D ONE
36 Q
37ONE S PSNP=$G(^PSDRUG(DA,"I")) I PSNP,PSNP<DT Q
38 W !,"You have just VERIFIED this match and MERGED the entry." D CKDF D EN2^PSSUTIL(DISPDRG,1) S:'$D(OLDDF) OLDDF="" I OLDDF'=NEWDF S FLGNDF=1 D WR
39 Q
40CKDF S NWND=^PSDRUG(DA,"ND"),NWPC1=$P(NWND,"^",1),NWPC3=$P(NWND,"^",3),DA=NWPC1,K=NWPC3 S X=$$PSJDF^PSNAPIS(DA,K) S NEWDF=$P(X,"^",2),DA=DISPDRG
41 N PSSK D PKIND^PSSDDUT2
42 Q
43NOPE S ZAPFLG=0 I '$D(^PSDRUG(DA,"ND")),$D(^PSDRUG(DA,2)),$P(^PSDRUG(DA,2),"^",1)']"" D DFNULL
44 I '$D(^PSDRUG(DA,"ND")),'$D(^PSDRUG(DA,2)) D DFNULL
45 I $D(^PSDRUG(DA,"ND")),$P(^PSDRUG(DA,"ND"),"^",2)']"",$D(^PSDRUG(DA,2)),$P(^PSDRUG(DA,2),"^",1)']"" D DFNULL
46 Q
47DFNULL S OLDDF="",ZAPFLG=1
48 Q
49ZAPIT I $D(ZAPFLG),ZAPFLG=1,FLGNDF=1,OLDDF'=NEWDF D CKIV^PSSDEE1
50 Q
51APP W !!,"MARK THIS DRUG AND EDIT IT FOR: " D CHOOSE
52 Q
53CHOOSE I $D(^XUSEC("PSORPH",DUZ))!($D(^XUSEC("PSXCMOPMGR",DUZ))) W !,"O - Outpatient" S FLG1=1
54 I $D(^XUSEC("PSJU MGR",DUZ)) W !,"U - Unit Dose" S FLG2=1
55 I $D(^XUSEC("PSJI MGR",DUZ)) W !,"I - IV" S FLG3=1
56 I $D(^XUSEC("PSGWMGR",DUZ)) W !,"W - Ward Stock" S FLG4=1
57 I $D(^XUSEC("PSAMGR",DUZ))!($D(^XUSEC("PSA ORDERS",DUZ))) W !,"D - Drug Accountability" S FLG5=1
58 I $D(^XUSEC("PSDMGR",DUZ)) W !,"C - Controlled Substances" S FLG6=1
59 I $D(^XUSEC("PSORPH",DUZ)) W !,"X - Non-VA Med" S FLG7=1
60 I FLG1,FLG2,FLG3,FLG4,FLG5,FLG6 S FLAG=1
61 I FLAG W !,"A - ALL"
62 W !
63 I 'FLG1,'FLG2,'FLG3,'FLG4,'FLG5,'FLG6,'FLG7 W !,"You do not have the proper keys to continue. Sorry, this concludes your editing session.",! S FLGKY=1 K DIRUT,X Q
64 I FLGKY'=1 D
65 . K DIR S DIR(0)="FO^1:30"
66 . S DIR("A")="Enter your choice(s) separated by commas "
67 . F D ^DIR Q:$$CHECK($$UP^XLFSTR(X))
68 . S PSSANS=X,PSSANS=$$UP^XLFSTR(PSSANS) D BRANCH,BRANCH1
69 Q
70 ;
71CHECK(X) ; Validates Application Use response
72 N CHECK,I,C
73 S CHECK=1 I X=""!(Y["^")!($D(DIRUT)) Q CHECK
74 F I=1:1:$L(X,",") D
75 . S C=$P(X,",",I) W !?43,C," - "
76 . I C="O",FLG1 W "Outpatient" Q
77 . I C="U",FLG2 W "Unit Dose" Q
78 . I C="I",FLG3 W "IV" Q
79 . I C="W",FLG4 W "Ward Stock" Q
80 . I C="D",FLG5 W "Drug Accountability" Q
81 . I C="C",FLG6 W "Controlled Substances" Q
82 . I C="X",FLG7 W "Non-VA Med" Q
83 . W "Invalid Entry",$C(7) S CHECK=0
84 Q CHECK
85BRANCH D:PSSANS["O" OP D:PSSANS["U" UD D:PSSANS["I" IV D:PSSANS["W" WS
86 D:PSSANS["D" DACCT D:PSSANS["C" CS D:PSSANS["X" NVM
87 Q
88BRANCH1 I FLAG,PSSANS["A" D OP,UD,IV,WS,DACCT,CS,NVM
89 Q
90OP I FLG1 D
91 . W !,"** You are NOW editing OUTPATIENT fields. **"
92 . S PSIUDA=DA,PSIUX="O^Outpatient Pharmacy" D ^PSSGIU
93 . I %=1 D
94 . . S DIE="^PSDRUG(",DR="[PSSOP]" D ^DIE K DIR D OPEI,ASKCMOP
95 . . S X="PSOCLO1" X ^%ZOSF("TEST") I D ASKCLOZ S FLGOI=1
96 I FLG1 D CKCMOP
97 Q
98CKCMOP I $P($G(^PSDRUG(DISPDRG,2)),"^",3)'["O" S:$D(^PSDRUG(DISPDRG,3)) $P(^PSDRUG(DISPDRG,3),"^",1)=0 K:$D(^PSDRUG("AQ",DISPDRG)) ^PSDRUG("AQ",DISPDRG) S DA=DISPDRG D ^PSSREF
99 Q
100UD I FLG2 W !,"** You are NOW editing UNIT DOSE fields. **" S PSIUDA=DA,PSIUX="U^Unit Dose" D ^PSSGIU I %=1 S DIE="^PSDRUG(",DR="62.05;212.2" D ^DIE S DIE="^PSDRUG(",DR="212",DR(2,50.0212)=".01;1" D ^DIE S FLGOI=1
101 Q
102IV I FLG3 W !,"** You are NOW editing IV fields. **" S (PSIUDA,PSSDA)=DA,PSIUX="I^IV" D ^PSSGIU I %=1 D IV1 S FLGOI=1
103 Q
104IV1 K PSSIVOUT ;This variable controls the selection process loop.
105 W !,"Edit Additives or Solutions: " K DIR S DIR(0)="SO^A:ADDITIVES;S:SOLUTIONS;" D ^DIR Q:$D(DIRUT) S PSSASK=Y(0) D:PSSASK="ADDITIVES" ENA^PSSVIDRG D:PSSASK="SOLUTIONS" ENS^PSSVIDRG I '$D(PSSIVOUT) G IV1
106 K PSSIVOUT
107 Q
108WS I FLG4 W !,"** You are NOW editing WARD STOCK fields. **" S DIE="^PSDRUG(",DR="300;301;302" D ^DIE
109 Q
110DACCT I FLG5 W !,"** You are NOW editing DRUG ACCOUNTABILITY fields. **" S DIE="^PSDRUG(",DR="441" D ^DIE S DIE="^PSDRUG(",DR="9",DR(2,50.1)="1;2;400;401;402;403;404;405" D ^DIE
111 Q
112CS I FLG6 W !,"** You are NOW Marking/Unmarking for CONTROLLED SUBS. **" S PSIUDA=DA,PSIUX="N^Controlled Substances" D ^PSSGIU
113 Q
114NVM I FLG7 W !,"** You are NOW Marking/Unmarking for NON-VA MEDS. **" S PSIUDA=DA,PSIUX="X^Non-VA Med" D ^PSSGIU
115 Q
116ASKCMOP I $D(^XUSEC("PSXCMOPMGR",DUZ)) W !!,"Do you wish to mark to transmit to CMOP? " K DIR S DIR(0)="Y",DIR("?")="If you answer ""yes"", you will attempt to mark this drug to transmit to CMOP."
117 D ^DIR I "Nn"[X K X,Y,DIRUT Q
118 I "Yy"[X S PSXFL=0 D TEXT^PSSMARK H 7 N PSXUDA S (PSXUM,PSXUDA)=DA,PSXLOC=$P(^PSDRUG(DA,0),"^"),PSXGOOD=0,PSXF=0,PSXBT=0 D BLD^PSSMARK,PICK2^PSSMARK S DA=PSXUDA
119 Q
120ASKCLOZ W !!,"Do you wish to mark/unmark as a LAB MONITOR or CLOZAPINE DRUG? " K DIR S DIR(0)="Y",DIR("?")="If you answer ""yes"", you will have the opportunity to edit LAB MONITOR or CLOZAPINE fields."
121 D ^DIR I "Nn"[X K X,Y,DIRUT Q
122 I "Yy"[X S NFLAG=0 D MONCLOZ
123 Q
124MONCLOZ K PSSAST D FLASH W !,"Mark/Unmark for Lab Monitor or Clozapine: " K DIR S DIR(0)="S^L:LAB MONITOR;C:CLOZAPINE;" D ^DIR Q:$D(DIRUT) S PSSAST=Y(0) D:PSSAST="LAB MONITOR" ^PSSLAB D:PSSAST="CLOZAPINE" CLOZ
125 Q
126FLASH K LMFLAG,CLFALG,WHICH S WHICH=$P($G(^PSDRUG(DISPDRG,"CLOZ1")),"^"),LMFLAG=0,CLFLAG=0
127 I WHICH="PSOCLO1" S CLFLAG=1
128 I WHICH'="PSOCLO1" S:WHICH'="" LMFLAG=1
129 Q
130CLOZ Q:NFLAG Q:$D(DTOUT) Q:$D(DIRUT) Q:$D(DUOUT) W !,"** You are NOW editing CLOZAPINE fields. **" D ^PSSCLDRG
131 Q
132USE K PACK S PACK="" S:$P($G(^PSDRUG(DISPDRG,"PSG")),"^",2)]"" PACK="W" I $D(^PSDRUG(DISPDRG,2)) S PACK=PACK_$P(^PSDRUG(DISPDRG,2),"^",3)
133 I PACK'="" D
134 .W $C(7) N XX W !! F XX=1:1:79 W "*"
135 .W !,"This entry is marked for the following PHARMACY packages: "
136 .D USE1
137 Q
138USE1 W:PACK["O" !," Outpatient" W:PACK["U" !," Unit Dose" W:PACK["I" !," IV"
139 W:PACK["W" !," Ward Stock" W:PACK["D" !," Drug Accountability"
140 W:PACK["N" !," Controlled Substances" W:PACK["X" !," Non-VA Med"
141 W:'$D(PACK) !," NONE"
142 I PACK'["O",PACK'["U",PACK'["I",PACK'["W",PACK'["D",PACK'["N",PACK'["X" W !," NONE"
143 Q
144WR I ^XMB("NETNAME")'["CMOP-" W:OLDDF'="" !,"The dosage form has changed from "_OLDDF_" to "_NEWDF_" due to",!,"matching/rematching to NDF.",!,"You will need to rematch to Orderable Item.",!
145 Q
146PRIMDRG I $D(^PS(59.7,1,20)),$P(^PS(59.7,1,20),"^",1)=4!($P(^PS(59.7,1,20),"^",1)=4.5) I $D(^PSDRUG(DISPDRG,2)) S VAR=$P(^PSDRUG(DISPDRG,2),"^",3) I VAR["U"!(VAR["I") D PRIM1
147 Q
148PRIM1 W !!,"You need to match this drug to ""PRIMARY DRUG"" file as well.",! S DIE="^PSDRUG(",DR="64",DA=DISPDRG D ^DIE K VAR
149 Q
150MF I $P($G(^PS(59.7,1,80)),"^",2)>1 I $D(^PSDRUG(DISPDRG,2)) S PSSOR=$P(^PSDRUG(DISPDRG,2),"^",1) I PSSOR]"" D EN^PSSPOIDT(PSSOR),EN2^PSSHL1(PSSOR,"MUP")
151 Q
152MFA I $P($G(^PS(59.7,1,80)),"^",2)>1 S PSSOR=$P(^PS(52.6,ENTRY,0),"^",11),PSSDD=$P(^PS(52.6,ENTRY,0),"^",2) I PSSOR]"" D EN^PSSPOIDT(PSSOR),EN2^PSSHL1(PSSOR,"MUP") D MFDD
153 Q
154MFS I $P($G(^PS(59.7,1,80)),"^",2)>1 S PSSOR=$P(^PS(52.7,ENTRY,0),"^",11),PSSDD=$P(^PS(52.7,ENTRY,0),"^",2) I PSSOR]"" D EN^PSSPOIDT(PSSOR),EN2^PSSHL1(PSSOR,"MUP") D MFDD
155 Q
156MFDD I $D(^PSDRUG(PSSDD,2)) S PSSOR=$P(^PSDRUG(PSSDD,2),"^",1) I PSSOR]"" D EN^PSSPOIDT(PSSOR),EN2^PSSHL1(PSSOR,"MUP")
157 Q
158OPEI N PSDRUGND
159 S PSDRUGND=$G(^PSDRUG(DISPDRG,"ND"))
160 I PSDRUGND']"" Q
161 I $P(PSDRUGND,"^",3)']"",$P(PSDRUGND,"^",10)']"" Q
162 I $P(PSDRUGND,"^",10)]"" G OPEI1
163 I $P($G(^PSNDF(50.68,$P(PSDRUGND,"^",3),1)),"^",2)]"" G OPEI1
164 Q
165OPEI1 ;
166 S DIE="^PSDRUG(",DR="28",DA=DISPDRG
167 D ^DIE
168 Q
169DEA ;
170 I $P($G(^PSDRUG(DISPDRG,3)),"^")=1,($P(^PSDRUG(DISPDRG,0),"^",3)[1!($P(^(0),"^",3)[2)) D DSH
171 Q
172DSH W !!,"****************************************************************************"
173 W !,"This entry contains a ""1"" or a ""2"" in the ""DEA, SPECIAL HDLG""",!,"field, therefore this item has been UNMARKED for CMOP transmission."
174 W !,"****************************************************************************",! S $P(^PSDRUG(DISPDRG,3),"^")=0 K ^PSDRUG("AQ",DISPDRG) S DA=DISPDRG N % D ^PSSREF
175 Q
Note: See TracBrowser for help on using the repository browser.