source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBSDU.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.1 KB
Line 
1IBSDU ;ALB/TMP - ACRP API UTILITIES ;16-SEP-97
2 ;;2.0;INTEGRATED BILLING;**91,249,366**;21-MAR-94;Build 3
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SCAN(IBINDX,IBVAL,IBFILTER,IBCBK,IBCLOSE,IBQUERY,IBDIR,IBZXERR) ; Scan encountrs
6 ; *** NOTE *** When using this call, the variable passed as IBQUERY
7 ; must be newed or killed in the calling program
8 ; IBINDX = index name property of the query object
9 ; IBVAL = array of data elements for start/end of search
10 ; IBVAL("DFN") = patient DFN
11 ; IBVAL("BDT") = begin date
12 ; IBVAL("EDT") = end date
13 ; IBVAL("VIS") = encounter file ien
14 ; IBFILTER = the executable code to use to screen entries
15 ; IBCBK = the executable scan callback code to create the result set
16 ; IBCLOSE = Flag that says whether or not to close the QUERY object
17 ; 1 = Perform close 0 or null = Do not close object
18 ; IBQUERY = the # of the current query, if not a new query. If passed
19 ; by reference and query closed, this variable will be nulled
20 ; IBDIR = the direction of the scan (optional)
21 ; null, undefined or FORWARD : Scan forwards
22 ; BACKWARD : Scan backwards
23 ; IBZXERR = the name of the error array to be returned (or none if null)
24 ;
25 N QUERY
26 S QUERY=$G(IBQUERY)
27 I $G(IBZXERR)="" K ^TMP("DIERR",$J)
28 I $G(IBZXERR)'="" K @IBZXERR
29 I '$G(QUERY) D
30 .D OPEN^SDQ(.IBQUERY,$G(IBZXERR)) Q:'$G(IBQUERY)
31 .D INDEX^SDQ(.IBQUERY,IBINDX,"SET",$G(IBZXERR))
32 .I $G(IBFILTER)'="" D FILTER^SDQ(.IBQUERY,IBFILTER,"SET",$G(IBZXERR))
33 .D SCANCB^SDQ(.IBQUERY,IBCBK,"SET",$G(IBZXERR))
34 I $G(QUERY) D ACTIVE^SDQ(.IBQUERY,"FALSE","SET",$G(IBZXERR))
35 D SETINDX(.IBQUERY,IBINDX)
36 D ACTIVE^SDQ(.IBQUERY,"TRUE","SET",$G(IBZXERR))
37 S:$G(IBDIR)="" IBDIR="FORWARD"
38 D SCAN^SDQ(.IBQUERY,IBDIR,$G(IBZXERR))
39 I $G(IBCLOSE) D CLOSE(.IBQUERY)
40 I $G(IBZXERR)="" K ^TMP("DIERR",$J)
41 Q
42 ;
43CLOSE(IBQUERY) ; Close the query
44 N IBERROR
45 G:'$G(IBQUERY) CLOSEQ
46 D CLOSE^SDQ(.IBQUERY)
47CLOSEQ Q
48 ;
49SETINDX(IBQUERY,IBINDX) ;
50 I IBINDX="PATIENT/DATE" D PAT,DATE
51 I IBINDX="DATE/TIME" D DATE
52 I IBINDX="PATIENT" D PAT
53 I IBINDX="VISIT" D VIS
54 Q
55 ;
56PAT ; Verify patient
57 D PAT^SDQ(.IBQUERY,$G(IBVAL("DFN")),"SET",$G(IBZXERR))
58 Q
59 ;
60DATE ; Verify date range
61 D DATE^SDQ(.IBQUERY,$G(IBVAL("BDT")),$G(IBVAL("EDT")),"SET",$G(IBZXERR))
62 Q
63 ;
64VIS ; Verify visit
65 D VISIT^SDQ(.IBQUERY,$G(IBVAL("VIS")),"SET",$G(IBZXERR))
66 Q
67 ;
68EPTR(IBOE) ; Function returns extended pointer for encounter (IBOE) 0-node
69 Q $$ER^SDOE(IBOE)
70 ;
71SCE(IBOE,PC,NODE,IBZXERR) ; Returns the specific piece or entire node of the enctr
72 ; NODE = the node to return ... if undefined, the 0-node is assumed
73 ; If PC is null or undefined, the whole node is returned, otherwise
74 ; just the PC-piece is returned
75 ; IBZXERR = the name of the array where errors should be passed back in
76 ; (pass in quotes I.E.: "IBERR"). If no name passed, errors are
77 ; not returned
78 N IBX
79 S:$G(NODE)="" NODE=0
80 I '$G(PC),NODE=0 S IBX=$$GETOE^SDOE(IBOE,$G(IBZXERR)) G SCEQ
81 D GETGEN^SDOE(IBOE,"IBX",$G(IBZXERR))
82 S IBX=$S($G(PC):$P($G(IBX(NODE)),U,+PC),1:$G(IBX(NODE)))
83 ;
84SCEQ I $G(IBZXERR)="" K ^TMP("DIERR",$J)
85 Q IBX
86 ;
87DISND(IBOE,IBOE0,PC,NODE) ; Returns the specific piece or all pieces of "DIS"
88 ; (disposition) of the PATIENT file entry for the encounter IBOE
89 ; NODE = the node to return ... if undefined, the 0-node is assumed
90 ; If PC is null or undefined, the whole node is returned, otherwise
91 ; just the PC-piece is returned
92 ; IBOE0 = 0-node of encounter file (optional)
93 N DATA,IBOE0
94 S:$G(NODE)="" NODE=0
95 I $G(IBOE0)="" S IBOE0=$$SCE(IBOE)
96 S DATA=$G(^DPT(+$P(IBOE0,U,2),"DIS",+$$EPTR^IBSDU(IBOE),NODE))
97 S:$G(PC) DATA=$P(DATA,U,+PC)
98 Q DATA
99 ;
100LAST(IBDFN) ; Returns the patient's Last Appointment
101 ; ARRAYS IN DFN MUST BE LOCAL or ^TMP or ^UTILITY
102 ; pass in single DFN or an open array reference (local or global)
103 ; for array of patients, array will = last appt
104 ; if '$d(array(dfn)) returned then unknown for that patient
105 ; Unknown - cannot be determined, N/A - patient has none
106 ;
107 ;
108 N IBARRAY,DFN,DATA,X K ^TMP($J,"SDAMA301")
109 I 'IBDFN,$E(IBDFN)="^",$E(IBDFN,1,5)'="^TMP(",$E(IBDFN,1,9)'="^UTILITY(" S DATA="INVALID DFN" G LASTQ
110 I IBDFN,$$GETICN^MPIF001(IBDFN)<1!($$IFLOCAL^MPIF001(IBDFN)) S DATA="Unknown" G LASTQ
111 I 'IBDFN S DFN=0 F S DFN=$O(@(IBDFN_DFN_")")) Q:'DFN I $$GETICN^MPIF001(DFN)<1!($$IFLOCAL^MPIF001(DFN)) K @(IBDFN_DFN_")")
112 I 'IBDFN,$D(@($E(IBDFN,1,$L(IBDFN)-1)_$S(IBDFN[",":")",1:"")))<9 S DATA=0 G LASTQ
113 S IBARRAY(1)=";"_DT
114 S IBARRAY(3)="R;I;NT"
115 S IBARRAY(4)=IBDFN
116 S IBARRAY("FLDS")=1
117 I IBDFN S IBARRAY("MAX")=-1
118 S IBARRAY("PURGED")=1
119 S IBARRAY("SORT")="P"
120 S DATA=$$SDAPI^SDAMA301(.IBARRAY)
121 I IBDFN S DATA=$S(DATA=0:"N/A",DATA=-1:-1,1:$O(^TMP($J,"SDAMA301",IBDFN,0)))
122 I 'IBDFN S (DATA,DFN)=0 F S DFN=$O(@(IBDFN_DFN_")")) Q:'DFN S X=$O(^TMP($J,"SDAMA301",DFN,9999999),-1),@(IBDFN_DFN_")")=$S(X:X,1:"N/A"),DATA=DATA+1
123 ;
124LASTQ K ^TMP($J,"SDAMA301")
125 Q DATA
126 ;
127NEXT(IBDFN) ; Returns the patient's Next Appointment
128 ; ARRAYS IN DFN MUST BE LOCAL or ^TMP or ^UTILITY
129 ; pass in single DFN or an open array reference (local or global)
130 ; for array of patients, array will = next appt
131 ; if '$d(array(dfn)) returned then unknown for that patient
132 ; Unknown - cannot be determined, N/A - patient has none
133 ; Pass DATA by reference for list or $$ return for single
134 ;
135 ;
136 N IBARRAY,DFN,DATA,X K ^TMP($J,"SDAMA301")
137 I 'IBDFN,$E(IBDFN)="^",$E(IBDFN,1,5)'="^TMP(",$E(IBDFN,1,9)'="^UTILITY(" S DATA="INVALID DFN" G NEXTQ
138 I IBDFN,$$GETICN^MPIF001(IBDFN)<1!($$IFLOCAL^MPIF001(IBDFN)) S DATA="Unknown" G NEXTQ
139 I 'IBDFN S DFN=0 F S DFN=$O(@(IBDFN_DFN_")")) Q:'DFN I $$GETICN^MPIF001(DFN)<1!($$IFLOCAL^MPIF001(DFN)) K @(IBDFN_DFN_")")
140 I 'IBDFN,$D(@($E(IBDFN,1,$L(IBDFN)-1)_$S(IBDFN[",":")",1:"")))<9 S DATA=0 G NEXTQ
141 S IBARRAY(1)=DT
142 S IBARRAY(3)="R;I;NT"
143 S IBARRAY(4)=IBDFN
144 S IBARRAY("FLDS")=1
145 I IBDFN S IBARRAY("MAX")=1
146 S IBARRAY("SORT")="P"
147 S DATA=$$SDAPI^SDAMA301(.IBARRAY)
148 I IBDFN S DATA=$S(DATA=0:"N/A",DATA=-1:-1,1:$O(^TMP($J,"SDAMA301",IBDFN,0)))
149 I 'IBDFN S (DATA,DFN)=0 F S DFN=$O(@(IBDFN_DFN_")")) Q:'DFN S X=$O(^TMP($J,"SDAMA301",DFN,0)),@(IBDFN_DFN_")")=$S(X:X,1:"N/A"),DATA=DATA+1
150 ;
151NEXTQ K ^TMP($J,"SDAMA301")
152 Q DATA
153 ;
Note: See TracBrowser for help on using the repository browser.