ECUTL0 ;ALB/ESD - Event Capture Eligibility and In/Outpat Utilities ;2/9/18 16:51
;;2.0;EVENT CAPTURE;**10,139**;8 May 96;Build 7
;
;
CHKDSS(DSSU,INOUT) ; Determine if DSS Unit is sending data to PCE
;
; Input:
; DSSU - DSS Unit IEN
; INOUT - Inpatient or Outpatient
;
; Output:
; Function Value - 0 if DSS Unit not sending to PCE or input
; parameters not passed in
; 1 if DSS Unit sending to PCE
;
N ECDSS,ECSEND
;
;- Drops out if invalid condition
D
. I '$G(DSSU),($G(INOUT)="") S ECDSS=0 Q
.;
.;- Get 'Send to PCE' field
. S ECSEND=$P($G(^ECD(+DSSU,0)),"^",14)
. I ECSEND="A" S ECDSS=1 ;139 Change logic to set to 1 if sending (asking SC related questions)
. E S ECDSS=0 ;139 else we're not asking SC related questions
Q ECDSS
;
;
ELGLST() ; Display list of patient eligibilities and allow user to
; select eligibility, given ELIG^VADPT has been previously called.
;
; Input:
; None
; Output:
; Function value - IEN of eligibility from ELIGIBILITY CODE file
; (#8) or 0 if unsuccessful
;
N ECALLEL,ECELIEN,ECELIG,ECPRIMEL
S (ECELIEN,ECELIG)=0
;
;- If VAEL not previously called, exit with error condition
I '$D(VAEL)!('$G(VAEL(1))) G ELGLSTQ
ELIG S ECALLEL=""
S ECPRIMEL=$P(VAEL(1),"^",2)
W !!,"THIS PATIENT HAS OTHER ENTITLED ELIGIBILITIES:"
;
;- Display all of patient's eligibilities
F ECELIEN=0:0 S ECELIEN=$O(VAEL(1,ECELIEN)) Q:'ECELIEN D
. W !?5,$P(VAEL(1,ECELIEN),"^",2)
. S ECALLEL=ECALLEL_"^"_$P(VAEL(1,ECELIEN),"^",2)
;
;- Use patient's primary elig as default
CHOOSE W !!,"ENTER THE ELIGIBILITY FOR THIS APPOINTMENT: "_ECPRIMEL_"// "
;
;- If return, uparrow, or time out get prim elig w/o searching for match
R X:DTIME G PRIMELG:"^"[X!('$T) S X=$$UPPER^VALM1(X) G ELIG:X["?",CHOOSE:ECALLEL'[("^"_X)
S ECPRIMEL=X_$P($P(ECALLEL,"^"_X,2),"^")
W $P($P(ECALLEL,"^"_X,2),"^")
;
;- If match found, exit with eligibility IEN from file #8
F ECELIEN=0:0 S ECELIEN=$O(VAEL(1,ECELIEN)) Q:'ECELIEN I $P(VAEL(1,ECELIEN),"^",2)=ECPRIMEL S ECELIG=+ECELIEN G ELGLSTQ
;
;- If default or error cond exit with IEN of primary elig from file #8
PRIMELG I ('$T)!(X["^") D ELIGERR^ECUTL0
I ('$T)!(X["^")!($P(VAEL(1),"^",2)=ECPRIMEL) S ECELIG=+$P(VAEL(1),"^")
;
ELGLSTQ Q ECELIG
;
;
MULTELG(DFN) ; Determine if patient has multiple eligibilites (calls
; ELIG^VADPT).
;
; Input:
; DFN - IEN of Patient file (#2)
; Output:
; Function value - 0 if no additional eligibilities exist,
; otherwise a number greater than 0 if addt'l eligibilities exist
;
D ELIG^VADPT
Q +$O(VAEL(1,0))
;
;
ASKIF(ELIGNM) ; Ask user whether to edit the eligibility during the edit
; of an existing EC Patient file (#721) record
;
; Input:
; ELIGNM - Eligibility Name
;
; Output:
; Function value - 1 if user wants to edit eligibility
; 0 if user does not want to edit eligibility
; -1 if uparrow or time out
;
N DIR
Q:$G(ELIGNM)="" 0
;- Display patient's current eligibility
W !!,"The eligibility previously filed for this patient's procedure is:",!?5,ELIGNM,!!
;- Ask user
S DIR(0)="YA"
S DIR("A")="Do you wish to edit the patient's eligibility? "
S DIR("B")="NO"
D ^DIR
Q $S($D(DIRUT):-1,'Y:0,1:Y)
;
;
ELIGERR ; If user uparrows or times out while choosing eligibility, display
; primary eligibility msg to screen
;
; Input:
; None
;
; Output:
; Display primary eligibility message to screen
;
W !!?5,"No eligibility entered. The primary eligibility of the patient"
W !?5,"will be sent to PCE for workload reporting (if the patient's"
W !?5,"procedure data is complete).",!
Q
;
;
INOUTPT(DFN,PROCDT) ; Determine inpatient/outpatient status
;
; Input:
; DFN - IEN of Patient file (#2)
; PROCDT - Procedure Date/Time
;
; Output:
; Function value - I if inpatient, O if outpatient, null if error
;
N ECPTSTAT
S ECPTSTAT=1
I '$G(DFN)!('$G(PROCDT)) S ECPTSTAT=0
;
;- Call inpat/outpat function if both input variables are present
I ECPTSTAT D
. S ECPTSTAT=$$INP^SDAM2(DFN,PROCDT)
. I $G(ECPTSTAT)="" S ECPTSTAT="O"
;
;- If either one of input variables are missing, return null (otherwise
; return "I" or "O")
Q $S(ECPTSTAT=0:"",1:ECPTSTAT)
;
;
DSPSTAT(ECSTAT) ; Display inpatient/outpatient status
;
; Input:
; ECSTAT - Inpatient/Outpatient status (I=inpatient, O=outpatient)
;
; Output:
; Display inpatient/outpatient status to screen
;
N ECTXT
S ECTXT="This patient is an "
W !!,ECTXT_$S(ECSTAT="I":"Inpatient",1:"Outpatient"),!
Q
;
;
INOUTERR ; Display inpat/outpat status error msg to screen and set exit
; variable
;
; Input:
; None
;
; Output:
; Display error message to screen
;
W !,"Patient record data or procedure date/time data is missing. No action taken."
S ECOUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUTL0 5154 printed Sep 23, 2025@19:35:16 Page 2
ECUTL0 ;ALB/ESD - Event Capture Eligibility and In/Outpat Utilities ;2/9/18 16:51
+1 ;;2.0;EVENT CAPTURE;**10,139**;8 May 96;Build 7
+2 ;
+3 ;
CHKDSS(DSSU,INOUT) ; Determine if DSS Unit is sending data to PCE
+1 ;
+2 ; Input:
+3 ; DSSU - DSS Unit IEN
+4 ; INOUT - Inpatient or Outpatient
+5 ;
+6 ; Output:
+7 ; Function Value - 0 if DSS Unit not sending to PCE or input
+8 ; parameters not passed in
+9 ; 1 if DSS Unit sending to PCE
+10 ;
+11 NEW ECDSS,ECSEND
+12 ;
+13 ;- Drops out if invalid condition
+14 Begin DoDot:1
+15 IF '$GET(DSSU)
IF ($GET(INOUT)="")
SET ECDSS=0
QUIT
+16 ;
+17 ;- Get 'Send to PCE' field
+18 SET ECSEND=$PIECE($GET(^ECD(+DSSU,0)),"^",14)
+19 ;139 Change logic to set to 1 if sending (asking SC related questions)
IF ECSEND="A"
SET ECDSS=1
+20 ;139 else we're not asking SC related questions
IF '$TEST
SET ECDSS=0
End DoDot:1
+21 QUIT ECDSS
+22 ;
+23 ;
ELGLST() ; Display list of patient eligibilities and allow user to
+1 ; select eligibility, given ELIG^VADPT has been previously called.
+2 ;
+3 ; Input:
+4 ; None
+5 ; Output:
+6 ; Function value - IEN of eligibility from ELIGIBILITY CODE file
+7 ; (#8) or 0 if unsuccessful
+8 ;
+9 NEW ECALLEL,ECELIEN,ECELIG,ECPRIMEL
+10 SET (ECELIEN,ECELIG)=0
+11 ;
+12 ;- If VAEL not previously called, exit with error condition
+13 IF '$DATA(VAEL)!('$GET(VAEL(1)))
GOTO ELGLSTQ
ELIG SET ECALLEL=""
+1 SET ECPRIMEL=$PIECE(VAEL(1),"^",2)
+2 WRITE !!,"THIS PATIENT HAS OTHER ENTITLED ELIGIBILITIES:"
+3 ;
+4 ;- Display all of patient's eligibilities
+5 FOR ECELIEN=0:0
SET ECELIEN=$ORDER(VAEL(1,ECELIEN))
if 'ECELIEN
QUIT
Begin DoDot:1
+6 WRITE !?5,$PIECE(VAEL(1,ECELIEN),"^",2)
+7 SET ECALLEL=ECALLEL_"^"_$PIECE(VAEL(1,ECELIEN),"^",2)
End DoDot:1
+8 ;
+9 ;- Use patient's primary elig as default
CHOOSE WRITE !!,"ENTER THE ELIGIBILITY FOR THIS APPOINTMENT: "_ECPRIMEL_"// "
+1 ;
+2 ;- If return, uparrow, or time out get prim elig w/o searching for match
+3 READ X:DTIME
if "^"[X!('$TEST)
GOTO PRIMELG
SET X=$$UPPER^VALM1(X)
if X["?"
GOTO ELIG
if ECALLEL'[("^"_X)
GOTO CHOOSE
+4 SET ECPRIMEL=X_$PIECE($PIECE(ECALLEL,"^"_X,2),"^")
+5 WRITE $PIECE($PIECE(ECALLEL,"^"_X,2),"^")
+6 ;
+7 ;- If match found, exit with eligibility IEN from file #8
+8 FOR ECELIEN=0:0
SET ECELIEN=$ORDER(VAEL(1,ECELIEN))
if 'ECELIEN
QUIT
IF $PIECE(VAEL(1,ECELIEN),"^",2)=ECPRIMEL
SET ECELIG=+ECELIEN
GOTO ELGLSTQ
+9 ;
+10 ;- If default or error cond exit with IEN of primary elig from file #8
PRIMELG IF ('$TEST)!(X["^")
DO ELIGERR^ECUTL0
+1 IF ('$TEST)!(X["^")!($PIECE(VAEL(1),"^",2)=ECPRIMEL)
SET ECELIG=+$PIECE(VAEL(1),"^")
+2 ;
ELGLSTQ QUIT ECELIG
+1 ;
+2 ;
MULTELG(DFN) ; Determine if patient has multiple eligibilites (calls
+1 ; ELIG^VADPT).
+2 ;
+3 ; Input:
+4 ; DFN - IEN of Patient file (#2)
+5 ; Output:
+6 ; Function value - 0 if no additional eligibilities exist,
+7 ; otherwise a number greater than 0 if addt'l eligibilities exist
+8 ;
+9 DO ELIG^VADPT
+10 QUIT +$ORDER(VAEL(1,0))
+11 ;
+12 ;
ASKIF(ELIGNM) ; Ask user whether to edit the eligibility during the edit
+1 ; of an existing EC Patient file (#721) record
+2 ;
+3 ; Input:
+4 ; ELIGNM - Eligibility Name
+5 ;
+6 ; Output:
+7 ; Function value - 1 if user wants to edit eligibility
+8 ; 0 if user does not want to edit eligibility
+9 ; -1 if uparrow or time out
+10 ;
+11 NEW DIR
+12 if $GET(ELIGNM)=""
QUIT 0
+13 ;- Display patient's current eligibility
+14 WRITE !!,"The eligibility previously filed for this patient's procedure is:",!?5,ELIGNM,!!
+15 ;- Ask user
+16 SET DIR(0)="YA"
+17 SET DIR("A")="Do you wish to edit the patient's eligibility? "
+18 SET DIR("B")="NO"
+19 DO ^DIR
+20 QUIT $SELECT($DATA(DIRUT):-1,'Y:0,1:Y)
+21 ;
+22 ;
ELIGERR ; If user uparrows or times out while choosing eligibility, display
+1 ; primary eligibility msg to screen
+2 ;
+3 ; Input:
+4 ; None
+5 ;
+6 ; Output:
+7 ; Display primary eligibility message to screen
+8 ;
+9 WRITE !!?5,"No eligibility entered. The primary eligibility of the patient"
+10 WRITE !?5,"will be sent to PCE for workload reporting (if the patient's"
+11 WRITE !?5,"procedure data is complete).",!
+12 QUIT
+13 ;
+14 ;
INOUTPT(DFN,PROCDT) ; Determine inpatient/outpatient status
+1 ;
+2 ; Input:
+3 ; DFN - IEN of Patient file (#2)
+4 ; PROCDT - Procedure Date/Time
+5 ;
+6 ; Output:
+7 ; Function value - I if inpatient, O if outpatient, null if error
+8 ;
+9 NEW ECPTSTAT
+10 SET ECPTSTAT=1
+11 IF '$GET(DFN)!('$GET(PROCDT))
SET ECPTSTAT=0
+12 ;
+13 ;- Call inpat/outpat function if both input variables are present
+14 IF ECPTSTAT
Begin DoDot:1
+15 SET ECPTSTAT=$$INP^SDAM2(DFN,PROCDT)
+16 IF $GET(ECPTSTAT)=""
SET ECPTSTAT="O"
End DoDot:1
+17 ;
+18 ;- If either one of input variables are missing, return null (otherwise
+19 ; return "I" or "O")
+20 QUIT $SELECT(ECPTSTAT=0:"",1:ECPTSTAT)
+21 ;
+22 ;
DSPSTAT(ECSTAT) ; Display inpatient/outpatient status
+1 ;
+2 ; Input:
+3 ; ECSTAT - Inpatient/Outpatient status (I=inpatient, O=outpatient)
+4 ;
+5 ; Output:
+6 ; Display inpatient/outpatient status to screen
+7 ;
+8 NEW ECTXT
+9 SET ECTXT="This patient is an "
+10 WRITE !!,ECTXT_$SELECT(ECSTAT="I":"Inpatient",1:"Outpatient"),!
+11 QUIT
+12 ;
+13 ;
INOUTERR ; Display inpat/outpat status error msg to screen and set exit
+1 ; variable
+2 ;
+3 ; Input:
+4 ; None
+5 ;
+6 ; Output:
+7 ; Display error message to screen
+8 ;
+9 WRITE !,"Patient record data or procedure date/time data is missing. No action taken."
+10 SET ECOUT=1
+11 QUIT
