source: fmts/trunk/p/C0XPT3.m@ 1613

Last change on this file since 1613 was 1613, checked in by Sam Habiel, 11 years ago

Changes I forgot to commit
File size: 10.0 KB
Line 
1C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT ;2013-02-22 3:38 PM
2 ;;1.0;FILEMAN TRIPLE STORE;;Jun 26,2012;Build 29
3 ;
4MEDS(G,DFN) ; Private Proc; Extract Medication Data from a Patient's Graph
5 ; G - Patient Graph, DFN - you should know this
6 K ^TMP($J,"MEDS")
7 D ONETYPE^C0XGET3($NA(^TMP($J,"MEDS")),G,"sp:Medication")
8 ;
9 ; For each medication (C0XI = COUNTER; S = Medication Node as Subject)
10 N C0XI,S F C0XI=0:0 S C0XI=$O(^TMP($J,"MEDS",C0XI)) Q:'C0XI S S=^(C0XI) DO MED1(G,S,DFN)
11 K ^TMP($J,"MEDS")
12 QUIT
13 ;
14MED1(G,S,DFN) ; Private Procedure; Process each medication in Graph.
15 ; G = Graph; S = Medication Description ID as subject.
16 ;
17 ; 1. Start Date; obtain and then conv to fileman format
18 N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,S,"sp:startDate") ; Duh! Start Date.
19 D
20 . N %DT,X,Y S X=STARTDT D ^%DT S STARTDT=Y ; New stack level for variables.
21 ;
22 ;DEBUG.ASSERT that STARTDT is greater than 1900
23 I STARTDT'>2000000 S $EC=",U1,"
24 ;
25 ; 2. Frequency
26 N FVALUE S FVALUE=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:value")
27 N FUNIT S FUNIT=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:unit")
28 ;
29 ; 3. Dose Quantity
30 ; Get value, get unit and strip the braces out.
31 N DOSE S DOSE=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:value")
32 N DUNIT S DUNIT=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:unit"),DUNIT=$TR(DUNIT,"{}")
33 ;
34 ; 4. Instructions
35 N INST S INST=$$GSPO1^C0XGET3(G,S,"sp:instructions")
36 ;
37 ; 5. Drug Name and Code
38 N RXN S RXN=$$GSPO1^C0XGET3(G,S,"sp:drugName.sp:code"),RXN=$P(RXN,"/",$L(RXN,"/")) ; RxNorm Code
39 N DN S DN=$$GSPO1^C0XGET3(G,S,"sp:drugName.dcterms:title") ; Drug Name
40 ;
41 W S," ",FVALUE_FUNIT," ",DOSE," ",DUNIT," ",INST," ",DN,!
42 ;
43 ; 6. Get Fill Dates
44 N FULF ; Fulfillments
45 D GSPO^C0XGET3($NA(FULF),G,S,"sp:fulfillment")
46 ;
47 N FILLS ; Fills array. Contains every time a drug was dispensed.
48 N FILL S FILL="" F S FILL=$O(FULF(FILL)) Q:FILL="" D
49 . N S S S=FULF(FILL) ; New subject; subsumes above one in this loop
50 . ;
51 . ; Dispense Date
52 . N FILLDATE S FILLDATE=$$GSPO1^C0XGET3(G,S,"dcterms:date")
53 . D
54 . . N %DT,X,Y S X=FILLDATE D ^%DT S FILLDATE=Y
55 . I FILLDATE<2000000 W $EC=",U1," ; Converstion error
56 . ;
57 . S FILLS(RXN,FILLDATE,"sp:dispenseDaysSupply")=$$GSPO1^C0XGET3(G,S,"sp:dispenseDaysSupply") ; Self Explanatory?
58 . ;
59 . ; Get quantity value and unit
60 . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:value")=$$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:value")
61 . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
62 ;
63 ; ZWRITE:$D(FILLS) FILLS
64 ;
65 D
66 . N FILDT,FILQTY,FILDAYS
67 . S FILDT=$O(FILLS(RXN,""))
68 . I FILDT S FILQTY=FILLS(RXN,FILDT,"sp:quantityDispensed.sp:value"),FILDAYS=FILLS(RXN,FILDT,"sp:dispenseDaysSupply")
69 . E S (FILQTY,FILDAYS)=""
70 . D PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,.FILLS)
71 ;
72 QUIT
73 ;
74PREP(DFN,RXN,INST,FILDT,FILQTY,FILDAYS,FILLS) ;
75 ; TODO:
76 ; 1. Resolve medication
77 ; 2. Figure out what to do with meds that have no fill history (omit?)
78 ; 3. Don't file a med twice! Check ^PXRMINDX to make sure it aint there first
79 ; 4. Compute the number of refills for original number so that remaining refills aren't displayed as negative
80 ; 5. Original fill doesn't have a dispense comment
81 ; 6. Coded sig (FVALUE, FUNIT, DOSE, DUNIT)
82 ; 7. Fill label log section of Rx? Maybe not.
83 N ORZPT,PSODFN S (ORZPT,PSODFN)=DFN ;"" ;POINTER TO PATIENT FILE (#2)
84 N PNTSTAT S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
85 N PROV S PROV=$$NP^C0XPT0() ;NEW PERSON FILE (#200)
86 N PSODRUG S PSODRUG=94558 ;POINTER TO DRUG FILE (#50) ; TODO: HARDCODED; RXN
87 S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3)
88 N QTY S QTY=FILQTY ; NUMBER ;0;7 NUMBER (Required)
89 N DAYSUPLY S DAYSUPLY=FILDAYS ;NUMBER ; 0;8 NUMBER (Required);
90 N REFIL S REFIL=0 ;NUMBER ; 0;9 NUMBER (Required)
91 N ORDCONV S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
92 N COPIES S COPIES=1 ;NUMBER
93 N MLWIND S MLWIND="W" ; Mail/Window: 'M' or 'W'
94 N ENTERBY S ENTERBY=.5 ;NEW PERSON FILE (#200) - POSTMASTER
95 N UNITPRICE S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER
96 N PSOSITE S PSOSITE=$O(^PS(59,0)) ; OUTPATIENT SITE FILE (#59); get first one
97 N %,LOGDT D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required)
98 N FILLDT S FILLDT=FILDT ;DATE; First fill date from our data.
99 N ISSDT S ISSDT=FILLDT ;DATE
100 N DISPDT S DISPDT=ISSDT ;DATE
101 N X D
102 . N X1,X2
103 . S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180
104 N EXPIRDT S EXPIRDT=X ;
105 N PORDITM S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7)
106 N STATUS S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE;
107 N TRNSTYP S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1)
108 N LDISPDT S LDISPDT=FILLDT ; 3;1 DATE
109 N REASON S REASON="E" ;Activity log ; SET ([E]dit)
110 N INIT S INIT=.5 ;NEW PERSON FILE (#200)
111 N COM S COM="Oupatient medication order." ;TEXT
112 N SIG S SIG=INST ;#51,.01
113 ;
114CREATE ; fall through
115 ;
116 N PSONEW
117 D AUTO^PSONRXN ;RX auto number
118 I $G(PSONEW("RX #"))="" S $EC=",U1," ; Auto-numbering not turned on!
119 N RXNUM S RXNUM=PSONEW("RX #") ; Rx Number, again...
120 ;
121 L +^PSRX(0):0 ; Lock zero node while we get the record.
122 N PSOIEN S PSOIEN=$P($G(^PSRX(0)),"^",3)+1 ; Next available IEN
123 I $D(^PSRX(PSOIEN)) S $EC=",U1," ; Next number not available. File issue.
124 S $P(^PSRX(0),U,3)=PSOIEN ; Reset next available number.
125 S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required)
126 L +^PSRX(PSOIEN):0 ; Lock record node
127 L -^PSRX(0) ; Unlock zero node, we now got it
128 ;
129 S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required)
130 S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2)
131 S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53)
132 S $P(^PSRX(PSOIEN,0),"^",4)=PROV ;NEW PERSON FILE (#200)
133 S $P(^PSRX(PSOIEN,0),"^",5)="" ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44)
134 S $P(^PSRX(PSOIEN,0),"^",6)=PSODRUG ;POINTER TO DRUG FILE (#50)
135 S $P(^PSRX(PSOIEN,0),"^",7)=QTY ;NUMBER ;0;7 NUMBER (Required)
136 S $P(^PSRX(PSOIEN,0),"^",8)=DAYSUPLY ;NUMBER ; 0;8 NUMBER (Required)
137 S $P(^PSRX(PSOIEN,0),"^",9)=REFIL ;NUMBER ; 0;9 NUMBER (Required)
138 S $P(^PSRX(PSOIEN,0),"^",11)=MLWIND ;'M' or 'W'
139 S $P(^PSRX(PSOIEN,0),"^",16)=ENTERBY ;NEW PERSON FILE (#200)
140 S $P(^PSRX(PSOIEN,0),"^",17)=UNITPRICE ;NUMBER
141 S $P(^PSRX(PSOIEN,0),"^",18)=COPIES ;COPIES
142 S $P(^PSRX(PSOIEN,0),"^",19)=ORDCONV ;ORDER CONVERTED 0;19 SET ['1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;]
143 ;
144 S $P(^PSRX(PSOIEN,2),"^",1)=LOGDT ;LOGIN DATE ; 2;1 DATE (Required)
145 S $P(^PSRX(PSOIEN,2),"^",2)=FILLDT ;FILL DATE
146 ;S $P(^PSRX(PSOIEN,2),"^",3)=PHARMACIST ; "" ; PHARMACIST ;2;3 POINTER TO NEW PERSON FILE (#200)
147 ;S $P(^PSRX(PSOIEN,2),"^",4)="" ; LOT # 2;4 FREE TEXT
148 S $P(^PSRX(PSOIEN,2),"^",5)=DISPDT ; DISPENSED DATE 2;5 DATE (Required)
149 S $P(^PSRX(PSOIEN,2),"^",6)=EXPIRDT ;"" ; EXPIRATION DATE
150 S $P(^PSRX(PSOIEN,2),"^",9)=PSOSITE ;2;9 POINTER TO OUTPATIENT SITE FILE (#59)
151 ;
152 S $P(^PSRX(PSOIEN,3),U,1)=DISPDT ;LAST DISPENSED DATE 3;1 DATE
153 ;
154 N C0XFILL S C0XFILL=""
155 N C0XREFCT S C0XREFCT=0
156 F S C0XFILL=$O(FILLS(RXN,C0XFILL)) Q:C0XFILL="" D
157 . S ^PSRX(PSOIEN,"A",0)="^52.3DA"_U_(C0XREFCT+1)_U_(C0XREFCT+1)
158 . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",1)=LOGDT ;DATE
159 . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",2)="N" ;SET ; Dispensed using external interface
160 . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",3)=INIT ;NEW PERSON FILE (#200)
161 . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",4)=0 ;NUMBER - RX REFERENCE
162 . S $P(^PSRX(PSOIEN,"A",C0XREFCT+1,0),"^",5)="Imported from Smart" ;TEXT
163 . ;
164 . Q:C0XFILL=FILDT ; Don't add refill data for first fill!
165 . ;
166 . ; Increment counter
167 . S C0XREFCT=C0XREFCT+1
168 . ;
169 . S ^PSRX(PSOIEN,1,0)="^52.1DA"_U_(C0XREFCT)_U_(C0XREFCT)
170 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",1)=C0XFILL ; REFILL DATE [D]
171 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",2)=MLWIND ; MAIL/WINDOW [RS]
172 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",3)="Imported from Smart" ; REMARKS [F]
173 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",4)=FILLS(RXN,C0XFILL,"sp:quantityDispensed.sp:value") ; QTY [RNJ12,2X]
174 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",5)=.5 ; PHARMACIST NAME [*P200']
175 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",6)="" ; LOT [F]
176 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",7)=.5 ; CLERK CODE [RP200']
177 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",8)="" ; LOGIN DATE [D]
178 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",9)="" ; DIVISION [RP59']
179 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",17)=PROV ; PROVIDER [R*P200X'I]
180 . S $P(^PSRX(PSOIEN,1,C0XREFCT,0),"^",19)=C0XFILL ; DISPENSED DATE [RD]
181 ;
182 S ^PSRX(PSOIEN,"OR1")=PORDITM ;PHARMACY ORDERABLE ITEM FILE (#50.7)
183 ;
184 S $P(^PSRX(PSOIEN,"POE"),"^",1)=1 ; POE RX POE;1 SET ['1' FOR YES;]
185 ;
186 S $P(^PSRX(PSOIEN,"SIG"),"^",1)=SIG ;SIG;1 FREE TEXT (Required) medication instruction DIC(51)
187 S $P(^PSRX(PSOIEN,"SIG"),"^",2)=0 ;OERR SIG (SET: 0 for NO; 1 for YES)
188 ;
189 S $P(^PSRX(PSOIEN,"STA"),"^",1)=STATUS ;STA;1 SET (Required) ; '0' FOR ACTIVE;
190 ;
191 ;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE IB ACTION TYPE FILE (#350.1)
192 S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER
193 D OERR(PSOIEN),F55,F52(PSOIEN),F525
194 L -PSRX(PSOIEN) ; Unlock record
195 Q
196 ;
197OERR(PSOIEN) ;UPDATES OR1 NODE
198 ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL
199 S $P(^PSRX(PSOIEN,"OR1"),"^",2)=""
200 N PSXRXIEN,STAT,PSSTAT,COMM,PSNOO
201 S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W"
202 D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO)
203 QUIT
204F55 ; - File data into ^PS(55)
205 ;S PSODFN=DFN
206 S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^"
207 F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1))
208 S ^PS(55,PSODFN,"P",PSOX1,0)=PSOIEN,$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1)
209 S:$P($G(^PSRX(PSOIEN,2)),"^",6) ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""
210 K PSOX1
211 Q
212F52(PSOIEN) ;; - Re-indexing file 52 entry
213 N DIK,DA S DIK="^PSRX(",DA=PSOIEN D IX1^DIK K DIK
214 Q
215 ;
216F525 ;UPDATE SUSPENSE FILE
217 Q:$G(^PSRX(PSOIEN,"STA"))'=5
218 S DA=PSOIEN,X=PSOIEN,FDT=$P($G(^PSRX(PSOIEN,2)),"^",2),TYPE=$P($G(^PSRX(PSOIEN,0)),"^",11)
219 S DIC="^PS(52.5,",DIC(0)="L",DLAYGO=52.5,DIC("DR")=".02///"_FDT_";.03////"_$P(^PSRX(PSOIEN,0),"^",2)_";.04////"_TYPE_";.05///0;.06////"_DIV_";2///0" K DD,D0 D FILE^DICN K DD,D0
220 Q
221 ;
Note: See TracBrowser for help on using the repository browser.