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

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

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