source: fmts/trunk/p/C0XPT4.m@ 1700

Last change on this file since 1700 was 1622, checked in by Sam Habiel, 12 years ago

Mostly comment changes; minor changes here and there. Encounters now work correctly.
File size: 6.0 KB
Line 
1C0XPT4 ; VEN/SMH - Encounter Processing;2013-05-06 9:42 AM
2 ;;1.0;FILEMAN TRIPLE STORE;
3 ; (c) 2013 Sam Habiel
4 ; Currently proprietary code. Stay out!!!
5 ;
6ENC(G,DFN) ; Extract and then process encounters; PEP
7 ;
8 ; ---PRIVATE TO SAM---
9 D DELALL(DFN) ; Delete all Encounters period...
10 ; ---PRIVATE TO SAM---
11 ;
12 K ^TMP($J,"ENC") ; data location
13 D ONETYPE^C0XGET3($NA(^TMP($J,"ENC")),G,"sp:Encounter") ; extract encounters
14 W "Encounters: ",!
15 N S F S=0:0 S S=$O(^TMP($J,"ENC",S)) Q:S="" W S," ",^(S) D W !
16 . N STARTDATE S STARTDATE=$$GSPO1^C0XGET3(G,S,"sp:startDate")
17 . S STARTDATE=$$FMDATE(STARTDATE)
18 . W " ",STARTDATE
19 . D ONEENC(STARTDATE,DFN) ; File One Encounter Private API
20 K ^TMP($J,"ENC") ; data location
21 QUIT
22 ;
23 ;
24FMDATE(STARTDATE) ; Internal to fix start date
25 ; Replace 00:00:00 with 00:00:01. Fileman doesn't understand null time for midnight except as .24 for yesterday
26 ; and replace the space with an @ because Fileman needs that to figure out that time comes next after date
27 I STARTDATE["00:00:00" S $E(STARTDATE,$L(STARTDATE))=1
28 S STARTDATE=$P(STARTDATE," ")_"@"_$P(STARTDATE," ",2)
29 ; Conv to Fileman
30 D
31 . N X,Y,%DT
32 . S X=STARTDATE,%DT="TS" D ^%DT
33 . S STARTDATE=Y
34 Q STARTDATE
35 ;
36 ;
37ONEENC(DATE,DFN,FTLOC,COMMENT) ; Private Proc; One Encounter Filing into the VISIT file
38 ; Input:
39 ; - DATE: FM DATE of VISIT (Scalar) - Required
40 ; - DFN (Scalar) - Required
41 ; - FTLOC: (Scalar) Free Text Location - Optional. Defaults to SMART LOCATION
42 ; - COMMENT: (Scalar) Free Text Comment - Optional. Defaults to Imported from Smart
43 ; Output:
44 ; - Creates V file entries for encounter
45 ;
46 ; Handle required and optional variables...
47 N X F X="DATE","DFN" I '$D(@X) S $EC=",U1," ; Check for the present of required input variables
48 S FTLOC=$G(FTLOC,"SMART LOCATION") ; Get default if not supplied
49 S COMMENT=$G(COMMENT,"Imported from Smart") ; ditto
50 ;
51 ; Get package name
52 N PKG S PKG=$O(^DIC(9.4,"B","FILEMAN TRIPLE STORE",0)) I 'PKG S $EC=",U1,"
53 ;
54 ; Source
55 N SRC S SRC="FMTS PATIENT IMPORTER"
56 ;
57 ; Input Array for $$DATA2PCE
58 N C0XDATA
59 S C0XDATA("ENCOUNTER",1,"ENC D/T")=DATE
60 S C0XDATA("ENCOUNTER",1,"PATIENT")=DFN
61 S C0XDATA("ENCOUNTER",1,"HOS LOC")=$$HL^C0XPT0()
62 S C0XDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A" ; Ambulatory
63 S C0XDATA("ENCOUNTER",1,"OUTSIDE LOCATION")=FTLOC
64 S C0XDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P" ; Primary
65 S C0XDATA("ENCOUNTER",1,"COMMENT")=COMMENT
66 S C0XDATA("PROVIDER",1,"NAME")=$$NP^C0XPT0()
67 ; Diangosis and procedure necessary so visit will show up in ^SDE.
68 ; We invent them here.
69 S C0XDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
70 S C0XDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99212",0))
71 S C0XDATA("PROCEDURE",1,"QTY")=1
72 ;
73 N C0XVISIT,C0XERR ; Visit, Error
74 N XQORMUTE S XQORMUTE=1 ; Unwinder: Shut the hell up. Don't execute disabled protocols rather than whining about them.
75 N OK S OK=$$DATA2PCE^PXAPI($NA(C0XDATA),PKG,SRC,.C0XVISIT,,,.C0XERR)
76 I OK<1 S $EC=",U1," ; Invalid value is -1
77 QUIT
78 ;
79 ;
80DELALL(DFN) ; Private Proc; Delete ALL ALL ALL encounter information for the patient.
81 ; BE VERY CAREFUL USING THIS...
82 ; Walk through the C X-Ref for this patient
83 N I S I=9000010 ; Hit the VISIT file LAST as V files point to it!
84 N DIK,DA
85 F S I=$O(^DIC(I)) Q:I'<9000011 D ; For each V File...
86 . N OR S OR=$$ROOT^DILFD(I,"",0) ; Open Root for ^DIK
87 . N CR S CR=$$ROOT^DILFD(I,"",1) ; Closed Root for @CR@("C")
88 . ; W OR," ",CR ; DEBUG
89 . ; W ": " ; DEBUG
90 . S DIK=OR ; File root to kill
91 . N J S J="" F S J=$O(@CR@("C",DFN,J)) Q:'J S DA=J D ^DIK ; each entry to kill
92 . ; W ! ; DEBUG
93 ;
94 ; Visit file
95 N I S I=""
96 S DIK="^AUPNVSIT("
97 F S I=$O(^AUPNVSIT("C",DFN,I)) Q:'I S DA=I D ^DIK ;ditto
98 ;
99 ; Outpatient encounter file
100 N I S I=""
101 ; W "SCE: " ; Debug
102 S DIK="^SCE(" ; ditto
103 F S I=$O(^SCE("C",DFN,I)) Q:'I S DA=I D ^DIK ; ditto
104 QUIT
105 ;
106 ;
107TEST ; Test creating an encounter using DATA2PCE^PXAPI
108 ; Thank you Kevin Muldrum!
109 ; This code comes from EDP aka EDIS.
110 N DFN S DFN=188 ; One of those Ducks
111 ;S LOC=$$GET^XPAR(DUZ(2)_";DIC(4,","EDPF LOCATION")
112 N LOC S LOC=2 ; DR OFFICE
113 N EDPKG,EDPSRC,OK,EDPDATA,EDPVISIT,ERR
114 S EDPKG=$O(^DIC(9.4,"B","EMERGENCY DEPARTMENT",0))
115 S EDPSRC="EDP TRACKING LOG"
116 S EDPDATA("ENCOUNTER",1,"PATIENT")=DFN
117 S EDPDATA("ENCOUNTER",1,"HOS LOC")=LOC
118 S EDPDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A"
119 S EDPDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
120 S EDPDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
121 ;
122 S EDPDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
123 S EDPDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99201",0))
124 S EDPDATA("PROCEDURE",1,"QTY")=1
125 S EDPDATA("PROVIDER",1,"NAME")=23
126 ;
127 S OK=$$DATA2PCE^PXAPI("EDPDATA",EDPKG,EDPSRC,.EDPVISIT,23,1,.ERR)
128 W OK
129 Q
130 ;
131 ;
132TEST2 ; Test creating an historical event
133 ;
134 N DFN S DFN=188
135 N LOC S LOC=1
136 N PKG S PKG=$O(^DIC(9.4,"B","FILEMAN TRIPLE STORE",0))
137 I 'PKG S $EC=",U1,"
138 ;
139 N SRC S SRC="FMTS TEST"
140 ;
141 N C0XDATA
142 S C0XDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
143 S C0XDATA("ENCOUNTER",1,"PATIENT")=DFN
144 S C0XDATA("ENCOUNTER",1,"SERVICE CATEGORY")="E" ; EVENT
145 S C0XDATA("ENCOUNTER",1,"OUTSIDE LOCATION")="FROM THE WIDE WORLD"
146 S C0XDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P" ; Primary
147 S C0XDATA("ENCOUNTER",1,"COMMENT")="Testing"
148 ;
149 N OK,C0XVISIT,ERR
150 S OK=$$DATA2PCE^PXAPI($NA(C0XDATA),PKG,SRC,.C0XVISIT,,,.ERR)
151 QUIT
152TEST3 ; Test creating a real event
153 ;
154 N DFN S DFN=190
155 N LOC S LOC=$$HL^C0XPT0()
156 N PKG S PKG=$O(^DIC(9.4,"B","FILEMAN TRIPLE STORE",0))
157 I 'PKG S $EC=",U1,"
158 ;
159 N SRC S SRC="FMTS TEST"
160 ;
161 N C0XDATA
162 S C0XDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
163 S C0XDATA("ENCOUNTER",1,"PATIENT")=DFN
164 S C0XDATA("ENCOUNTER",1,"HOS LOC")=LOC
165 S C0XDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A" ; Ambulatory
166 S C0XDATA("ENCOUNTER",1,"OUTSIDE LOCATION")="FROM THE WIDE WORLD"
167 S C0XDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P" ; Primary
168 S C0XDATA("PROVIDER",1,"NAME")=$$NP^C0XPT0()
169 S C0XDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
170 S C0XDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99201",0))
171 S C0XDATA("PROCEDURE",1,"QTY")=1
172 ;
173 N OK,C0XVISIT,ERR
174 S OK=$$DATA2PCE^PXAPI($NA(C0XDATA),PKG,SRC,.C0XVISIT,,,.ERR)
175 ;ZWRITE OK,C0XVISIT
176 ;ZWRITE:$D(ERR) ERR
177 QUIT
Note: See TracBrowser for help on using the repository browser.