source: FOIAVistA/tag/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/VSIT.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1VSIT ;ISD/MRL,RJP - Visit Tracking ;5/9/02 4:31pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,111,118,164**;Aug 12, 1996
3 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
4 ; the incorporation of the module into PCE. For historical reference,
5 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
6 ; patches.
7 ;
8 ;;2.0;VISIT TRACKING;**1**;Aug 12, 1996
9 ;
10 ; - pass VSIT = <visit date [and time] in FM format>
11 ; DFN = <patient file pointer>
12 ; [VSIT(0)] = <functional parameters>
13 ; [VSIT("xxx")] = <used in match logic if VSIT(0)["M">
14 ; - rtns VSIT("IEN") = <visit record # in format as Y w/ ^DIC>
15 ; VSIT(##,"XXX") = visit values passed by mnemonics
16 ; If VSIT("IEN") = -1 Error in creation/lookup.
17 ; If Vsit("IEN") = -2 Package is turned off or not defined in the
18 ; Visit Tracking Parameters file.
19 S VSIT("IEN")=$$GET($G(VSIT),$G(DFN),$G(VSIT(0)),.VSIT)
20EXIT ;
21 Q
22 ;
23GET(VDT,DFN,PRAM,VSIT) ; find or create a visit
24 ;
25 ; - pass {VDT/VSIT("VDT")} = <visit date [and time] in FM format>
26 ; {DFN/VSIT("PAT")} = <patient file pointer>
27 ; [PRAM/VSIT(0)] = <functional parameters>
28 ; [VSIT("xxx")] = <array w/ mnemonic subscript>
29 ; <used in match logic if VISIT(O)["M">
30 ; <for SVC, TYP, INS, DSS, ELG , LOC>
31 ; - rtns = <visit record # in format as Y w/ ^DIC>
32 I $G(VSITPKG)]"" S VSIT("PKG")=VSITPKG
33 E S (VSITPKG,VSIT("PKG"))=$G(VSIT("PKG"))
34 N VSITPKGP
35 S VSITPKGP=$$GETPKG^VSIT0($G(VSITPKG))
36 ;Check Inactive Flag
37 I VSITPKGP<1 S VSIT("IEN")=-2 G DONE ;Need to update Visit Tracking Parameters File
38 I $$ACTIVE^VSIT0(VSITPKGP)'=1 S VSIT("IEN")=-2 G DONE ;Quit if package is not active
39 ;Check that we now the site part of the Encounter ID
40 I $P($G(^DIC(150.9,1,4)),"^",2)<1 S VSIT("IEN")=-1 G DONE
41 ;
42 K VSIT("IEN"),^TMP("VSITDD",$J),^TMP($J,"VSIT-ERROR")
43 S:$G(VDT)]"" VSIT("VDT")=VDT
44 S:$G(DFN) VSIT("PAT")=+DFN
45 S:$G(PRAM)]"" VSIT(0)=PRAM
46 ;See if the old CLN nodes needs moved into the DSS node.
47 I '($D(VSIT("DSS"))#2),$D(VSIT("CLN"))#2 S VSIT("DSS")=VSIT("CLN")
48 ;
49 D FLD^VSITFLD
50 ;Set all of the VSIT nodes with $GET
51 D SETALL^VSITCK
52 ;
53 ;Inpatient movement
54 N VSITIPM S VSITIPM=+$$IP^VSITCK1(+VSIT("VDT"),+VSIT("PAT"))
55 ;Do the defaulting of the fields that need to be defaulted be for lookup
56 I $$REQUIRED^VSITDEF S VSIT("IEN")=-1 G DONE
57 ;
58 D:'$D(DT) DT^DICRW
59 ;
60 ;If Force new visit, make the visit and exit
61 I VSIT(0)["F" D G QUIT
62 . D DEFAULTS^VSITDEF
63 . D ^VSITPUT
64 ;
65 ;If not forcing new visit try to look up the visit
66 D LST^VSITGET("","","",.VSIT,.VSITGET)
67 I $$SWSTAT^IBBAPI(),+$G(VSITGET)=1 D ;PX*1.0*164
68 . N ACT
69 . I $G(VSIT("ACT"))']0 S VSIT("ACT")=$P($G(^AUPNVSIT(+VSITGET(1),0)),"^",26) Q
70 . I $G(VSIT("ACT"))]0 S ACT=VSIT("ACT") K VSIT S VSIT("IEN")=+$P(VSITGET(1),"^"),VSIT("ACT")=ACT D UPD^VSIT ;PX*1.0*164
71 ;
72 I +$G(VSITGET)=0,VSIT(0)["N" D G QUIT
73 . D DEFAULTS^VSITDEF
74 . D ^VSITPUT
75 I +$G(VSITGET)=1 S VSIT("IEN")=$P(VSITGET(1),"|")_"^"_$P($P(VSITGET(1),"^"),"|",2) G QUIT
76 I +$G(VSITGET)>1,VSIT(0)["I" S Y=$$VSIT^VSITASK(VSIT("PAT"),.VSITGET) S:'+Y Y=1 S VSIT("IEN")=$P(VSITGET(+Y),"|")_"^"_$P($P(VSITGET(+Y),"^"),"|",2) G QUIT
77 I +$G(VSITGET)>1,VSIT(0)'["I" S VSIT("IEN")=$P(VSITGET(1),"|")_"^"_$P($P(VSITGET(1),"^"),"|",2) G QUIT
78 S VSIT("IEN")=-1
79 ;
80QUIT ; - end of job
81 ;
82 ; set vsit api
83 I +$G(VSIT("IEN"))=0 S VSIT("IEN")=-1
84 D:VSIT("IEN")>0 ALL^VSITVAR(+VSIT("IEN"),"B",1)
85 ;
86DONE I $D(^TMP($J,"VSIT-ERROR")),$G(VSIT("IEN"))'>0,VSIT(0)["N"!(VSIT(0)["F") D SND^VSITBUL
87 K VSITGET
88 K ^TMP("VSITDD",$J)
89 Q VSIT("IEN")
90 ;
91ADD ; - add to dependency count
92 ; called via cross references on pointer files
93 D ADD^AUPNVSIT
94 Q
95 ;
96SUB ; - subtract from dependency count
97 ; called via cross references on pointer files
98 ;
99 D SUB^AUPNVSIT
100 Q
101 ;
102UPD ; Update Visit File
103 Q:$G(VSIT("IEN"))<1
104 Q:'$D(^AUPNVSIT(VSIT("IEN"),0))
105 N DR,DIE,DA,VSITDR,VSITDATA,VSITFLD
106 N %,%H,%I,X
107 D NOW^%DTC
108 S VSIT("MDT")=%
109 D FLD^VSITFLD
110 S DIE=9000010,DA=VSIT("IEN")
111 S (VSITDR,DR)=""
112 L +^AUPNVSIT(+VSIT("IEN")):10
113 F S VSITDR=$O(VSIT(VSITDR)) Q:VSITDR="" I $G(^TMP("VSITDD",$J,VSITDR))'="" D
114 .S VSITFLD=$P($G(^TMP("VSITDD",$J,VSITDR)),";",2) ;Field
115 .S VSITDATA=VSIT(VSITDR) ;Data
116 .;S DR=""_VSITFLD_"////"_VSITDATA_"" D ^DIE S DR="" ;Calls DIE each fld
117 .I $L(DR)<245 S DR=$P($G(^TMP("VSITDD",$J,VSITDR)),";",2)_"////"_VSIT(VSITDR)_";"_DR
118 .I $L(DR)>244 S DR=$E(DR,1,$L(DR)-1) D ^DIE S DR=$P($G(^TMP("VSITDD",$J,VSITDR)),";",2)_"////"_VSIT(VSITDR)_";"
119 I $G(DR)["////" S DR=$E(DR,1,$L(DR)-1) D ^DIE
120 ;
121 ;PX*1*111 - Update NTR file for Head & Neck
122 D
123 . N HNCARR,HNCERR
124 . K HNCARR,HNCERR
125 . D GETS^DIQ(9000010,+VSIT("IEN"),80006,"I","HNCARR","HNCERR")
126 . I $D(HNCERR) Q ;No data found
127 . I $G(HNCARR(9000010,(+VSIT("IEN")_","),80006,"I"))'=1 Q
128 . ;Answer is 'Y' to HNC question
129 . N SDELG0,DGARR,PCEXDFN
130 . S PCEXDFN=$G(DFN)
131 . I PCEXDFN="" S PCEXDFN=$G(PXAA("PATIENT"))
132 . I PCEXDFN="" Q
133 . S SDELG0=$$GETCUR^DGNTAPI(PCEXDFN,"DGARR")
134 . S SDELG0=+$G(DGARR("STAT"))
135 . I SDELG0'=3 Q ;NTR File does not require editing
136 . S SDELG0=$$FILEHNC^DGNTAPI1(PCEXDFN)
137 ;
138 L -^AUPNVSIT(+VSIT("IEN"))
139 K ^TMP("VSITDD",$J)
140 Q
141PKG2IEN(PKG) ;Pass in package name space and
142 ; returns pointer to the package in the Package file #9.4
143 Q $$PKG2IEN^VSIT0($G(PKG))
144 ;
145PKG(PKG,VALUE) ;-Entry point to add package to multiple in tracking parameters
146 ;-PKG=Package Name Space
147 ;-VALUE=Value on the ON/OFF flag under package multiple
148 ;--1=ON 0=OFF
149 Q $$PKG^VSIT0($G(PKG),$G(VALUE))
150 ;
151PKGON(PKG) ; -- Returns the active flag for the package
152 ; 1 the package can create visits
153 ; 0 the package cannot create visits
154 ; -1 called wrong or could not find package in VT parameters file
155 Q $$PKGON^VSIT0($G(PKG))
156 ;
157IEN2VID(IEN) ; -- Call with Visit IEN and returns the Visit ID
158 Q:'($D(^AUPNVSIT(+IEN,150))#2) -1
159 Q $P(^AUPNVSIT(IEN,150),"^",1)
160 ;
161VID2IEN(VID) ; -- Call with Visit's ID and returns the Visit IEN
162 N IEN
163 S IEN=$O(^AUPNVSIT("VID",VID,0))
164 Q $S(IEN]"":IEN,1:-1)
165 ;
166LOOKUP(IEN,FMT,WITHIEN) ; -- Lookup a visit and return all of its information
167 ;DBIA #: 1906
168 ;Parameters:
169 ; IEN is the IEN for the Visit OR the Visit's ID
170 ; FMT is the format that you want the output where
171 ; I ::= internal format
172 ; E ::= external format
173 ; B ::= both internal and external format
174 ; B is the default if FMT is anything other than "I" or "E"
175 ; WITHIEN is 0 if you do not want the IEN of the VSIT( as the first
176 ; subscript and 1 if you do. "1" is the default.
177 ;
178 ;Return: -1 if IEN was not a valid IEN or Visit ID
179 ; otherwise returns IEN
180 ; VSIT( an array VSIT(Visit IEN,field) or VSIT(field) depending
181 ; on the value of WITHIEN. The array is all of the fields
182 ; in the visit file. If B(oth) internal and external format
183 ; are returned the format is: internal^external.
184 ; If I(nternal) format is requested only the internal part
185 ; is returned.
186 ; If E(xternal) format is requested the format is: ^external
187 ; External values, if requested, are always returned in the
188 ; second pieces of the array elements.
189 ;
190 Q:$G(IEN)']"" -1
191 S:+IEN'=IEN IEN=$$VID2IEN(IEN) ;PX*1.0*118
192 Q:'($D(^AUPNVSIT(+IEN,0))#2) -1
193 S FMT=$G(FMT)
194 S FMT=$S(FMT["B":"B",FMT["I":"I",FMT["E":"E",1:"B")
195 S WITHIEN=$S($G(WITHIEN)=0:0,1:1)
196 D ALL^VSITVAR(IEN,FMT,WITHIEN)
197 Q IEN
198 ;
199SELECTED(DFN,SDT,EDT,HOSLOC,ENCTYPE,NENCTYPE,SERVCAT,NSERVCAT,LASTN) ;
200 ; -- Returns selected visits depending on screens passed in.
201 D VSITAPI^VSITOE($G(DFN),$G(SDT),$G(EDT),$G(HOSLOC),$G(ENCTYPE),$G(NENCTYPE),$G(SERVCAT),$G(NSERVCAT),$G(LASTN))
202 Q
203 ;
204HISTORIC(IEN) ; -- Returns 1 if it is an Historical visit ("E" in #.07)
205 ; 0 if it is not an Historical visit.
206 ; -1 if the IEN is bad
207 Q $S('($D(^AUPNVSIT(IEN,0))#2):-1,1:$P($G(^AUPNVSIT(IEN,0)),"^",7)="E")
208 ;
209MODIFIED(IEN) ;Sets the Date Last Modified (.13) field to NOW
210 ;
211 N VSIT
212 S VSIT("IEN")=IEN
213 D UPD
214 Q
Note: See TracBrowser for help on using the repository browser.