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

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

code to extract fulfillments of medications (# of times it's dispensed)
File size: 8.0 KB
Line 
1C0XPT3 ;ISI/MLS,VEN/SMH -- MEDS IMPORT;2013-02-20 3:15 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 (I = COUNTER; S = Medication Node as Subject)
10 N I,S F I=0:0 S I=$O(^TMP($J,"MEDS",I)) Q:'I S S=^(I) DO MED1(G,S)
11 ;
12 K ^TMP($J,"MEDS")
13 QUIT
14 ;
15MED1(G,S) ; Private Procedure; Process each medication in Graph.
16 ; G = Graph; S = Medication Description ID as subject.
17 ;
18 ; 1. Start Date; obtain and then conv to fileman format
19 N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,S,"sp:startDate") ; Duh! Start Date.
20 D
21 . N %DT,X,Y S X=STARTDT D ^%DT S STARTDT=Y ; New stack level for variables.
22 ;
23 ;DEBUG.ASSERT that STARTDT is greater than 1900
24 I STARTDT'>2000000 S $EC=",U1,"
25 ;
26 ; 2. Frequency
27 N FVALUE S FVALUE=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:value")
28 N FUNIT S FUNIT=$$GSPO1^C0XGET3(G,S,"sp:frequency.sp:unit")
29 ;
30 ; 3. Dose Quantity
31 ; Get value, get unit and strip the braces out.
32 N DOSE S DOSE=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:value")
33 N DUNIT S DUNIT=$$GSPO1^C0XGET3(G,S,"sp:quantity.sp:unit"),DUNIT=$TR(DUNIT,"{}")
34 ;
35 ; 4. Instructions
36 N INST S INST=$$GSPO1^C0XGET3(G,S,"sp:instructions")
37 ;
38 ; 5. Drug Name and Code
39 N RXN S RXN=$$GSPO1^C0XGET3(G,S,"sp:drugName.sp:code"),RXN=$P(RXN,"/",$L(RXN,"/")) ; RxNorm Code
40 N DN S DN=$$GSPO1^C0XGET3(G,S,"sp:drugName.dcterms:title") ; Drug Name
41 ;
42 W S," ",FVALUE_FUNIT," ",DOSE," ",DUNIT," ",INST," ",DN,!
43 ;
44 ; 6. Get Fill Dates
45 N FULF ; Fulfillments
46 D GSPO^C0XGET3($NA(FULF),G,S,"sp:fulfillment")
47 ;
48 N FILLS ; Fills array. Contains every time a drug was dispensed.
49 N FILL S FILL="" F S FILL=$O(FULF(FILL)) Q:FILL="" D
50 . N S S S=FULF(FILL) ; New subject; subsumes above one in this loop
51 . ;
52 . ; Dispense Date
53 . N FILLDATE S FILLDATE=$$GSPO1^C0XGET3(G,S,"dcterms:date")
54 . D
55 . . N %DT,X,Y S X=FILLDATE D ^%DT S FILLDATE=Y
56 . I FILLDATE<2000000 W $EC=",U1," ; Converstion error
57 . ;
58 . S FILLS(RXN,FILLDATE,"sp:dispenseDaysSupply")=$$GSPO1^C0XGET3(G,S,"sp:dispenseDaysSupply") ; Self Explanatory?
59 . ;
60 . ; Get quantity value and unit
61 . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:value")=$$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:value")
62 . S FILLS(RXN,FILLDATE,"sp:quantityDispensed.sp:unit")=$TR($$GSPO1^C0XGET3(G,S,"sp:quantityDispensed.sp:unit"),"{}")
63 ;
64 ZWRITE:$D(FILLS) FILLS
65 QUIT
66 ;
67MED(ISIMISC) ;Create med order entry
68 ; Input - ISIMISC(ARRAY)
69 ; Format: ISIMISC(PARAM)=VALUE
70 ; eg: ISIMISC("DFN")=123455
71 ;
72 ; Output - ISIRC [return code]
73 ; ISIRESUL(0)=1 [if successful]
74 ; ISIRESUL(1)=PSOIEN [if successful]
75 ;
76 N ORZPT,PNTSTAT,PROV,PSODRUG,QTY,DAYSUPLY,REFIL,ORDCONV,RXNUM,PSOIEN
77 N COPIES,MLWIND,ENTERBY,UNITPRICE,PSOSITE,LOGDT,DISPDT,ISSDT,SIG
78 N X1,X2,EXPIRDT,STATUS,TRNSTYP,LDISPDT,FILLDT,PORDITM,REASON
79 N INIT,COM
80 ;
81 S ISIRC=1
82 D PREP
83 I +ISIRC<0 Q ISIRC
84 D CREATE
85 I +ISIRC<0 Q ISIRC
86 S ISIRESUL(0)=1
87 S ISIRESUL(1)=PSOIEN
88 Q ISIRC
89 ;
90PREP ;
91 ;
92 N EXIT
93 S ORZPT=ISIMISC("DFN") ;"" ;POINTER TO PATIENT FILE (#2)
94 S PSODFN=ORZPT
95 S PNTSTAT=20 ; NON-VA ;RX PATIENT STATUS FILE (#53)
96 S PROV=ISIMISC("PROV") ;NEW PERSON FILE (#200)
97 S PSODRUG=ISIMISC("DRUG") ;"" ;POINTER TO DRUG FILE (#50)
98 S PSODRUG("DEA")=$P($G(^PSDRUG(PSODRUG,0)),U,3)
99 S QTY=ISIMISC("QTY") ;NUMBER ;0;7 NUMBER (Required)
100 S DAYSUPLY=ISIMISC("SUPPLY") ;NUMBER ; 0;8 NUMBER (Required)
101 S REFIL=ISIMISC("REFILL") ;NUMBER ; 0;9 NUMBER (Required)
102 S ORDCONV=1 ;'1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;
103 S COPIES=1 ;NUMBER
104 S MLWIND="W" ;'M' or 'W'
105 S ENTERBY=DUZ ;NEW PERSON FILE (#200)
106 S UNITPRICE=$P(^PSDRUG(PSODRUG,660),U,6) ;0.009 ;"" ;NUMBER
107 S PSOSITE=ISIMISC("PSOSITE") ; OUTPATIENT SITE FILE (#59)
108 D NOW^%DTC S LOGDT=% ;LOGIN DATE ; 2;1 DATE (Required)
109 S FILLDT=ISIMISC("DATE") ;DATE
110 S ISSDT=FILLDT ;DATE
111 S DISPDT=ISSDT ;DATE
112 S X1=DISPDT,X2=180 D C^%DTC ;Default expiration of T+180
113 S EXPIRDT=X ;
114 S PORDITM=$P($G(^PSDRUG(PSODRUG,2)),U,1) ;PHARMACY ORDERABLE ITEM FILE (#50.7)
115 S STATUS=0 ;STA;1 SET (Required) ; '0' FOR ACTIVE;
116 S TRNSTYP=1 ; IB ACTION TYPE FILE (#350.1)
117 S LDISPDT=FILLDT ; 3;1 DATE
118 S REASON="E" ;Activity log ; SET ([E]dit)
119 S INIT=DUZ ;NEW PERSON FILE (#200)
120 S COM="Oupatient medication order." ;TEXT
121 S SIG=ISIMISC("SIG") ;#51,.01
122 Q
123 ;
124CREATE ;
125 D AUTO^PSONRXN ;RX auto number
126 I $G(PSONEW("RX #"))="" S ISIRC="-1^RX Auto number error." Q
127 S RXNUM=PSONEW("RX #")
128 ;
129 S PSOIEN=$P($G(^PSRX(0)),"^",3)+1
130 I $D(^PSRX(PSOIEN)) S ISIRC="-1^Problem with PSRX (#50) internal counter" Q ;pointer error
131 S $P(^PSRX(0),U,3)=PSOIEN
132 ;
133 S $P(^PSRX(PSOIEN,0),"^",1)=RXNUM ; 0;1 FREE TEXT (Required)
134 S $P(^PSRX(PSOIEN,0),"^",13)=ISSDT ; 0;13 DATE (Required)
135 S $P(^PSRX(PSOIEN,0),"^",2)=ORZPT ;POINTER TO PATIENT FILE (#2)
136 S $P(^PSRX(PSOIEN,0),"^",3)=PNTSTAT ;RX PATIENT STATUS FILE (#53)
137 S $P(^PSRX(PSOIEN,0),"^",4)=PROV ;NEW PERSON FILE (#200)
138 S $P(^PSRX(PSOIEN,0),"^",5)="" ; Outpatient ; LOC ;HOSPITAL LOCATION FILE (#44)
139 S $P(^PSRX(PSOIEN,0),"^",6)=PSODRUG ;POINTER TO DRUG FILE (#50)
140 S $P(^PSRX(PSOIEN,0),"^",7)=QTY ;NUMBER ;0;7 NUMBER (Required)
141 S $P(^PSRX(PSOIEN,0),"^",8)=DAYSUPLY ;NUMBER ; 0;8 NUMBER (Required)
142 S $P(^PSRX(PSOIEN,0),"^",9)=REFIL ;NUMBER ; 0;9 NUMBER (Required)
143 S $P(^PSRX(PSOIEN,0),"^",11)=MLWIND ;'M' or 'W'
144 S $P(^PSRX(PSOIEN,0),"^",16)=ENTERBY ;NEW PERSON FILE (#200)
145 S $P(^PSRX(PSOIEN,0),"^",17)=UNITPRICE ;NUMBER
146 S $P(^PSRX(PSOIEN,0),"^",18)=COPIES ;COPIES
147 S $P(^PSRX(PSOIEN,0),"^",19)=ORDCONV ;ORDER CONVERTED 0;19 SET ['1' FOR ORDER CONVERTED;'2' FOR EXPIRATION TO CPRS;]
148 ;
149 S $P(^PSRX(PSOIEN,2),"^",1)=LOGDT ;LOGIN DATE ; 2;1 DATE (Required)
150 S $P(^PSRX(PSOIEN,2),"^",2)=FILLDT ;FILL DATE
151 ;S $P(^PSRX(PSOIEN,2),"^",3)=PHARMACIST ; "" ; PHARMACIST ;2;3 POINTER TO NEW PERSON FILE (#200)
152 ;S $P(^PSRX(PSOIEN,2),"^",4)="" ; LOT # 2;4 FREE TEXT
153 S $P(^PSRX(PSOIEN,2),"^",5)=DISPDT ; DISPENSED DATE 2;5 DATE (Required)
154 S $P(^PSRX(PSOIEN,2),"^",6)=EXPIRDT ;"" ; EXPIRATION DATE
155 S $P(^PSRX(PSOIEN,2),"^",9)=PSOSITE ;2;9 POINTER TO OUTPATIENT SITE FILE (#59)
156 ;
157 S $P(^PSRX(PSOIEN,3),U,1)=DISPDT ;LAST DISPENSED DATE 3;1 DATE
158 ;
159 S ^PSRX(PSOIEN,"A",0)="^52.3DA^1^1"
160 S $P(^PSRX(PSOIEN,"A",1,0),"^",1)=LOGDT ;DATE
161 S $P(^PSRX(PSOIEN,"A",1,0),"^",2)=REASON ;SET
162 S $P(^PSRX(PSOIEN,"A",1,0),"^",3)=INIT ;NEW PERSON FILE (#200)
163 S $P(^PSRX(PSOIEN,"A",1,0),"^",4)=0 ;NUMBER - RX REFERENCE
164 S $P(^PSRX(PSOIEN,"A",1,0),"^",5)="ISI automated entry." ;TEXT
165 ;
166 S ^PSRX(PSOIEN,"OR1")=PORDITM ;PHARMACY ORDERABLE ITEM FILE (#50.7)
167 ;
168 S $P(^PSRX(PSOIEN,"POE"),"^",1)=1 ; POE RX POE;1 SET ['1' FOR YES;]
169 ;
170 S $P(^PSRX(PSOIEN,"SIG"),"^",1)=SIG ;SIG;1 FREE TEXT (Required) medication instruction DIC(51)
171 S $P(^PSRX(PSOIEN,"SIG"),"^",2)=0 ;OERR SIG (SET: 0 for NO; 1 for YES)
172 ;
173 S $P(^PSRX(PSOIEN,"STA"),"^",1)=STATUS ;STA;1 SET (Required) ; '0' FOR ACTIVE;
174 ;
175 ;S ^PSRX(PSOIEN,"IB")=TRNSTYP ;COPAY TRANSACTION TYPE IB ACTION TYPE FILE (#350.1)
176 S ^PSRX(PSOIEN,"TYPE")=0 ;TYPE OF RX TYPE;1 NUMBER
177 D OERR,F55,F52,F525
178 Q
179 ;
180OERR ;UPDATES OR1 NODE
181 ;THE SECOND PIECE IS KILLED BEFORE MAKING THE CALL
182 S $P(^PSRX(PSOIEN,"OR1"),"^",2)=""
183 S PSXRXIEN=PSOIEN,STAT="SN",PSSTAT="CM",COMM="",PSNOO="W"
184 D EN^PSOHLSN1(PSXRXIEN,STAT,PSSTAT,COMM,PSNOO)
185F55 ; - File data into ^PS(55)
186 ;S PSODFN=DFN
187 S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^"
188 F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1))
189 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)
190 S ^PS(55,PSODFN,"P","A",$P($G(^PSRX(PSOIEN,2)),"^",6),PSOIEN)=""
191 K PSOX1
192 Q
193F52 ;; - Re-indexing file 52 entry
194 K DIK,DA S DIK="^PSRX(",DA=PSOIEN D IX1^DIK K DIK
195 Q
196 ;
197F525 ;UPDATE SUSPENSE FILE
198 Q:$G(^PSRX(PSOIEN,"STA"))'=5
199 S DA=PSOIEN,X=PSOIEN,FDT=$P($G(^PSRX(PSOIEN,2)),"^",2),TYPE=$P($G(^PSRX(PSOIEN,0)),"^",11)
200 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
201 Q
202 ;
Note: See TracBrowser for help on using the repository browser.