Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRH1B

IBTRH1B.m

Go to the documentation of this file. 
  1. IBTRH1B ;ALB/FA - HCSR Worklist ;11-SEP-2014
  1.  ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;
  1.  ;
  1.  ; Contains Entry points and functions used in filtering/displaying the 
  1.  ; HCSR Worklist
  1.  ;
  1.  ; --------------------------   Entry Points   --------------------------------
  1.  ;    DELAY     - Protocol Action that allows the user to select multiple
  1.  ;                entries and remove them until a future date or until time
  1.  ;                of discharge.
  1.  ;    GETDDATE  - Returns the delay date for an entry being delayed
  1.  ;    RESPWR    - Protocol Action that allows the user to view the Response
  1.  ;                Worklist.
  1.  ;    SHOWFILT  - Displays the currently selected filter selections for the
  1.  ;                HCSR Worklist
  1.  ;-----------------------------------------------------------------------------
  1.  ;
  1. DELAY ;EP
  1.  ; Protocol action to remove selected HCSR Worklist entry(s) until a
  1.  ; selected date or until time of discharge
  1.  ; Input:   ^TMP("IBTRH1",$J)   - Current Array of displayed entries
  1.  ;          ^TMP($J,"IBTRHIX")  - Current Index of displayed entries
  1.  ; Output:  Selected Entry is removed from the worklist 
  1.  ;          Error messages display (potentially)
  1.  ;          ^TMP("IBTRH1",$J)   - Updated Array of displayed entries
  1.  ;          ^TMP($J,"IBTRHIX")  - Updated Index of displayed entries
  1.  N DDATE,DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,ERROR,FIELD,IEN,IX,LINE,MSG
  1.  N PROMPT,SDATA
  1.  D VALMSGH^IBTRH1                               ; Set flag legend
  1.  S VALMBCK="R",ERROR=0
  1.  S MSG="Are you sure you want to delay "
  1.  S PROMPT="Select the worklist entry(s) to be delayed"
  1.  ; 
  1.  ; First select the entry(s) to be delay review from the worklist
  1.  S EIENS=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,1)   ; Select the entry to be delayed
  1.  I EIENS="" S VALMBCK="R" Q
  1.  S DDATE=$$GETDDATE(DLINE)                      ; Get the selected delay date
  1.  Q:DDATE=""
  1.  S MSG=MSG_$S(DLINE[",":"Entries ",1:"Entry ")_DLINE_" until "
  1.  S MSG=MSG_$S(DDATE="D":"Discharge",1:$$FMTE^XLFDT(DDATE,"2Z"))
  1.  Q:'$$ASKSURE^IBTRH1(DLINE,MSG,1)               ; Final warning
  1.  F IX=1:1:$L(EIENS,",") D
  1.  . S EIEN=$P(EIENS,",",IX)
  1.  . S LINE=$P(DLINE,",",IX)
  1.  . ;
  1.  . ; Only allow delay of events for Inpatients
  1.  . I $P(^IBT(356.22,EIEN,0),"^",4)="O" D  Q
  1.  . . W !,*7,">>>> Entry ",LINE," is for an Outpatient and cannot be delayed"
  1.  . . S ERROR=1
  1.  . ;
  1.  . ; Only allow delay of events with no current status
  1.  . I +$P(^IBT(356.22,EIEN,0),"^",8)'=0 D  Q
  1.  . . W !,*7,">>>> Entry ",LINE," is being worked and cannot be delayed"
  1.  . . S ERROR=1
  1.  . ;
  1.  . ; Next set the delay date of the entry
  1.  . I '$$LOCKEV^IBTRH1(EIEN) D  Q
  1.  . . W !,*7,">>>> Someone else is editing entry ",LINE,". Try again later."
  1.  . . S ERROR=1
  1.  . ;
  1.  . K SDATA
  1.  . S IEN=EIEN_","
  1.  . S SDATA(356.22,IEN,.08)="08"                 ; Change Status
  1.  . S SDATA(356.22,IEN,.17)=DDATE                ; Set Status manual remove flag
  1.  . D FILE^DIE("","SDATA")
  1.  . D UNLOCKEV^IBTRH1(EIEN)
  1.  . ;
  1.  . ; Finally, flag the entry for next review
  1.  . S FIELD="*"_$E($G(^TMP("IBTRH1",$J,LINE,0)),7,23)
  1.  . D FLDTEXT^VALM10(LINE,"PAT NAME",FIELD)      ; Update flag display
  1.  . D WRITE^VALM10(LINE)                         ; Redisplay line
  1.  K DIR
  1.  D:ERROR PAUSE^VALM1
  1.  Q
  1.  ;
  1. GETDDATE(DLINE) ;EP
  1.  ; Allows the user to select a delay date which is used to remove
  1.  ; entries from the HCSR Worklist until the delay date has been met
  1.  ; Input:   DLINE   - Comma delimited list of entries to be delayed
  1.  ; Returns: DDATE   - 'D' to delay until admission has been discharged
  1.  ;                    Fileman internal date of when the entry will re-appear
  1.  ;                    null, if nothing selected
  1.  N CODE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,NOW,PROMPT,X,XX,Y
  1.  S PROMPT="Enter 'D' or Future Date for "
  1.  S XX=$S(DLINE[",":"Entries ",1:"Entry ")
  1.  S NOW=$$DT^XLFDT()
  1.  S CODE="I ((X'=""D"")&(X'=""d"")),X'="""" S XX=X,NOW=$$DT^XLFDT,X=XX D ^%DT K:Y'>NOW X"
  1.  S DIR(0)="FO^^"_CODE
  1.  S DIR("A")=PROMPT_XX_DLINE
  1.  S DIR("?",1)="Entry a future date or 'D' to delay until discharge.  A 'D' will remove the"
  1.  S DIR("?",2)="selected entries from the worklist until the patients have been discharged."
  1.  S DIR("?",3)="Entering a Date will remove the selected entries from the worklist until the"
  1.  S DIR("?")="selected date."
  1.  D ^DIR K DIR
  1.  Q:$G(DIRUT) ""
  1.  Q $$UP^XLFSTR(Y)
  1.  ;
  1. RESPWR ;EP
  1.  ; Protocol action to display the Response Worklist to show all Entries with
  1.  ; completed responses.
  1.  ; Input:   IBFILTS - Array of filter options currently set on the
  1.  ;                    HCSR Worklist
  1.  ; Output:  Response Worklist is shown with the current filter settings
  1.  N IBFILTSR
  1.  M IBFILTSR=IBFILTS
  1.  D EN^IBTRH5(.IBFILTSR)
  1.  Q
  1.  ;
  1. SHOWFILT(FILTERS)   ;EP
  1.  ; Displays the currently selected filter selections for the
  1.  ; HCSR Worklist
  1.  ; Input:   FILTERS()   - Array of filter settings. See FILTERS for a detailed
  1.  ;                        explanation of the FILTERS array
  1.  ; Output:  Current Filter settings are displayed
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IEN,IX,LEN,XX
  1.  W !!,"Show ChampVA/Tricare entries, CPAC entries or Both: "
  1.  W $S($P(FILTERS(0),"^",2)=0:"C",FILTERS(0)=1:"T",1:"B")
  1.  W !,"Show Inpatient entries, Outpatient entries or Both: "
  1.  W $S($P(FILTERS(0),"^",1)=0:"O",$P(FILTERS(0),"^",1)=1:"I",1:"B")
  1.  W !,"Show All Divisions or Selected Divisions: "
  1.  W $S($P(FILTERS(0),"^",3)=0:"All",1:"Selected")
  1.  ;
  1.  ; Division list (if any)
  1.  I ($P(FILTERS(0),"^",3)=1) D
  1.  . W !,"Divisions to Display: "
  1.  . S LEN=20
  1.  . F IX=1:1:$L(FILTERS(3),"^") D
  1.  . . S IEN=$P(FILTERS(3),"^",IX),XX=$$GET1^DIQ(40.8,IEN_",",.01)
  1.  . . S LEN=LEN+$L(XX)
  1.  . . I LEN+2<80 D  Q
  1.  . . . W XX
  1.  . . . I $P(FILTERS(3),"^",IX+1)'="" D
  1.  . . . . S LEN=LEN+2
  1.  . . . . W ", "
  1.  . . S LEN=20
  1.  . . W !,"                    ",XX
  1.  ;
  1.  ; Clinic Inclusion list (if any)
  1.  I ($P(FILTERS(0),"^",1)=0)!($P(FILTERS(0),"^",1)=2) D
  1.  . W !,"Clinics to Display: "
  1.  . I $G(FILTERS(1))="" W "ALL" Q
  1.  . S LEN=20
  1.  . F IX=1:1:$L(FILTERS(1),"^") D
  1.  . . S IEN=$P(FILTERS(1),"^",IX),XX=$$GET1^DIQ(44,IEN_",",.01)
  1.  . . S LEN=LEN+$L(XX)
  1.  . . I LEN+2<80 D  Q
  1.  . . . W XX
  1.  . . . I $P(FILTERS(1),"^",IX+1)'="" D
  1.  . . . . S LEN=LEN+2
  1.  . . . . W ", "
  1.  . . S LEN=20
  1.  . . W !,"                    ",XX
  1.  ;
  1.  ; Ward Inclusion list (if any)
  1.  I $P(FILTERS(0),"^",1)>0 D
  1.  . W !,"Wards to Display:   "
  1.  . I $G(FILTERS(2))="" W "ALL" Q
  1.  . S LEN=20
  1.  . F IX=1:1:$L(FILTERS(2),"^") D
  1.  . . S IEN=$P(FILTERS(2),"^",IX),XX=$$GET1^DIQ(42,IEN_",",.01)
  1.  . . S LEN=LEN+$L(XX)
  1.  . . I LEN+2<80 D  Q
  1.  . . . W XX
  1.  . . . W:$P(FILTERS(2),"^",IX+1)'="" ", "
  1.  . . W !,"                    ",XX
  1.  K DIR
  1.  D PAUSE^VALM1
  1.  Q
  1.  ;