- 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 Feb 18, 2025@23:25:36 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