IBTRH1B ;ALB/FA - HCSR Worklist ;11-SEP-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;;
;
; Contains Entry points and functions used in filtering/displaying the
; HCSR Worklist
;
; -------------------------- Entry Points --------------------------------
; DELAY - Protocol Action that allows the user to select multiple
; entries and remove them until a future date or until time
; of discharge.
; GETDDATE - Returns the delay date for an entry being delayed
; RESPWR - Protocol Action that allows the user to view the Response
; Worklist.
; SHOWFILT - Displays the currently selected filter selections for the
; HCSR Worklist
;-----------------------------------------------------------------------------
;
DELAY ;EP
; Protocol action to remove selected HCSR Worklist entry(s) until a
; selected date or until time of discharge
; Input: ^TMP("IBTRH1",$J) - Current Array of displayed entries
; ^TMP($J,"IBTRHIX") - Current Index of displayed entries
; Output: Selected Entry is removed from the worklist
; Error messages display (potentially)
; ^TMP("IBTRH1",$J) - Updated Array of displayed entries
; ^TMP($J,"IBTRHIX") - Updated Index of displayed entries
N DDATE,DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,ERROR,FIELD,IEN,IX,LINE,MSG
N PROMPT,SDATA
D VALMSGH^IBTRH1 ; Set flag legend
S VALMBCK="R",ERROR=0
S MSG="Are you sure you want to delay "
S PROMPT="Select the worklist entry(s) to be delayed"
;
; First select the entry(s) to be delay review from the worklist
S EIENS=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,1) ; Select the entry to be delayed
I EIENS="" S VALMBCK="R" Q
S DDATE=$$GETDDATE(DLINE) ; Get the selected delay date
Q:DDATE=""
S MSG=MSG_$S(DLINE[",":"Entries ",1:"Entry ")_DLINE_" until "
S MSG=MSG_$S(DDATE="D":"Discharge",1:$$FMTE^XLFDT(DDATE,"2Z"))
Q:'$$ASKSURE^IBTRH1(DLINE,MSG,1) ; Final warning
F IX=1:1:$L(EIENS,",") D
. S EIEN=$P(EIENS,",",IX)
. S LINE=$P(DLINE,",",IX)
. ;
. ; Only allow delay of events for Inpatients
. I $P(^IBT(356.22,EIEN,0),"^",4)="O" D Q
. . W !,*7,">>>> Entry ",LINE," is for an Outpatient and cannot be delayed"
. . S ERROR=1
. ;
. ; Only allow delay of events with no current status
. I +$P(^IBT(356.22,EIEN,0),"^",8)'=0 D Q
. . W !,*7,">>>> Entry ",LINE," is being worked and cannot be delayed"
. . S ERROR=1
. ;
. ; Next set the delay date of the entry
. I '$$LOCKEV^IBTRH1(EIEN) D Q
. . W !,*7,">>>> Someone else is editing entry ",LINE,". Try again later."
. . S ERROR=1
. ;
. K SDATA
. S IEN=EIEN_","
. S SDATA(356.22,IEN,.08)="08" ; Change Status
. S SDATA(356.22,IEN,.17)=DDATE ; Set Status manual remove flag
. D FILE^DIE("","SDATA")
. D UNLOCKEV^IBTRH1(EIEN)
. ;
. ; Finally, flag the entry for next review
. S FIELD="*"_$E($G(^TMP("IBTRH1",$J,LINE,0)),7,23)
. D FLDTEXT^VALM10(LINE,"PAT NAME",FIELD) ; Update flag display
. D WRITE^VALM10(LINE) ; Redisplay line
K DIR
D:ERROR PAUSE^VALM1
Q
;
GETDDATE(DLINE) ;EP
; Allows the user to select a delay date which is used to remove
; entries from the HCSR Worklist until the delay date has been met
; Input: DLINE - Comma delimited list of entries to be delayed
; Returns: DDATE - 'D' to delay until admission has been discharged
; Fileman internal date of when the entry will re-appear
; null, if nothing selected
N CODE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,NOW,PROMPT,X,XX,Y
S PROMPT="Enter 'D' or Future Date for "
S XX=$S(DLINE[",":"Entries ",1:"Entry ")
S NOW=$$DT^XLFDT()
S CODE="I ((X'=""D"")&(X'=""d"")),X'="""" S XX=X,NOW=$$DT^XLFDT,X=XX D ^%DT K:Y'>NOW X"
S DIR(0)="FO^^"_CODE
S DIR("A")=PROMPT_XX_DLINE
S DIR("?",1)="Entry a future date or 'D' to delay until discharge. A 'D' will remove the"
S DIR("?",2)="selected entries from the worklist until the patients have been discharged."
S DIR("?",3)="Entering a Date will remove the selected entries from the worklist until the"
S DIR("?")="selected date."
D ^DIR K DIR
Q:$G(DIRUT) ""
Q $$UP^XLFSTR(Y)
;
RESPWR ;EP
; Protocol action to display the Response Worklist to show all Entries with
; completed responses.
; Input: IBFILTS - Array of filter options currently set on the
; HCSR Worklist
; Output: Response Worklist is shown with the current filter settings
N IBFILTSR
M IBFILTSR=IBFILTS
D EN^IBTRH5(.IBFILTSR)
Q
;
SHOWFILT(FILTERS) ;EP
; Displays the currently selected filter selections for the
; HCSR Worklist
; Input: FILTERS() - Array of filter settings. See FILTERS for a detailed
; explanation of the FILTERS array
; Output: Current Filter settings are displayed
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IEN,IX,LEN,XX
W !!,"Show ChampVA/Tricare entries, CPAC entries or Both: "
W $S($P(FILTERS(0),"^",2)=0:"C",FILTERS(0)=1:"T",1:"B")
W !,"Show Inpatient entries, Outpatient entries or Both: "
W $S($P(FILTERS(0),"^",1)=0:"O",$P(FILTERS(0),"^",1)=1:"I",1:"B")
W !,"Show All Divisions or Selected Divisions: "
W $S($P(FILTERS(0),"^",3)=0:"All",1:"Selected")
;
; Division list (if any)
I ($P(FILTERS(0),"^",3)=1) D
. W !,"Divisions to Display: "
. S LEN=20
. F IX=1:1:$L(FILTERS(3),"^") D
. . S IEN=$P(FILTERS(3),"^",IX),XX=$$GET1^DIQ(40.8,IEN_",",.01)
. . S LEN=LEN+$L(XX)
. . I LEN+2<80 D Q
. . . W XX
. . . I $P(FILTERS(3),"^",IX+1)'="" D
. . . . S LEN=LEN+2
. . . . W ", "
. . S LEN=20
. . W !," ",XX
;
; Clinic Inclusion list (if any)
I ($P(FILTERS(0),"^",1)=0)!($P(FILTERS(0),"^",1)=2) D
. W !,"Clinics to Display: "
. I $G(FILTERS(1))="" W "ALL" Q
. S LEN=20
. F IX=1:1:$L(FILTERS(1),"^") D
. . S IEN=$P(FILTERS(1),"^",IX),XX=$$GET1^DIQ(44,IEN_",",.01)
. . S LEN=LEN+$L(XX)
. . I LEN+2<80 D Q
. . . W XX
. . . I $P(FILTERS(1),"^",IX+1)'="" D
. . . . S LEN=LEN+2
. . . . W ", "
. . S LEN=20
. . W !," ",XX
;
; Ward Inclusion list (if any)
I $P(FILTERS(0),"^",1)>0 D
. W !,"Wards to Display: "
. I $G(FILTERS(2))="" W "ALL" Q
. S LEN=20
. F IX=1:1:$L(FILTERS(2),"^") D
. . S IEN=$P(FILTERS(2),"^",IX),XX=$$GET1^DIQ(42,IEN_",",.01)
. . S LEN=LEN+$L(XX)
. . I LEN+2<80 D Q
. . . W XX
. . . W:$P(FILTERS(2),"^",IX+1)'="" ", "
. . W !," ",XX
K DIR
D PAUSE^VALM1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH1B 6760 printed Oct 16, 2024@18:28:37 Page 2
IBTRH1B ;ALB/FA - HCSR Worklist ;11-SEP-2014
+1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 ;
+5 ; Contains Entry points and functions used in filtering/displaying the
+6 ; HCSR Worklist
+7 ;
+8 ; -------------------------- Entry Points --------------------------------
+9 ; DELAY - Protocol Action that allows the user to select multiple
+10 ; entries and remove them until a future date or until time
+11 ; of discharge.
+12 ; GETDDATE - Returns the delay date for an entry being delayed
+13 ; RESPWR - Protocol Action that allows the user to view the Response
+14 ; Worklist.
+15 ; SHOWFILT - Displays the currently selected filter selections for the
+16 ; HCSR Worklist
+17 ;-----------------------------------------------------------------------------
+18 ;
DELAY ;EP
+1 ; Protocol action to remove selected HCSR Worklist entry(s) until a
+2 ; selected date or until time of discharge
+3 ; Input: ^TMP("IBTRH1",$J) - Current Array of displayed entries
+4 ; ^TMP($J,"IBTRHIX") - Current Index of displayed entries
+5 ; Output: Selected Entry is removed from the worklist
+6 ; Error messages display (potentially)
+7 ; ^TMP("IBTRH1",$J) - Updated Array of displayed entries
+8 ; ^TMP($J,"IBTRHIX") - Updated Index of displayed entries
+9 NEW DDATE,DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,ERROR,FIELD,IEN,IX,LINE,MSG
+10 NEW PROMPT,SDATA
+11 ; Set flag legend
DO VALMSGH^IBTRH1
+12 SET VALMBCK="R"
SET ERROR=0
+13 SET MSG="Are you sure you want to delay "
+14 SET PROMPT="Select the worklist entry(s) to be delayed"
+15 ;
+16 ; First select the entry(s) to be delay review from the worklist
+17 ; Select the entry to be delayed
SET EIENS=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,1)
+18 IF EIENS=""
SET VALMBCK="R"
QUIT
+19 ; Get the selected delay date
SET DDATE=$$GETDDATE(DLINE)
+20 if DDATE=""
QUIT
+21 SET MSG=MSG_$SELECT(DLINE[",":"Entries ",1:"Entry ")_DLINE_" until "
+22 SET MSG=MSG_$SELECT(DDATE="D":"Discharge",1:$$FMTE^XLFDT(DDATE,"2Z"))
+23 ; Final warning
if '$$ASKSURE^IBTRH1(DLINE,MSG,1)
QUIT
+24 FOR IX=1:1:$LENGTH(EIENS,",")
Begin DoDot:1
+25 SET EIEN=$PIECE(EIENS,",",IX)
+26 SET LINE=$PIECE(DLINE,",",IX)
+27 ;
+28 ; Only allow delay of events for Inpatients
+29 IF $PIECE(^IBT(356.22,EIEN,0),"^",4)="O"
Begin DoDot:2
+30 WRITE !,*7,">>>> Entry ",LINE," is for an Outpatient and cannot be delayed"
+31 SET ERROR=1
End DoDot:2
QUIT
+32 ;
+33 ; Only allow delay of events with no current status
+34 IF +$PIECE(^IBT(356.22,EIEN,0),"^",8)'=0
Begin DoDot:2
+35 WRITE !,*7,">>>> Entry ",LINE," is being worked and cannot be delayed"
+36 SET ERROR=1
End DoDot:2
QUIT
+37 ;
+38 ; Next set the delay date of the entry
+39 IF '$$LOCKEV^IBTRH1(EIEN)
Begin DoDot:2
+40 WRITE !,*7,">>>> Someone else is editing entry ",LINE,". Try again later."
+41 SET ERROR=1
End DoDot:2
QUIT
+42 ;
+43 KILL SDATA
+44 SET IEN=EIEN_","
+45 ; Change Status
SET SDATA(356.22,IEN,.08)="08"
+46 ; Set Status manual remove flag
SET SDATA(356.22,IEN,.17)=DDATE
+47 DO FILE^DIE("","SDATA")
+48 DO UNLOCKEV^IBTRH1(EIEN)
+49 ;
+50 ; Finally, flag the entry for next review
+51 SET FIELD="*"_$EXTRACT($GET(^TMP("IBTRH1",$JOB,LINE,0)),7,23)
+52 ; Update flag display
DO FLDTEXT^VALM10(LINE,"PAT NAME",FIELD)
+53 ; Redisplay line
DO WRITE^VALM10(LINE)
End DoDot:1
+54 KILL DIR
+55 if ERROR
DO PAUSE^VALM1
+56 QUIT
+57 ;
GETDDATE(DLINE) ;EP
+1 ; Allows the user to select a delay date which is used to remove
+2 ; entries from the HCSR Worklist until the delay date has been met
+3 ; Input: DLINE - Comma delimited list of entries to be delayed
+4 ; Returns: DDATE - 'D' to delay until admission has been discharged
+5 ; Fileman internal date of when the entry will re-appear
+6 ; null, if nothing selected
+7 NEW CODE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,NOW,PROMPT,X,XX,Y
+8 SET PROMPT="Enter 'D' or Future Date for "
+9 SET XX=$SELECT(DLINE[",":"Entries ",1:"Entry ")
+10 SET NOW=$$DT^XLFDT()
+11 SET CODE="I ((X'=""D"")&(X'=""d"")),X'="""" S XX=X,NOW=$$DT^XLFDT,X=XX D ^%DT K:Y'>NOW X"
+12 SET DIR(0)="FO^^"_CODE
+13 SET DIR("A")=PROMPT_XX_DLINE
+14 SET DIR("?",1)="Entry a future date or 'D' to delay until discharge. A 'D' will remove the"
+15 SET DIR("?",2)="selected entries from the worklist until the patients have been discharged."
+16 SET DIR("?",3)="Entering a Date will remove the selected entries from the worklist until the"
+17 SET DIR("?")="selected date."
+18 DO ^DIR
KILL DIR
+19 if $GET(DIRUT)
QUIT ""
+20 QUIT $$UP^XLFSTR(Y)
+21 ;
RESPWR ;EP
+1 ; Protocol action to display the Response Worklist to show all Entries with
+2 ; completed responses.
+3 ; Input: IBFILTS - Array of filter options currently set on the
+4 ; HCSR Worklist
+5 ; Output: Response Worklist is shown with the current filter settings
+6 NEW IBFILTSR
+7 MERGE IBFILTSR=IBFILTS
+8 DO EN^IBTRH5(.IBFILTSR)
+9 QUIT
+10 ;
SHOWFILT(FILTERS) ;EP
+1 ; Displays the currently selected filter selections for the
+2 ; HCSR Worklist
+3 ; Input: FILTERS() - Array of filter settings. See FILTERS for a detailed
+4 ; explanation of the FILTERS array
+5 ; Output: Current Filter settings are displayed
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,IEN,IX,LEN,XX
+7 WRITE !!,"Show ChampVA/Tricare entries, CPAC entries or Both: "
+8 WRITE $SELECT($PIECE(FILTERS(0),"^",2)=0:"C",FILTERS(0)=1:"T",1:"B")
+9 WRITE !,"Show Inpatient entries, Outpatient entries or Both: "
+10 WRITE $SELECT($PIECE(FILTERS(0),"^",1)=0:"O",$PIECE(FILTERS(0),"^",1)=1:"I",1:"B")
+11 WRITE !,"Show All Divisions or Selected Divisions: "
+12 WRITE $SELECT($PIECE(FILTERS(0),"^",3)=0:"All",1:"Selected")
+13 ;
+14 ; Division list (if any)
+15 IF ($PIECE(FILTERS(0),"^",3)=1)
Begin DoDot:1
+16 WRITE !,"Divisions to Display: "
+17 SET LEN=20
+18 FOR IX=1:1:$LENGTH(FILTERS(3),"^")
Begin DoDot:2
+19 SET IEN=$PIECE(FILTERS(3),"^",IX)
SET XX=$$GET1^DIQ(40.8,IEN_",",.01)
+20 SET LEN=LEN+$LENGTH(XX)
+21 IF LEN+2<80
Begin DoDot:3
+22 WRITE XX
+23 IF $PIECE(FILTERS(3),"^",IX+1)'=""
Begin DoDot:4
+24 SET LEN=LEN+2
+25 WRITE ", "
End DoDot:4
End DoDot:3
QUIT
+26 SET LEN=20
+27 WRITE !," ",XX
End DoDot:2
End DoDot:1
+28 ;
+29 ; Clinic Inclusion list (if any)
+30 IF ($PIECE(FILTERS(0),"^",1)=0)!($PIECE(FILTERS(0),"^",1)=2)
Begin DoDot:1
+31 WRITE !,"Clinics to Display: "
+32 IF $GET(FILTERS(1))=""
WRITE "ALL"
QUIT
+33 SET LEN=20
+34 FOR IX=1:1:$LENGTH(FILTERS(1),"^")
Begin DoDot:2
+35 SET IEN=$PIECE(FILTERS(1),"^",IX)
SET XX=$$GET1^DIQ(44,IEN_",",.01)
+36 SET LEN=LEN+$LENGTH(XX)
+37 IF LEN+2<80
Begin DoDot:3
+38 WRITE XX
+39 IF $PIECE(FILTERS(1),"^",IX+1)'=""
Begin DoDot:4
+40 SET LEN=LEN+2
+41 WRITE ", "
End DoDot:4
End DoDot:3
QUIT
+42 SET LEN=20
+43 WRITE !," ",XX
End DoDot:2
End DoDot:1
+44 ;
+45 ; Ward Inclusion list (if any)
+46 IF $PIECE(FILTERS(0),"^",1)>0
Begin DoDot:1
+47 WRITE !,"Wards to Display: "
+48 IF $GET(FILTERS(2))=""
WRITE "ALL"
QUIT
+49 SET LEN=20
+50 FOR IX=1:1:$LENGTH(FILTERS(2),"^")
Begin DoDot:2
+51 SET IEN=$PIECE(FILTERS(2),"^",IX)
SET XX=$$GET1^DIQ(42,IEN_",",.01)
+52 SET LEN=LEN+$LENGTH(XX)
+53 IF LEN+2<80
Begin DoDot:3
+54 WRITE XX
+55 if $PIECE(FILTERS(2),"^",IX+1)'=""
WRITE ", "
End DoDot:3
QUIT
+56 WRITE !," ",XX
End DoDot:2
End DoDot:1
+57 KILL DIR
+58 DO PAUSE^VALM1
+59 QUIT
+60 ;
