IBSDU ;ALB/TMP - ACRP API UTILITIES ;16-SEP-97
;;2.0;INTEGRATED BILLING;**91,249,366**;21-MAR-94;Build 3
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
SCAN(IBINDX,IBVAL,IBFILTER,IBCBK,IBCLOSE,IBQUERY,IBDIR,IBZXERR) ; Scan encountrs
; *** NOTE *** When using this call, the variable passed as IBQUERY
; must be newed or killed in the calling program
; IBINDX = index name property of the query object
; IBVAL = array of data elements for start/end of search
; IBVAL("DFN") = patient DFN
; IBVAL("BDT") = begin date
; IBVAL("EDT") = end date
; IBVAL("VIS") = encounter file ien
; IBFILTER = the executable code to use to screen entries
; IBCBK = the executable scan callback code to create the result set
; IBCLOSE = Flag that says whether or not to close the QUERY object
; 1 = Perform close 0 or null = Do not close object
; IBQUERY = the # of the current query, if not a new query. If passed
; by reference and query closed, this variable will be nulled
; IBDIR = the direction of the scan (optional)
; null, undefined or FORWARD : Scan forwards
; BACKWARD : Scan backwards
; IBZXERR = the name of the error array to be returned (or none if null)
;
N QUERY
S QUERY=$G(IBQUERY)
I $G(IBZXERR)="" K ^TMP("DIERR",$J)
I $G(IBZXERR)'="" K @IBZXERR
I '$G(QUERY) D
.D OPEN^SDQ(.IBQUERY,$G(IBZXERR)) Q:'$G(IBQUERY)
.D INDEX^SDQ(.IBQUERY,IBINDX,"SET",$G(IBZXERR))
.I $G(IBFILTER)'="" D FILTER^SDQ(.IBQUERY,IBFILTER,"SET",$G(IBZXERR))
.D SCANCB^SDQ(.IBQUERY,IBCBK,"SET",$G(IBZXERR))
I $G(QUERY) D ACTIVE^SDQ(.IBQUERY,"FALSE","SET",$G(IBZXERR))
D SETINDX(.IBQUERY,IBINDX)
D ACTIVE^SDQ(.IBQUERY,"TRUE","SET",$G(IBZXERR))
S:$G(IBDIR)="" IBDIR="FORWARD"
D SCAN^SDQ(.IBQUERY,IBDIR,$G(IBZXERR))
I $G(IBCLOSE) D CLOSE(.IBQUERY)
I $G(IBZXERR)="" K ^TMP("DIERR",$J)
Q
;
CLOSE(IBQUERY) ; Close the query
N IBERROR
G:'$G(IBQUERY) CLOSEQ
D CLOSE^SDQ(.IBQUERY)
CLOSEQ Q
;
SETINDX(IBQUERY,IBINDX) ;
I IBINDX="PATIENT/DATE" D PAT,DATE
I IBINDX="DATE/TIME" D DATE
I IBINDX="PATIENT" D PAT
I IBINDX="VISIT" D VIS
Q
;
PAT ; Verify patient
D PAT^SDQ(.IBQUERY,$G(IBVAL("DFN")),"SET",$G(IBZXERR))
Q
;
DATE ; Verify date range
D DATE^SDQ(.IBQUERY,$G(IBVAL("BDT")),$G(IBVAL("EDT")),"SET",$G(IBZXERR))
Q
;
VIS ; Verify visit
D VISIT^SDQ(.IBQUERY,$G(IBVAL("VIS")),"SET",$G(IBZXERR))
Q
;
EPTR(IBOE) ; Function returns extended pointer for encounter (IBOE) 0-node
Q $$ER^SDOE(IBOE)
;
SCE(IBOE,PC,NODE,IBZXERR) ; Returns the specific piece or entire node of the enctr
; NODE = the node to return ... if undefined, the 0-node is assumed
; If PC is null or undefined, the whole node is returned, otherwise
; just the PC-piece is returned
; IBZXERR = the name of the array where errors should be passed back in
; (pass in quotes I.E.: "IBERR"). If no name passed, errors are
; not returned
N IBX
S:$G(NODE)="" NODE=0
I '$G(PC),NODE=0 S IBX=$$GETOE^SDOE(IBOE,$G(IBZXERR)) G SCEQ
D GETGEN^SDOE(IBOE,"IBX",$G(IBZXERR))
S IBX=$S($G(PC):$P($G(IBX(NODE)),U,+PC),1:$G(IBX(NODE)))
;
SCEQ I $G(IBZXERR)="" K ^TMP("DIERR",$J)
Q IBX
;
DISND(IBOE,IBOE0,PC,NODE) ; Returns the specific piece or all pieces of "DIS"
; (disposition) of the PATIENT file entry for the encounter IBOE
; NODE = the node to return ... if undefined, the 0-node is assumed
; If PC is null or undefined, the whole node is returned, otherwise
; just the PC-piece is returned
; IBOE0 = 0-node of encounter file (optional)
N DATA,IBOE0
S:$G(NODE)="" NODE=0
I $G(IBOE0)="" S IBOE0=$$SCE(IBOE)
S DATA=$G(^DPT(+$P(IBOE0,U,2),"DIS",+$$EPTR^IBSDU(IBOE),NODE))
S:$G(PC) DATA=$P(DATA,U,+PC)
Q DATA
;
LAST(IBDFN) ; Returns the patient's Last Appointment
; ARRAYS IN DFN MUST BE LOCAL or ^TMP or ^UTILITY
; pass in single DFN or an open array reference (local or global)
; for array of patients, array will = last appt
; if '$d(array(dfn)) returned then unknown for that patient
; Unknown - cannot be determined, N/A - patient has none
;
;
N IBARRAY,DFN,DATA,X K ^TMP($J,"SDAMA301")
I 'IBDFN,$E(IBDFN)="^",$E(IBDFN,1,5)'="^TMP(",$E(IBDFN,1,9)'="^UTILITY(" S DATA="INVALID DFN" G LASTQ
I IBDFN,$$GETICN^MPIF001(IBDFN)<1!($$IFLOCAL^MPIF001(IBDFN)) S DATA="Unknown" G LASTQ
I 'IBDFN S DFN=0 F S DFN=$O(@(IBDFN_DFN_")")) Q:'DFN I $$GETICN^MPIF001(DFN)<1!($$IFLOCAL^MPIF001(DFN)) K @(IBDFN_DFN_")")
I 'IBDFN,$D(@($E(IBDFN,1,$L(IBDFN)-1)_$S(IBDFN[",":")",1:"")))<9 S DATA=0 G LASTQ
S IBARRAY(1)=";"_DT
S IBARRAY(3)="R;I;NT"
S IBARRAY(4)=IBDFN
S IBARRAY("FLDS")=1
I IBDFN S IBARRAY("MAX")=-1
S IBARRAY("PURGED")=1
S IBARRAY("SORT")="P"
S DATA=$$SDAPI^SDAMA301(.IBARRAY)
I IBDFN S DATA=$S(DATA=0:"N/A",DATA=-1:-1,1:$O(^TMP($J,"SDAMA301",IBDFN,0)))
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
;
LASTQ K ^TMP($J,"SDAMA301")
Q DATA
;
NEXT(IBDFN) ; Returns the patient's Next Appointment
; ARRAYS IN DFN MUST BE LOCAL or ^TMP or ^UTILITY
; pass in single DFN or an open array reference (local or global)
; for array of patients, array will = next appt
; if '$d(array(dfn)) returned then unknown for that patient
; Unknown - cannot be determined, N/A - patient has none
; Pass DATA by reference for list or $$ return for single
;
;
N IBARRAY,DFN,DATA,X K ^TMP($J,"SDAMA301")
I 'IBDFN,$E(IBDFN)="^",$E(IBDFN,1,5)'="^TMP(",$E(IBDFN,1,9)'="^UTILITY(" S DATA="INVALID DFN" G NEXTQ
I IBDFN,$$GETICN^MPIF001(IBDFN)<1!($$IFLOCAL^MPIF001(IBDFN)) S DATA="Unknown" G NEXTQ
I 'IBDFN S DFN=0 F S DFN=$O(@(IBDFN_DFN_")")) Q:'DFN I $$GETICN^MPIF001(DFN)<1!($$IFLOCAL^MPIF001(DFN)) K @(IBDFN_DFN_")")
I 'IBDFN,$D(@($E(IBDFN,1,$L(IBDFN)-1)_$S(IBDFN[",":")",1:"")))<9 S DATA=0 G NEXTQ
S IBARRAY(1)=DT
S IBARRAY(3)="R;I;NT"
S IBARRAY(4)=IBDFN
S IBARRAY("FLDS")=1
I IBDFN S IBARRAY("MAX")=1
S IBARRAY("SORT")="P"
S DATA=$$SDAPI^SDAMA301(.IBARRAY)
I IBDFN S DATA=$S(DATA=0:"N/A",DATA=-1:-1,1:$O(^TMP($J,"SDAMA301",IBDFN,0)))
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
;
NEXTQ K ^TMP($J,"SDAMA301")
Q DATA
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBSDU 6410 printed Oct 16, 2024@18:27:40 Page 2
IBSDU ;ALB/TMP - ACRP API UTILITIES ;16-SEP-97
+1 ;;2.0;INTEGRATED BILLING;**91,249,366**;21-MAR-94;Build 3
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
SCAN(IBINDX,IBVAL,IBFILTER,IBCBK,IBCLOSE,IBQUERY,IBDIR,IBZXERR) ; Scan encountrs
+1 ; *** NOTE *** When using this call, the variable passed as IBQUERY
+2 ; must be newed or killed in the calling program
+3 ; IBINDX = index name property of the query object
+4 ; IBVAL = array of data elements for start/end of search
+5 ; IBVAL("DFN") = patient DFN
+6 ; IBVAL("BDT") = begin date
+7 ; IBVAL("EDT") = end date
+8 ; IBVAL("VIS") = encounter file ien
+9 ; IBFILTER = the executable code to use to screen entries
+10 ; IBCBK = the executable scan callback code to create the result set
+11 ; IBCLOSE = Flag that says whether or not to close the QUERY object
+12 ; 1 = Perform close 0 or null = Do not close object
+13 ; IBQUERY = the # of the current query, if not a new query. If passed
+14 ; by reference and query closed, this variable will be nulled
+15 ; IBDIR = the direction of the scan (optional)
+16 ; null, undefined or FORWARD : Scan forwards
+17 ; BACKWARD : Scan backwards
+18 ; IBZXERR = the name of the error array to be returned (or none if null)
+19 ;
+20 NEW QUERY
+21 SET QUERY=$GET(IBQUERY)
+22 IF $GET(IBZXERR)=""
KILL ^TMP("DIERR",$JOB)
+23 IF $GET(IBZXERR)'=""
KILL @IBZXERR
+24 IF '$GET(QUERY)
Begin DoDot:1
+25 DO OPEN^SDQ(.IBQUERY,$GET(IBZXERR))
if '$GET(IBQUERY)
QUIT
+26 DO INDEX^SDQ(.IBQUERY,IBINDX,"SET",$GET(IBZXERR))
+27 IF $GET(IBFILTER)'=""
DO FILTER^SDQ(.IBQUERY,IBFILTER,"SET",$GET(IBZXERR))
+28 DO SCANCB^SDQ(.IBQUERY,IBCBK,"SET",$GET(IBZXERR))
End DoDot:1
+29 IF $GET(QUERY)
DO ACTIVE^SDQ(.IBQUERY,"FALSE","SET",$GET(IBZXERR))
+30 DO SETINDX(.IBQUERY,IBINDX)
+31 DO ACTIVE^SDQ(.IBQUERY,"TRUE","SET",$GET(IBZXERR))
+32 if $GET(IBDIR)=""
SET IBDIR="FORWARD"
+33 DO SCAN^SDQ(.IBQUERY,IBDIR,$GET(IBZXERR))
+34 IF $GET(IBCLOSE)
DO CLOSE(.IBQUERY)
+35 IF $GET(IBZXERR)=""
KILL ^TMP("DIERR",$JOB)
+36 QUIT
+37 ;
CLOSE(IBQUERY) ; Close the query
+1 NEW IBERROR
+2 if '$GET(IBQUERY)
GOTO CLOSEQ
+3 DO CLOSE^SDQ(.IBQUERY)
CLOSEQ QUIT
+1 ;
SETINDX(IBQUERY,IBINDX) ;
+1 IF IBINDX="PATIENT/DATE"
DO PAT
DO DATE
+2 IF IBINDX="DATE/TIME"
DO DATE
+3 IF IBINDX="PATIENT"
DO PAT
+4 IF IBINDX="VISIT"
DO VIS
+5 QUIT
+6 ;
PAT ; Verify patient
+1 DO PAT^SDQ(.IBQUERY,$GET(IBVAL("DFN")),"SET",$GET(IBZXERR))
+2 QUIT
+3 ;
DATE ; Verify date range
+1 DO DATE^SDQ(.IBQUERY,$GET(IBVAL("BDT")),$GET(IBVAL("EDT")),"SET",$GET(IBZXERR))
+2 QUIT
+3 ;
VIS ; Verify visit
+1 DO VISIT^SDQ(.IBQUERY,$GET(IBVAL("VIS")),"SET",$GET(IBZXERR))
+2 QUIT
+3 ;
EPTR(IBOE) ; Function returns extended pointer for encounter (IBOE) 0-node
+1 QUIT $$ER^SDOE(IBOE)
+2 ;
SCE(IBOE,PC,NODE,IBZXERR) ; Returns the specific piece or entire node of the enctr
+1 ; NODE = the node to return ... if undefined, the 0-node is assumed
+2 ; If PC is null or undefined, the whole node is returned, otherwise
+3 ; just the PC-piece is returned
+4 ; IBZXERR = the name of the array where errors should be passed back in
+5 ; (pass in quotes I.E.: "IBERR"). If no name passed, errors are
+6 ; not returned
+7 NEW IBX
+8 if $GET(NODE)=""
SET NODE=0
+9 IF '$GET(PC)
IF NODE=0
SET IBX=$$GETOE^SDOE(IBOE,$GET(IBZXERR))
GOTO SCEQ
+10 DO GETGEN^SDOE(IBOE,"IBX",$GET(IBZXERR))
+11 SET IBX=$SELECT($GET(PC):$PIECE($GET(IBX(NODE)),U,+PC),1:$GET(IBX(NODE)))
+12 ;
SCEQ IF $GET(IBZXERR)=""
KILL ^TMP("DIERR",$JOB)
+1 QUIT IBX
+2 ;
DISND(IBOE,IBOE0,PC,NODE) ; Returns the specific piece or all pieces of "DIS"
+1 ; (disposition) of the PATIENT file entry for the encounter IBOE
+2 ; NODE = the node to return ... if undefined, the 0-node is assumed
+3 ; If PC is null or undefined, the whole node is returned, otherwise
+4 ; just the PC-piece is returned
+5 ; IBOE0 = 0-node of encounter file (optional)
+6 NEW DATA,IBOE0
+7 if $GET(NODE)=""
SET NODE=0
+8 IF $GET(IBOE0)=""
SET IBOE0=$$SCE(IBOE)
+9 SET DATA=$GET(^DPT(+$PIECE(IBOE0,U,2),"DIS",+$$EPTR^IBSDU(IBOE),NODE))
+10 if $GET(PC)
SET DATA=$PIECE(DATA,U,+PC)
+11 QUIT DATA
+12 ;
LAST(IBDFN) ; Returns the patient's Last Appointment
+1 ; ARRAYS IN DFN MUST BE LOCAL or ^TMP or ^UTILITY
+2 ; pass in single DFN or an open array reference (local or global)
+3 ; for array of patients, array will = last appt
+4 ; if '$d(array(dfn)) returned then unknown for that patient
+5 ; Unknown - cannot be determined, N/A - patient has none
+6 ;
+7 ;
+8 NEW IBARRAY,DFN,DATA,X
KILL ^TMP($JOB,"SDAMA301")
+9 IF 'IBDFN
IF $EXTRACT(IBDFN)="^"
IF $EXTRACT(IBDFN,1,5)'="^TMP("
IF $EXTRACT(IBDFN,1,9)'="^UTILITY("
SET DATA="INVALID DFN"
GOTO LASTQ
+10 IF IBDFN
IF $$GETICN^MPIF001(IBDFN)<1!($$IFLOCAL^MPIF001(IBDFN))
SET DATA="Unknown"
GOTO LASTQ
+11 IF 'IBDFN
SET DFN=0
FOR
SET DFN=$ORDER(@(IBDFN_DFN_")"))
if 'DFN
QUIT
IF $$GETICN^MPIF001(DFN)<1!($$IFLOCAL^MPIF001(DFN))
KILL @(IBDFN_DFN_")")
+12 IF 'IBDFN
IF $DATA(@($EXTRACT(IBDFN,1,$LENGTH(IBDFN)-1)_$SELECT(IBDFN[",":")",1:"")))<9
SET DATA=0
GOTO LASTQ
+13 SET IBARRAY(1)=";"_DT
+14 SET IBARRAY(3)="R;I;NT"
+15 SET IBARRAY(4)=IBDFN
+16 SET IBARRAY("FLDS")=1
+17 IF IBDFN
SET IBARRAY("MAX")=-1
+18 SET IBARRAY("PURGED")=1
+19 SET IBARRAY("SORT")="P"
+20 SET DATA=$$SDAPI^SDAMA301(.IBARRAY)
+21 IF IBDFN
SET DATA=$SELECT(DATA=0:"N/A",DATA=-1:-1,1:$ORDER(^TMP($JOB,"SDAMA301",IBDFN,0)))
+22 IF 'IBDFN
SET (DATA,DFN)=0
FOR
SET DFN=$ORDER(@(IBDFN_DFN_")"))
if 'DFN
QUIT
SET X=$ORDER(^TMP($JOB,"SDAMA301",DFN,9999999),-1)
SET @(IBDFN_DFN_")")=$SELECT(X:X,1:"N/A")
SET DATA=DATA+1
+23 ;
LASTQ KILL ^TMP($JOB,"SDAMA301")
+1 QUIT DATA
+2 ;
NEXT(IBDFN) ; Returns the patient's Next Appointment
+1 ; ARRAYS IN DFN MUST BE LOCAL or ^TMP or ^UTILITY
+2 ; pass in single DFN or an open array reference (local or global)
+3 ; for array of patients, array will = next appt
+4 ; if '$d(array(dfn)) returned then unknown for that patient
+5 ; Unknown - cannot be determined, N/A - patient has none
+6 ; Pass DATA by reference for list or $$ return for single
+7 ;
+8 ;
+9 NEW IBARRAY,DFN,DATA,X
KILL ^TMP($JOB,"SDAMA301")
+10 IF 'IBDFN
IF $EXTRACT(IBDFN)="^"
IF $EXTRACT(IBDFN,1,5)'="^TMP("
IF $EXTRACT(IBDFN,1,9)'="^UTILITY("
SET DATA="INVALID DFN"
GOTO NEXTQ
+11 IF IBDFN
IF $$GETICN^MPIF001(IBDFN)<1!($$IFLOCAL^MPIF001(IBDFN))
SET DATA="Unknown"
GOTO NEXTQ
+12 IF 'IBDFN
SET DFN=0
FOR
SET DFN=$ORDER(@(IBDFN_DFN_")"))
if 'DFN
QUIT
IF $$GETICN^MPIF001(DFN)<1!($$IFLOCAL^MPIF001(DFN))
KILL @(IBDFN_DFN_")")
+13 IF 'IBDFN
IF $DATA(@($EXTRACT(IBDFN,1,$LENGTH(IBDFN)-1)_$SELECT(IBDFN[",":")",1:"")))<9
SET DATA=0
GOTO NEXTQ
+14 SET IBARRAY(1)=DT
+15 SET IBARRAY(3)="R;I;NT"
+16 SET IBARRAY(4)=IBDFN
+17 SET IBARRAY("FLDS")=1
+18 IF IBDFN
SET IBARRAY("MAX")=1
+19 SET IBARRAY("SORT")="P"
+20 SET DATA=$$SDAPI^SDAMA301(.IBARRAY)
+21 IF IBDFN
SET DATA=$SELECT(DATA=0:"N/A",DATA=-1:-1,1:$ORDER(^TMP($JOB,"SDAMA301",IBDFN,0)))
+22 IF 'IBDFN
SET (DATA,DFN)=0
FOR
SET DFN=$ORDER(@(IBDFN_DFN_")"))
if 'DFN
QUIT
SET X=$ORDER(^TMP($JOB,"SDAMA301",DFN,0))
SET @(IBDFN_DFN_")")=$SELECT(X:X,1:"N/A")
SET DATA=DATA+1
+23 ;
NEXTQ KILL ^TMP($JOB,"SDAMA301")
+1 QUIT DATA
+2 ;
