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

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

boy oh boy now we file fully fledged ambulatory encounters that can show up on the CPRS cover sheet.
File size: 6.0 KB
Line 
1C0XPT4 ; VEN/SMH - Encounter Processing;2013-05-03 5:11 PM
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 HISTENC(STARTDATE,DFN) ; Historical 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 ;
37HISTENC(DATE,DFN,FTLOC,COMMENT) ; Private Proc; Historical Encounter Filing into the VISIT file
38 ; Input:
39 ; - DATE: FM DATE of VISIT (Scalar) - Required
40 ; - DFN (Scalar) - Required
41 ; - FTLOC: Free Text Location - Optional. Defaults to SMART LOCATION
42 ; - COMMENT: Free Text Comment - Optional. Defaults to Imported from Smart
43 ; Output:
44 ; - Creates V file entries for the historical 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")="FROM THE WIDE WORLD"
64 S C0XDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P" ; Primary
65 S C0XDATA("PROVIDER",1,"NAME")=$$NP^C0XPT0()
66 ; Diangosis and procedure necessary so visit will show up in ^SDE.
67 S C0XDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
68 S C0XDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99201",0))
69 S C0XDATA("PROCEDURE",1,"QTY")=1
70 ;
71 N C0XVISIT,C0XERR ; Visit, Error
72 N XQORMUTE S XQORMUTE=1 ; Unwinder: Shut the hell up. Don't execute disabled protocols rather than whining about them.
73 N OK S OK=$$DATA2PCE^PXAPI($NA(C0XDATA),PKG,SRC,.C0XVISIT,,,.C0XERR)
74 I OK<1 S $EC=",U1,"
75 QUIT
76 ;
77 ;
78DELALL(DFN) ; Private Proc; Delete ALL ALL ALL encounter information for the patient.
79 ; BE VERY CAREFUL USING THIS...
80 ; Walk through the C X-Ref for this patient
81 N I S I=9000010 ; Hit the VISIT file LAST as some xrefs in other files point to it!
82 N DIK,DA
83 F S I=$O(^DIC(I)) Q:I'<9000011 D ; For each V File...
84 . N OR S OR=$$ROOT^DILFD(I,"",0) ; Open Root for ^DIK
85 . N CR S CR=$$ROOT^DILFD(I,"",1) ; Closed Root for @CR@("C")
86 . ; W OR," ",CR ; DEBUG
87 . ; W ": " ; DEBUG
88 . S DIK=OR ; File root to kill
89 . N J S J="" F S J=$O(@CR@("C",DFN,J)) Q:'J S DA=J D ^DIK ; each entry to kill
90 . ; W ! ; DEBUG
91 ;
92 ; Visit file
93 N I S I=""
94 S DIK="^AUPNVSIT("
95 F S I=$O(^AUPNVSIT("C",DFN,I)) Q:'I S DA=I D ^DIK ;ditto
96 ;
97 ; Outpatient encounter file
98 N I S I=""
99 ; W "SCE: " ; Debug
100 S DIK="^SCE(" ; ditto
101 F S I=$O(^SCE("C",DFN,I)) Q:'I S DA=I D ^DIK ; ditto
102 QUIT
103 ;
104 ;
105TEST ; Test creating an encounter using DATA2PCE^PXAPI
106 ; Thank you Kevin Muldrum!
107 ; This code comes from EDP aka EDIS.
108 N DFN S DFN=188 ; One of those Ducks
109 ;S LOC=$$GET^XPAR(DUZ(2)_";DIC(4,","EDPF LOCATION")
110 N LOC S LOC=2 ; DR OFFICE
111 N EDPKG,EDPSRC,OK,EDPDATA,EDPVISIT,ERR
112 S EDPKG=$O(^DIC(9.4,"B","EMERGENCY DEPARTMENT",0))
113 S EDPSRC="EDP TRACKING LOG"
114 S EDPDATA("ENCOUNTER",1,"PATIENT")=DFN
115 S EDPDATA("ENCOUNTER",1,"HOS LOC")=LOC
116 S EDPDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A"
117 S EDPDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
118 S EDPDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
119 ;
120 S EDPDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
121 S EDPDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99201",0))
122 S EDPDATA("PROCEDURE",1,"QTY")=1
123 S EDPDATA("PROVIDER",1,"NAME")=23
124 ;
125 S OK=$$DATA2PCE^PXAPI("EDPDATA",EDPKG,EDPSRC,.EDPVISIT,23,1,.ERR)
126 W OK
127 Q
128 ;
129 ;
130TEST2 ; Test creating an historical event
131 ;
132 N DFN S DFN=188
133 N LOC S LOC=1
134 N PKG S PKG=$O(^DIC(9.4,"B","FILEMAN TRIPLE STORE",0))
135 I 'PKG S $EC=",U1,"
136 ;
137 N SRC S SRC="FMTS TEST"
138 ;
139 N C0XDATA
140 S C0XDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
141 S C0XDATA("ENCOUNTER",1,"PATIENT")=DFN
142 S C0XDATA("ENCOUNTER",1,"SERVICE CATEGORY")="E" ; EVENT
143 S C0XDATA("ENCOUNTER",1,"OUTSIDE LOCATION")="FROM THE WIDE WORLD"
144 S C0XDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P" ; Primary
145 S C0XDATA("ENCOUNTER",1,"COMMENT")="Testing"
146 ;
147 N OK,C0XVISIT,ERR
148 S OK=$$DATA2PCE^PXAPI($NA(C0XDATA),PKG,SRC,.C0XVISIT,,,.ERR)
149 QUIT
150TEST3 ; Test creating a real event
151 ;
152 N DFN S DFN=190
153 N LOC S LOC=$$HL^C0XPT0()
154 N PKG S PKG=$O(^DIC(9.4,"B","FILEMAN TRIPLE STORE",0))
155 I 'PKG S $EC=",U1,"
156 ;
157 N SRC S SRC="FMTS TEST"
158 ;
159 N C0XDATA
160 S C0XDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
161 S C0XDATA("ENCOUNTER",1,"PATIENT")=DFN
162 S C0XDATA("ENCOUNTER",1,"HOS LOC")=LOC
163 S C0XDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A" ; Ambulatory
164 S C0XDATA("ENCOUNTER",1,"OUTSIDE LOCATION")="FROM THE WIDE WORLD"
165 S C0XDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P" ; Primary
166 S C0XDATA("PROVIDER",1,"NAME")=$$NP^C0XPT0()
167 S C0XDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
168 S C0XDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99201",0))
169 S C0XDATA("PROCEDURE",1,"QTY")=1
170 ;
171 N OK,C0XVISIT,ERR
172 S OK=$$DATA2PCE^PXAPI($NA(C0XDATA),PKG,SRC,.C0XVISIT,,,.ERR)
173 ;ZWRITE OK,C0XVISIT
174 ;ZWRITE:$D(ERR) ERR
175 QUIT
Note: See TracBrowser for help on using the repository browser.