- IBTRH5 ;ALB/FA - HCSR Response Worklist ;18-JUL-2014
- ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;
- ;
- EN(IBFILTSR) ;EP
- ; Main entry point for HCSR Response Worklist
- ; Input: IBFILTSR - Array of filter options from the HCSR Worklist
- ; NOTE: Any modifications done to these filters in the
- ; REFRESH menu action are not returned back to
- ; HCSR Worklist
- N HCSRSRTR
- D EN^VALM("IBT HCSR RESPONSE WORKLIST")
- Q
- ;
- HDR ;EP
- ; Header code for HCSR Response Worklist
- ; Input: HCSSRTR - Current sort selection
- ; Output: VALMHDR - Header information to display
- ; VALM("TITLE") - HCSR Response Worklist Title
- ; VALMSG - Initial Error line display
- N SORT
- S:$G(HCSRSRTR)="" HCSRSRTR="1^Oldest Entries First"
- S SORT=$P(HCSRSRTR,"^",2)
- S VALMHDR(1)=$$FILTBY^IBTRH1(.IBFILTSR)
- S VALMHDR(2)="Sorted By: "_SORT
- S VALM("TITLE")="HCSR Response Worklist"
- S VALMSG="#In-Prog"
- Q
- ;
- INIT ;EP
- ; Initialize variables and list array
- ; Input: None
- ; Output: HCSRSRTR - Initial worklist sort if not yet defined
- ; ^TMP("IBTRH5",$J) - Body lines to display
- K ^TMP("IBTRH5",$J),^TMP($J,"IBTRH5IX")
- S:$G(HCSRSRTR)="" HCSRSRTR="1^Oldest Entries First"
- D BLD
- Q
- ;
- BLD ; Build screen array, no variables required for input
- ; Input: HCSRSRTR - Current select sort type
- ; Output: ^TMP("IBTRH5",$J) - Body lines to display
- ; ^TMP($J,"IBTRH5S") - Sorted Body lines to display
- ; ^TMP($J,"IBTRH5IX") - Index of Event IENs by display line
- N DA,ECTR,LINE,S1,S2,S3,XSELCNT,XDA1
- D SORT1 ; Build the sorted list of lines to display
- S (ECTR,VALMCNT)=0,S1=""
- F S S1=$O(^TMP($J,"IBTRH5S",S1)) Q:S1="" D
- .S S2="" F S S2=$O(^TMP($J,"IBTRH5S",S1,S2)) Q:S2="" D
- .. S S3="" F S S3=$O(^TMP($J,"IBTRH5S",S1,S2,S3)) Q:S3="" D
- ... S DA="" F S DA=$O(^TMP($J,"IBTRH5S",S1,S2,S3,DA)) Q:DA="" D
- .... S ECTR=ECTR+1
- .... S LINE=^TMP($J,"IBTRH5S",S1,S2,S3,DA)
- .... S LINE=$$BLDLN(ECTR,LINE)
- .... S VALMCNT=VALMCNT+1,XSELCNT=$G(XSELCNT)+1
- .... D SET^VALM10(VALMCNT,LINE,XSELCNT)
- .... S ^TMP($J,"IBTRH5IX",XSELCNT)=DA
- .... S XDA1=$G(^IBT(356.22,DA,103))
- .... I $P(XDA1,"^",3)'="" D
- ..... N XREVDA1
- ..... D GETS^DIQ(356.021,$P(XDA1,"^",3),".01:.02",,"XREVDA1")
- ..... S VALMCNT=VALMCNT+1
- ..... D SET^VALM10(VALMCNT," Review Decision: "_XREVDA1(356.021,$P(XDA1,"^",3)_",",".01")_" - "_XREVDA1(356.021,$P(XDA1,"^",3)_",",".02"),XSELCNT)
- I VALMCNT=0 D
- . S ^TMP("IBTRH5",$J,1,0)="There are no events to display."
- Q
- ;
- BLDLN(ECTR,LINED) ; Builds a line to display on List screen for one event
- ; Input: ECTR - Event counter
- ; LINED - A1^A2^...A9 Where:
- ; A1 - Patient Name
- ; A2 - Patient Status ('I' or 'O')
- ; A3 - External Appt or Admission date
- ; A4 - Clinic or Ward name
- ; A5 - COB ('P', 'S' or 'T')
- ; A6 - Insurance Company Name
- ; A7 - Certification Action Code
- ; Output: LINE - Formatted for setting into the list display
- N LINE
- S LINE=$$SETSTR^VALM1(ECTR,"",1,4) ; Event #
- S LINE=$$SETSTR^VALM1($P(LINED,"^",1),LINE,6,23) ; Patient Name
- S LINE=$$SETSTR^VALM1($P(LINED,"^",2),LINE,30,1) ; Patient Status
- S LINE=$$SETSTR^VALM1($P(LINED,"^",3),LINE,32,8) ; Appt/Adm Date
- S LINE=$$SETSTR^VALM1($P(LINED,"^",4),LINE,41,10) ; Clinic or Ward
- S LINE=$$SETSTR^VALM1($P(LINED,"^",5),LINE,52,1) ; COB
- S LINE=$$SETSTR^VALM1($P(LINED,"^",6),LINE,55,14) ; Insurance Name
- S LINE=$$SETSTR^VALM1($P(LINED,"^",7),LINE,70,5) ; Certification Action Code
- Q LINE
- ;
- HELP ;EP
- ; Display HCSR Response worklist Help
- ; Input: None
- D FULL^VALM1
- S VALMBCK="R"
- W @IOF,"Flags displayed on screen for S (Patient Status):"
- W !," O - Outpatient"
- W !," I - Inpatient"
- W !!,"Flags displayed on screen for COB:"
- W !," P - Primary Insurance"
- W !," S - Secondary Insurance"
- W !," T - Tertiary"
- W !!,"Flags displayed for Cert Type (Certification Action):"
- W !," A1 - Certified in Total"
- W !," A2 - Certified in Partial"
- W !," A3 - Not Certified"
- W !," A6 - Modified "
- W !," C - Cancelled"
- W !," CT - Contact Payer"
- W !," NA - No Action Required"
- W !," 51 - Complete"
- W !," 71 - Term Expired"
- W !,"The following Status indicator may appear to the left of the patient name:"
- W !," # - 278 has been not been initiated, entry is in-progress"
- D PAUSE^VALM1
- Q
- ;
- DEL ;EP
- ; Protocol Action to select an entry to be manually removed from the
- ; Response Worklist
- ; Input: ^TMP("IBTRH5",$J) - Current Array of displayed entries
- ; ^TMP($J,"IBTRH5IX") - Current Index of displayed entries
- ; Output: Selected Entry is removed from the worklist
- ; Error messages display (potentially)
- ; ^TMP("IBTRH5",$J) - Updated Array of displayed entries
- ; ^TMP($J,"IBTRH5IX") - Updated Index of displayed entries
- N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,ERROR,IEN,IX,LINE,MSG
- N PROMPT,SDATA,DELRCODE,XCOM,COM,DIWETXT
- S VALMBCK="R",ERROR=0
- S VALMSG="#In-Prog"
- ; First select the entry(s) to be removed from the worklist
- S PROMPT="Select the worklist entry(s) to be deleted"
- S MSG="Are you sure you want to delete "
- ; Select the entry to be deleted
- S EIENS=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,1,"IBTRH5IX")
- I EIENS="" S VALMBCK="R" Q
- ;; 1/19/16 comment out delete reason code entry
- ;; enter a delete reason code
- D1 ;;
- ;;S DIC(0)="AEQM",DIC="^IBT(356.023,"
- ;;S DIC("A")="Select a Delete Reason Code: "
- ;;D ^DIC
- ;;I Y<0 Q:X="^" W !,*7,">>>> A Delete Reason Code must be selected, or '^' to exit." G D1
- ;;S DELRCODE=$P(Y,"^")
- ;; 1/19/16 commented out code above to enter delete reason code
- ;
- Q:'$$ASKSURE^IBTRH1(DLINE,MSG) ; Final warning
- F IX=1:1:$L(EIENS,",") D
- . S EIEN=$P(EIENS,",",IX)
- . S LINE=$P(DLINE,",",IX)
- . ; Next update the status to be manually removed
- . 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,.22)=1 ; Set Response manual remove flag
- . S SDATA(356.22,IEN,.23)=$$NOW^XLFDT() ; Set Manually Removed Date/Time
- . S SDATA(356.22,IEN,.24)=DUZ ; Set Manually Removed By User
- . ;;S SDATA(356.22,IEN,.25)=DELRCODE ; Set Delete Reason code pointer
- . I $P(^IBT(356.22,EIEN,0),"^",11)="" S SDATA(356.22,IEN,.11)=DUZ ; 517-T14: if REQUESTED BY is blank, set it to user deleting
- . D FILE^DIE("","SDATA")
- . D UNLOCKEV^IBTRH1(EIEN)
- K DIR
- Q
- ;
- EXIT ;EP
- ; Exit the HCSR Response worklist
- ; Input: None
- K ^TMP("IBTRH5",$J),^TMP($J,"IBTRH5IX"),^TMP($J,"IBTRH5S")
- K HCSRSRTR
- D CLEAR^VALM1
- Q
- ;
- SORT(NOIOF) ;EP
- ; Listman Protocol Action to sort the worklist
- ; Input: NOIOF - 1 to not write @IOF, 0 otherwise
- ; Optional, defaults to 0
- ; HCSRSRTR - Current sort selection
- ; Output: HCSRSRTR - New sort selection
- N CTR,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
- S:'$D(NOIOF) NOIOF=0
- D FULL^VALM1
- S CTR=1
- W:'NOIOF @IOF
- W !,"Select the item to sort the records on the HCSR Response Worklist screen."
- S XX="SO^"_CTR_":Oldest Entries First",CTR=CTR+1
- S XX=XX_";"_CTR_":Newest Entries First",CTR=CTR+1
- S:+IBFILTSR(0)=2 XX=XX_";"_CTR_":Outpatient Appointments First",CTR=CTR+1
- S:+IBFILTSR(0)=2 XX=XX_";"_CTR_":Inpatient Admissions First",CTR=CTR+1
- S XX=XX_";"_CTR_":Insurance Company Name",CTR=CTR+1
- S XX=XX_";"_CTR_":Certification Type"
- S DIR(0)=XX
- S DIR("A")="Sort the list by",DIR("B")=$P($G(HCSRSRTR),"^",2)
- D ^DIR K DIR
- I 'Y S VALMBCK="R" Q ; User quit or timed out
- S HCSRSRTR=Y_"^"_Y(0) ; Sort selection
- ; Rebuild and resort the list and update the list header
- D INIT,HDR
- S VALMBCK="R",VALMBG=1
- Q
- ;
- SORT1 ; Builds the sorted list of HCSR Responses to be displayed
- ; Input: HCSRSRTR - Current sort selection
- ; Output: ^TMP("IBTRH5S",$J) - Sorted Event entries to display
- ;
- N CSTAT,DISPDT,ECTR,EIEN,EVDT,EVENT,XX
- K ^TMP($J,"IBTRH5S")
- S XX=$P(^IBE(350.9,1,62),"^",12)*-1 ; # of days to display
- S CSTAT=5 ; Event status for responses
- S DISPDT=$$FMADD^XLFDT(DT,XX)
- S EVDT=DISPDT,ECTR=0
- F D Q:EVDT=""
- . S EVDT=$O(^IBT(356.22,"AD",CSTAT,EVDT))
- . Q:EVDT=""
- . S EIEN=""
- . F D Q:EIEN=""
- .. S EIEN=$O(^IBT(356.22,"AD",CSTAT,EVDT,EIEN))
- .. Q:EIEN=""
- .. S EVENT=$G(^IBT(356.22,EIEN,0))
- .. Q:$P(EVENT,"^",13)="" ; Not a Response entry - skip
- .. Q:$P(EVENT,"^",22)=1 ; Manually Removed - skip
- .. Q:$$SKIP(EIEN,EVENT) ; Entry is filtered out
- .. S ECTR=ECTR+1
- .. I '$D(ZTQUEUED),'(ECTR#15) W "."
- .. D ONEEVENT(CSTAT,EIEN,EVENT) ; Add one event to sort array
- Q
- ;
- SKIP(EIEN,EVENT) ; Checks to see if the specified event entry should display on
- ; the list
- ; Input: EIEN - IEN of the Event entry
- ; EVENT - Node0 of the Event Entry being checked
- ; IBFILTSR() - Array of filter settings. See FILTERS for a
- ; detailed explanation of the FILTERS array
- ; Returns: 1 - Don't display the entry on the list, 0 - Display entry on list
- N IEN,IORO,SKIP,TRICARE,NOW,XX,ZZ
- S IORO=$P(EVENT,"^",4) ; 'I' Inpatient, 'O' Outpatient
- S NOW=$$DT^XLFDT() ; Today's Internal Fileman date
- I IORO="I",$P(IBFILTSR(0),"^",1)=0 Q 1 ; Only show outpatients, skip
- I IORO="O",$P(IBFILTSR(0),"^",1)=1 Q 1 ; Only show inpatients, skip
- S TRICARE=$$TRICARE^IBTRH1A(EVENT) ; Is event for Tricare?
- I $P(IBFILTSR(0),"^",2)=0,TRICARE Q 1 ; Only show CPAC, Skip
- I $P(IBFILTSR(0),"^",2)=1,'TRICARE Q 1 ; Only show Champ/Tricare, Skip
- S SKIP=0
- ; Check Division filter
- I $D(IBFILTSR(3)) D Q:SKIP 1
- . S XX="^"_IBFILTSR(3)_"^",Y=1
- . S IEN=$P(EVENT,"^",5) ; Ward IEN
- . S:IEN="" IEN=$P(EVENT,"^",6),Y=0 ; Clinic IEN
- . I Y S ZZ=$$GET1^DIQ(42,IEN_",",.015,"I")
- . E S ZZ=$$GET1^DIQ(44,IEN_",",3.5,"I")
- . S ZZ="^"_ZZ_"^"
- . I XX'[ZZ S SKIP=1 ; Wrong division
- ; Check Inpatient entry
- I IORO="I" D Q:SKIP 1
- . Q:$G(IBFILTSR(2))="" ; No Ward filters display
- . S IEN=$P(EVENT,"^",5) ; Ward IEN
- . S XX="^"_IBFILTSR(2)_"^"
- . Q:XX[("^"_IEN_"^") ; On inclusion list display
- . S SKIP=1 ; Not on inclusion list skip
- ; Check Outpatient entry
- I IORO="O" D Q:SKIP 1
- . Q:$G(IBFILTSR(1))="" ; No Clinic filters display
- . S IEN=$P(EVENT,"^",6) ; Clinic IEN
- . S XX="^"_IBFILTSR(1)_"^"
- . Q:XX[("^"_IEN_"^") ; On inclusion list display
- . S SKIP=1
- Q 0 ; Display this entry
- ;
- ONEEVENT(CSTAT,EIEN,EVENT) ; Adds one event to the sorted list
- ; Input: HCSRSORT - Current sort selection
- ; CSTAT - Status of the event to be added
- ; EIEN - Internal IEN of the event being added
- ; EVENT - ^IBT(356.22,EIEN,0)
- ; Output: ^TMP("IBTRH5S",$J) - Sorted Event entries to display
- N ADATE,CERTCDE,DFN,ESTATUS,HS1,HS2,HS3,ICOB,IENS,IGROUP,IIEN,INAME,ISTATUS
- N LINE,PNAME,RFLG,IMIEN
- S (INAME,LINE)=""
- ; Symbol to display in front of the patient name (if any)
- S RFLG=$S($$GET1^DIQ(356.22,EIEN_",",.21,"I")=1:"#",1:" ")
- S DFN=$P(EVENT,"^",2),PNAME="" ; Patient IEN
- S ESTATUS=$P(EVENT,"^",4) ; Patient Status
- S $P(LINE,"^",2)=ESTATUS
- S ADATE=$P(EVENT,"^",7) ; Internal Appt/Adm Date/Tm
- S $P(LINE,"^",3)=$$FMTE^XLFDT(ADATE,"2DZ")
- S ISTATUS=1
- I ESTATUS="O",+HCSRSRTR=3 S ISTATUS=0 ; Appointment sort
- I ESTATUS="I",+HCSRSRTR=4 S ISTATUS=0 ; Admissions sort
- S $P(LINE,"^",1)=$$PNAME^IBTRH1A(DFN,RFLG,.PNAME) ; Set 'PAT NAME' column
- S $P(LINE,"^",4)=$$PATLOC^IBTRH1A(EVENT) ; Ward or Clinic
- S IMIEN=$P(EVENT,"^",3),IENS=IMIEN_","_DFN_"," ; Insurance Multiple IEN
- S IIEN=$$GET1^DIQ(2.312,IENS,.01,"I") ; Insurance Company IEN
- S IGROUP=$$GET1^DIQ(2.312,IENS,.18,"I") ; Insurance Group IEN
- S:+IIEN INAME=$$GET1^DIQ(36,IIEN_",",.01) ; Insurance Company Name
- S:INAME="" INAME="**DELETED**"
- S ICOB=$$GET1^DIQ(2.312,IENS,.2,"I") ; Level of COB External Display
- S:ICOB="" ICOB=1
- S $P(LINE,"^",5)=$S(ICOB=1:"P",ICOB=2:"S",1:"T") ; Level of COB External Display
- S CERTCDE=$$GET1^DIQ(356.22,EIEN_",",103.01)
- S $P(LINE,"^",6)=$E(INAME,1,14)
- I +HCSRSRTR=1 S HS1=ADATE,HS2=PNAME,HS3=ICOB ; Oldest event first
- I +HCSRSRTR=2 S HS1=ADATE*-1,HS2=PNAME,HS3=ICOB ; Newest event first
- I +HCSRSRTR=3 S HS1=ISTATUS,HS2=PNAME,HS3=ICOB ; Appointments first
- I +HCSRSRTR=4 S HS1=ISTATUS,HS2=PNAME,HS3=ICOB ; Admissions sort
- I +HCSRSRTR=5 D ; Insurance name sort
- . S HS1=$$UP^XLFSTR(INAME),HS2=PNAME,HS3=ICOB
- I +HCSRSRTR=6 S HS1=CERTCDE,HS2=PNAME,HS3=ADATE ; Certification Action sort
- S $P(LINE,"^",7)=CERTCDE
- S ^TMP($J,"IBTRH5S",HS1,HS2,HS3,EIEN)=LINE
- Q
- ;
- SELEVENT(FULL,PROMPT,DLINE) ;EP
- ; Select an Event to perform an action upon
- ; upon
- ; Input: FULL - 1 - full screen mode, 0 otherwise
- ; PROMPT - Prompt to be displayed to the user
- ; ^TMP("IBTRH5",$J) - Array of displayed events
- ; ^TMP($J,"IBTRH5IX") - Index of displayed lines
- ; Output: DLINE - Line # of the selected event
- ; Returns: EIN - IEN of the selected event or
- ; 0 if none selected
- N DIR,DIROUT,DIRUT,DTOUT,DUOUT,EIEN,X,Y
- D:FULL FULL^VALM1
- S DLINE=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action
- I $D(^TMP($J,"IBTRH5IX",+DLINE)) D Q EIEN
- . S EIEN=^TMP($J,"IBTRH5IX",DLINE)
- S DIR(0)="NO^"_VALMBG_":"_VALMLST_":0" ; Select an event from screen
- S DIR("A")=PROMPT
- D ^DIR K DIR
- Q:'Y 0
- S DLINE=Y,EIEN=^TMP($J,"IBTRH5IX",DLINE)
- Q EIEN
- ;
- REFRESH ;EP
- ; Protocol action to search for new Responses, reset filter
- ; and redisplay the HCSR Response Worklist
- ; Input: HCSSORTR - Current sort selection
- ; Output: IBFILTSR() - Array of filter criteria
- ; NOTE: Any modifications done to these filters
- ; are not returned back to HCSR Worklist.
- ; ^TMP("IBTRH5",$J) - Body lines to display
- ; ^TMP($J,"IBTRH5S") - Sorted Body lines to display
- ; ^TMP($J,"IBTRH5IX") - Index of Event IENs by display line
- ;
- ; First check to see if we can create more event entries
- D FULL^VALM1
- S VALMBCK="R"
- Q:'$$FILTERS^IBTRH1A(.IBFILTSR) ; Reset Filter criteria
- D SORT(1)
- ;;3/21/16 JWS don't need to D HDR,INIT - already done in SORT(1) above
- ;D HDR ; Redisplay the header
- ;D INIT ; Rebuild the worklist
- Q
- ;
- SEND278(EIEN) ;EP
- ; Protocol action to create a new 278 request from a response. Copies the
- ; Request data from the response's original request and then allows the
- ; user to edit it before sending the request
- ; Input: EIEN - IEN of the Response Entry to create a new worklist
- ; entry from. Optional, only set when called from
- ; Protocol IBT HCSR RESPONSE EE SEND278 - SR from
- ; the EE action off of the Response Worklist.
- N DLINE,IBTRENT,IBTRIEN,PROMPT,REIEN,SEIEN,IBRESP
- S SEIEN=$S($D(EIEN):EIEN,1:"")
- ;
- ; First select the entry to create a request for from the worklist
- S PROMPT="Select the worklist entry"
- S:SEIEN="" SEIEN=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,0,"IBTRH5IX")
- I SEIEN="" S VALMBCK="R" Q
- ; do not allow multiple 278s to be created from the same response
- I $P(^IBT(356.22,SEIEN,0),"^",27) D Q
- . W !,*7,">>>> A 278 request has already been created from this response message."
- . D PAUSE^VALM1
- ;
- ; Next Lock the response entry
- I '$$LOCKEV^IBTRH1(SEIEN) D Q
- . W !,*7,">>>> Someone else is editing this entry. Try again later."
- . D PAUSE^VALM1
- ; Copy the request
- S REIEN=$P(^IBT(356.22,SEIEN,0),"^",13) ; Original Request entry
- S IBTRIEN=$$CRTENTRY^IBTRH5C(REIEN,SEIEN,"","",1) ; Copy the original request
- D UNLOCKEV^IBTRH1(SEIEN) ; Unlock the response entry
- Q:IBTRIEN=0 ; Copy was unsuccessful
- ; Next Lock the new request entry
- I '$$LOCKEV^IBTRH1(IBTRIEN) D Q
- . W !,*7,">>>> Someone else is editing entry. Try again later."
- . D PAUSE^VALM1
- S IBTRENT=2 ; Flag to indicate origin from here
- D SEND278^IBTRH2 ; Create and Send the request
- D UNLOCKEV^IBTRH1(IBTRIEN) ; Unlock the request entry
- W !,"A new HCSR Worklist entry has been created for Response."
- D PAUSE^VALM1
- Q
- ;
- DELAY ;EP
- ; Protocol action to create a new request from the response but delay its
- ; viewing on the HCSR Worklist until admission of the entry has been
- ; discharged.
- ; Input: ^TMP("IBTRH5",$J) - Current Array of displayed entries
- ; ^TMP($J,"IBTRH5IX") - Current Index of displayed entries
- ; Output: A new Request is created from the Selected Entry (potentially)
- N DDATE,DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,FIELD,GOOD
- N IX,LINE,MSG,PROMPT,REIEN,SDATA
- S VALMBCK="R",GOOD=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,"IBTRH5IX")
- I EIENS="" S VALMBCK="R" Q
- S DDATE=$$GETDDATE^IBTRH1B(DLINE) ; Get 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)
- . ; do not allow multiple 278s to be created from the same response
- . I $P(^IBT(356.22,EIEN,0),"^",27) D Q
- .. W !,*7,">>>> A 278 request has already been created from this response message."
- . ; 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"
- . ; 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."
- . ; Copy the request
- . S GOOD=1
- . S REIEN=$P(^IBT(356.22,EIEN,0),"^",13) ; Original Request entry
- . S IBTRIEN=$$CRTENTRY^IBTRH5C(EIEN,REIEN,"","",1,DDATE) ; Copy original request
- . D UNLOCKEV^IBTRH1(EIEN)
- K DIR
- I GOOD D
- . W !!,$S(DLINE[",":"Entries ",1:"Entry ")_DLINE
- . W $S(DLINE[",":" have_",1:" has ")_"been delayed"
- D PAUSE^VALM1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH5 19658 printed Jan 18, 2025@03:29:18 Page 2
- IBTRH5 ;ALB/FA - HCSR Response Worklist ;18-JUL-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 ;
- EN(IBFILTSR) ;EP
- +1 ; Main entry point for HCSR Response Worklist
- +2 ; Input: IBFILTSR - Array of filter options from the HCSR Worklist
- +3 ; NOTE: Any modifications done to these filters in the
- +4 ; REFRESH menu action are not returned back to
- +5 ; HCSR Worklist
- +6 NEW HCSRSRTR
- +7 DO EN^VALM("IBT HCSR RESPONSE WORKLIST")
- +8 QUIT
- +9 ;
- HDR ;EP
- +1 ; Header code for HCSR Response Worklist
- +2 ; Input: HCSSRTR - Current sort selection
- +3 ; Output: VALMHDR - Header information to display
- +4 ; VALM("TITLE") - HCSR Response Worklist Title
- +5 ; VALMSG - Initial Error line display
- +6 NEW SORT
- +7 if $GET(HCSRSRTR)=""
- SET HCSRSRTR="1^Oldest Entries First"
- +8 SET SORT=$PIECE(HCSRSRTR,"^",2)
- +9 SET VALMHDR(1)=$$FILTBY^IBTRH1(.IBFILTSR)
- +10 SET VALMHDR(2)="Sorted By: "_SORT
- +11 SET VALM("TITLE")="HCSR Response Worklist"
- +12 SET VALMSG="#In-Prog"
- +13 QUIT
- +14 ;
- INIT ;EP
- +1 ; Initialize variables and list array
- +2 ; Input: None
- +3 ; Output: HCSRSRTR - Initial worklist sort if not yet defined
- +4 ; ^TMP("IBTRH5",$J) - Body lines to display
- +5 KILL ^TMP("IBTRH5",$JOB),^TMP($JOB,"IBTRH5IX")
- +6 if $GET(HCSRSRTR)=""
- SET HCSRSRTR="1^Oldest Entries First"
- +7 DO BLD
- +8 QUIT
- +9 ;
- BLD ; Build screen array, no variables required for input
- +1 ; Input: HCSRSRTR - Current select sort type
- +2 ; Output: ^TMP("IBTRH5",$J) - Body lines to display
- +3 ; ^TMP($J,"IBTRH5S") - Sorted Body lines to display
- +4 ; ^TMP($J,"IBTRH5IX") - Index of Event IENs by display line
- +5 NEW DA,ECTR,LINE,S1,S2,S3,XSELCNT,XDA1
- +6 ; Build the sorted list of lines to display
- DO SORT1
- +7 SET (ECTR,VALMCNT)=0
- SET S1=""
- +8 FOR
- SET S1=$ORDER(^TMP($JOB,"IBTRH5S",S1))
- if S1=""
- QUIT
- Begin DoDot:1
- +9 SET S2=""
- FOR
- SET S2=$ORDER(^TMP($JOB,"IBTRH5S",S1,S2))
- if S2=""
- QUIT
- Begin DoDot:2
- +10 SET S3=""
- FOR
- SET S3=$ORDER(^TMP($JOB,"IBTRH5S",S1,S2,S3))
- if S3=""
- QUIT
- Begin DoDot:3
- +11 SET DA=""
- FOR
- SET DA=$ORDER(^TMP($JOB,"IBTRH5S",S1,S2,S3,DA))
- if DA=""
- QUIT
- Begin DoDot:4
- +12 SET ECTR=ECTR+1
- +13 SET LINE=^TMP($JOB,"IBTRH5S",S1,S2,S3,DA)
- +14 SET LINE=$$BLDLN(ECTR,LINE)
- +15 SET VALMCNT=VALMCNT+1
- SET XSELCNT=$GET(XSELCNT)+1
- +16 DO SET^VALM10(VALMCNT,LINE,XSELCNT)
- +17 SET ^TMP($JOB,"IBTRH5IX",XSELCNT)=DA
- +18 SET XDA1=$GET(^IBT(356.22,DA,103))
- +19 IF $PIECE(XDA1,"^",3)'=""
- Begin DoDot:5
- +20 NEW XREVDA1
- +21 DO GETS^DIQ(356.021,$PIECE(XDA1,"^",3),".01:.02",,"XREVDA1")
- +22 SET VALMCNT=VALMCNT+1
- +23 DO SET^VALM10(VALMCNT," Review Decision: "_XREVDA1(356.021,$PIECE(XDA1,"^",3)_",",".01")_" - "_XREVDA1(356.021,$PIECE(XDA1,"^",3)_",",".02"),XSELCNT)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 IF VALMCNT=0
- Begin DoDot:1
- +25 SET ^TMP("IBTRH5",$JOB,1,0)="There are no events to display."
- End DoDot:1
- +26 QUIT
- +27 ;
- BLDLN(ECTR,LINED) ; Builds a line to display on List screen for one event
- +1 ; Input: ECTR - Event counter
- +2 ; LINED - A1^A2^...A9 Where:
- +3 ; A1 - Patient Name
- +4 ; A2 - Patient Status ('I' or 'O')
- +5 ; A3 - External Appt or Admission date
- +6 ; A4 - Clinic or Ward name
- +7 ; A5 - COB ('P', 'S' or 'T')
- +8 ; A6 - Insurance Company Name
- +9 ; A7 - Certification Action Code
- +10 ; Output: LINE - Formatted for setting into the list display
- +11 NEW LINE
- +12 ; Event #
- SET LINE=$$SETSTR^VALM1(ECTR,"",1,4)
- +13 ; Patient Name
- SET LINE=$$SETSTR^VALM1($PIECE(LINED,"^",1),LINE,6,23)
- +14 ; Patient Status
- SET LINE=$$SETSTR^VALM1($PIECE(LINED,"^",2),LINE,30,1)
- +15 ; Appt/Adm Date
- SET LINE=$$SETSTR^VALM1($PIECE(LINED,"^",3),LINE,32,8)
- +16 ; Clinic or Ward
- SET LINE=$$SETSTR^VALM1($PIECE(LINED,"^",4),LINE,41,10)
- +17 ; COB
- SET LINE=$$SETSTR^VALM1($PIECE(LINED,"^",5),LINE,52,1)
- +18 ; Insurance Name
- SET LINE=$$SETSTR^VALM1($PIECE(LINED,"^",6),LINE,55,14)
- +19 ; Certification Action Code
- SET LINE=$$SETSTR^VALM1($PIECE(LINED,"^",7),LINE,70,5)
- +20 QUIT LINE
- +21 ;
- HELP ;EP
- +1 ; Display HCSR Response worklist Help
- +2 ; Input: None
- +3 DO FULL^VALM1
- +4 SET VALMBCK="R"
- +5 WRITE @IOF,"Flags displayed on screen for S (Patient Status):"
- +6 WRITE !," O - Outpatient"
- +7 WRITE !," I - Inpatient"
- +8 WRITE !!,"Flags displayed on screen for COB:"
- +9 WRITE !," P - Primary Insurance"
- +10 WRITE !," S - Secondary Insurance"
- +11 WRITE !," T - Tertiary"
- +12 WRITE !!,"Flags displayed for Cert Type (Certification Action):"
- +13 WRITE !," A1 - Certified in Total"
- +14 WRITE !," A2 - Certified in Partial"
- +15 WRITE !," A3 - Not Certified"
- +16 WRITE !," A6 - Modified "
- +17 WRITE !," C - Cancelled"
- +18 WRITE !," CT - Contact Payer"
- +19 WRITE !," NA - No Action Required"
- +20 WRITE !," 51 - Complete"
- +21 WRITE !," 71 - Term Expired"
- +22 WRITE !,"The following Status indicator may appear to the left of the patient name:"
- +23 WRITE !," # - 278 has been not been initiated, entry is in-progress"
- +24 DO PAUSE^VALM1
- +25 QUIT
- +26 ;
- DEL ;EP
- +1 ; Protocol Action to select an entry to be manually removed from the
- +2 ; Response Worklist
- +3 ; Input: ^TMP("IBTRH5",$J) - Current Array of displayed entries
- +4 ; ^TMP($J,"IBTRH5IX") - Current Index of displayed entries
- +5 ; Output: Selected Entry is removed from the worklist
- +6 ; Error messages display (potentially)
- +7 ; ^TMP("IBTRH5",$J) - Updated Array of displayed entries
- +8 ; ^TMP($J,"IBTRH5IX") - Updated Index of displayed entries
- +9 NEW DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,ERROR,IEN,IX,LINE,MSG
- +10 NEW PROMPT,SDATA,DELRCODE,XCOM,COM,DIWETXT
- +11 SET VALMBCK="R"
- SET ERROR=0
- +12 SET VALMSG="#In-Prog"
- +13 ; First select the entry(s) to be removed from the worklist
- +14 SET PROMPT="Select the worklist entry(s) to be deleted"
- +15 SET MSG="Are you sure you want to delete "
- +16 ; Select the entry to be deleted
- +17 SET EIENS=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,1,"IBTRH5IX")
- +18 IF EIENS=""
- SET VALMBCK="R"
- QUIT
- +19 ;; 1/19/16 comment out delete reason code entry
- +20 ;; enter a delete reason code
- D1 ;;
- +1 ;;S DIC(0)="AEQM",DIC="^IBT(356.023,"
- +2 ;;S DIC("A")="Select a Delete Reason Code: "
- +3 ;;D ^DIC
- +4 ;;I Y<0 Q:X="^" W !,*7,">>>> A Delete Reason Code must be selected, or '^' to exit." G D1
- +5 ;;S DELRCODE=$P(Y,"^")
- +6 ;; 1/19/16 commented out code above to enter delete reason code
- +7 ;
- +8 ; Final warning
- if '$$ASKSURE^IBTRH1(DLINE,MSG)
- QUIT
- +9 FOR IX=1:1:$LENGTH(EIENS,",")
- Begin DoDot:1
- +10 SET EIEN=$PIECE(EIENS,",",IX)
- +11 SET LINE=$PIECE(DLINE,",",IX)
- +12 ; Next update the status to be manually removed
- +13 IF '$$LOCKEV^IBTRH1(EIEN)
- Begin DoDot:2
- +14 WRITE !,*7,">>>> Someone else is editing entry ",LINE,". Try again later."
- +15 SET ERROR=1
- End DoDot:2
- QUIT
- +16 KILL SDATA
- +17 SET IEN=EIEN_","
- +18 ; Set Response manual remove flag
- SET SDATA(356.22,IEN,.22)=1
- +19 ; Set Manually Removed Date/Time
- SET SDATA(356.22,IEN,.23)=$$NOW^XLFDT()
- +20 ; Set Manually Removed By User
- SET SDATA(356.22,IEN,.24)=DUZ
- +21 ;;S SDATA(356.22,IEN,.25)=DELRCODE ; Set Delete Reason code pointer
- +22 ; 517-T14: if REQUESTED BY is blank, set it to user deleting
- IF $PIECE(^IBT(356.22,EIEN,0),"^",11)=""
- SET SDATA(356.22,IEN,.11)=DUZ
- +23 DO FILE^DIE("","SDATA")
- +24 DO UNLOCKEV^IBTRH1(EIEN)
- End DoDot:1
- +25 KILL DIR
- +26 QUIT
- +27 ;
- EXIT ;EP
- +1 ; Exit the HCSR Response worklist
- +2 ; Input: None
- +3 KILL ^TMP("IBTRH5",$JOB),^TMP($JOB,"IBTRH5IX"),^TMP($JOB,"IBTRH5S")
- +4 KILL HCSRSRTR
- +5 DO CLEAR^VALM1
- +6 QUIT
- +7 ;
- SORT(NOIOF) ;EP
- +1 ; Listman Protocol Action to sort the worklist
- +2 ; Input: NOIOF - 1 to not write @IOF, 0 otherwise
- +3 ; Optional, defaults to 0
- +4 ; HCSRSRTR - Current sort selection
- +5 ; Output: HCSRSRTR - New sort selection
- +6 NEW CTR,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
- +7 if '$DATA(NOIOF)
- SET NOIOF=0
- +8 DO FULL^VALM1
- +9 SET CTR=1
- +10 if 'NOIOF
- WRITE @IOF
- +11 WRITE !,"Select the item to sort the records on the HCSR Response Worklist screen."
- +12 SET XX="SO^"_CTR_":Oldest Entries First"
- SET CTR=CTR+1
- +13 SET XX=XX_";"_CTR_":Newest Entries First"
- SET CTR=CTR+1
- +14 if +IBFILTSR(0)=2
- SET XX=XX_";"_CTR_":Outpatient Appointments First"
- SET CTR=CTR+1
- +15 if +IBFILTSR(0)=2
- SET XX=XX_";"_CTR_":Inpatient Admissions First"
- SET CTR=CTR+1
- +16 SET XX=XX_";"_CTR_":Insurance Company Name"
- SET CTR=CTR+1
- +17 SET XX=XX_";"_CTR_":Certification Type"
- +18 SET DIR(0)=XX
- +19 SET DIR("A")="Sort the list by"
- SET DIR("B")=$PIECE($GET(HCSRSRTR),"^",2)
- +20 DO ^DIR
- KILL DIR
- +21 ; User quit or timed out
- IF 'Y
- SET VALMBCK="R"
- QUIT
- +22 ; Sort selection
- SET HCSRSRTR=Y_"^"_Y(0)
- +23 ; Rebuild and resort the list and update the list header
- +24 DO INIT
- DO HDR
- +25 SET VALMBCK="R"
- SET VALMBG=1
- +26 QUIT
- +27 ;
- SORT1 ; Builds the sorted list of HCSR Responses to be displayed
- +1 ; Input: HCSRSRTR - Current sort selection
- +2 ; Output: ^TMP("IBTRH5S",$J) - Sorted Event entries to display
- +3 ;
- +4 NEW CSTAT,DISPDT,ECTR,EIEN,EVDT,EVENT,XX
- +5 KILL ^TMP($JOB,"IBTRH5S")
- +6 ; # of days to display
- SET XX=$PIECE(^IBE(350.9,1,62),"^",12)*-1
- +7 ; Event status for responses
- SET CSTAT=5
- +8 SET DISPDT=$$FMADD^XLFDT(DT,XX)
- +9 SET EVDT=DISPDT
- SET ECTR=0
- +10 FOR
- Begin DoDot:1
- +11 SET EVDT=$ORDER(^IBT(356.22,"AD",CSTAT,EVDT))
- +12 if EVDT=""
- QUIT
- +13 SET EIEN=""
- +14 FOR
- Begin DoDot:2
- +15 SET EIEN=$ORDER(^IBT(356.22,"AD",CSTAT,EVDT,EIEN))
- +16 if EIEN=""
- QUIT
- +17 SET EVENT=$GET(^IBT(356.22,EIEN,0))
- +18 ; Not a Response entry - skip
- if $PIECE(EVENT,"^",13)=""
- QUIT
- +19 ; Manually Removed - skip
- if $PIECE(EVENT,"^",22)=1
- QUIT
- +20 ; Entry is filtered out
- if $$SKIP(EIEN,EVENT)
- QUIT
- +21 SET ECTR=ECTR+1
- +22 IF '$DATA(ZTQUEUED)
- IF '(ECTR#15)
- WRITE "."
- +23 ; Add one event to sort array
- DO ONEEVENT(CSTAT,EIEN,EVENT)
- End DoDot:2
- if EIEN=""
- QUIT
- End DoDot:1
- if EVDT=""
- QUIT
- +24 QUIT
- +25 ;
- SKIP(EIEN,EVENT) ; Checks to see if the specified event entry should display on
- +1 ; the list
- +2 ; Input: EIEN - IEN of the Event entry
- +3 ; EVENT - Node0 of the Event Entry being checked
- +4 ; IBFILTSR() - Array of filter settings. See FILTERS for a
- +5 ; detailed explanation of the FILTERS array
- +6 ; Returns: 1 - Don't display the entry on the list, 0 - Display entry on list
- +7 NEW IEN,IORO,SKIP,TRICARE,NOW,XX,ZZ
- +8 ; 'I' Inpatient, 'O' Outpatient
- SET IORO=$PIECE(EVENT,"^",4)
- +9 ; Today's Internal Fileman date
- SET NOW=$$DT^XLFDT()
- +10 ; Only show outpatients, skip
- IF IORO="I"
- IF $PIECE(IBFILTSR(0),"^",1)=0
- QUIT 1
- +11 ; Only show inpatients, skip
- IF IORO="O"
- IF $PIECE(IBFILTSR(0),"^",1)=1
- QUIT 1
- +12 ; Is event for Tricare?
- SET TRICARE=$$TRICARE^IBTRH1A(EVENT)
- +13 ; Only show CPAC, Skip
- IF $PIECE(IBFILTSR(0),"^",2)=0
- IF TRICARE
- QUIT 1
- +14 ; Only show Champ/Tricare, Skip
- IF $PIECE(IBFILTSR(0),"^",2)=1
- IF 'TRICARE
- QUIT 1
- +15 SET SKIP=0
- +16 ; Check Division filter
- +17 IF $DATA(IBFILTSR(3))
- Begin DoDot:1
- +18 SET XX="^"_IBFILTSR(3)_"^"
- SET Y=1
- +19 ; Ward IEN
- SET IEN=$PIECE(EVENT,"^",5)
- +20 ; Clinic IEN
- if IEN=""
- SET IEN=$PIECE(EVENT,"^",6)
- SET Y=0
- +21 IF Y
- SET ZZ=$$GET1^DIQ(42,IEN_",",.015,"I")
- +22 IF '$TEST
- SET ZZ=$$GET1^DIQ(44,IEN_",",3.5,"I")
- +23 SET ZZ="^"_ZZ_"^"
- +24 ; Wrong division
- IF XX'[ZZ
- SET SKIP=1
- End DoDot:1
- if SKIP
- QUIT 1
- +25 ; Check Inpatient entry
- +26 IF IORO="I"
- Begin DoDot:1
- +27 ; No Ward filters display
- if $GET(IBFILTSR(2))=""
- QUIT
- +28 ; Ward IEN
- SET IEN=$PIECE(EVENT,"^",5)
- +29 SET XX="^"_IBFILTSR(2)_"^"
- +30 ; On inclusion list display
- if XX[("^"_IEN_"^")
- QUIT
- +31 ; Not on inclusion list skip
- SET SKIP=1
- End DoDot:1
- if SKIP
- QUIT 1
- +32 ; Check Outpatient entry
- +33 IF IORO="O"
- Begin DoDot:1
- +34 ; No Clinic filters display
- if $GET(IBFILTSR(1))=""
- QUIT
- +35 ; Clinic IEN
- SET IEN=$PIECE(EVENT,"^",6)
- +36 SET XX="^"_IBFILTSR(1)_"^"
- +37 ; On inclusion list display
- if XX[("^"_IEN_"^")
- QUIT
- +38 SET SKIP=1
- End DoDot:1
- if SKIP
- QUIT 1
- +39 ; Display this entry
- QUIT 0
- +40 ;
- ONEEVENT(CSTAT,EIEN,EVENT) ; Adds one event to the sorted list
- +1 ; Input: HCSRSORT - Current sort selection
- +2 ; CSTAT - Status of the event to be added
- +3 ; EIEN - Internal IEN of the event being added
- +4 ; EVENT - ^IBT(356.22,EIEN,0)
- +5 ; Output: ^TMP("IBTRH5S",$J) - Sorted Event entries to display
- +6 NEW ADATE,CERTCDE,DFN,ESTATUS,HS1,HS2,HS3,ICOB,IENS,IGROUP,IIEN,INAME,ISTATUS
- +7 NEW LINE,PNAME,RFLG,IMIEN
- +8 SET (INAME,LINE)=""
- +9 ; Symbol to display in front of the patient name (if any)
- +10 SET RFLG=$SELECT($$GET1^DIQ(356.22,EIEN_",",.21,"I")=1:"#",1:" ")
- +11 ; Patient IEN
- SET DFN=$PIECE(EVENT,"^",2)
- SET PNAME=""
- +12 ; Patient Status
- SET ESTATUS=$PIECE(EVENT,"^",4)
- +13 SET $PIECE(LINE,"^",2)=ESTATUS
- +14 ; Internal Appt/Adm Date/Tm
- SET ADATE=$PIECE(EVENT,"^",7)
- +15 SET $PIECE(LINE,"^",3)=$$FMTE^XLFDT(ADATE,"2DZ")
- +16 SET ISTATUS=1
- +17 ; Appointment sort
- IF ESTATUS="O"
- IF +HCSRSRTR=3
- SET ISTATUS=0
- +18 ; Admissions sort
- IF ESTATUS="I"
- IF +HCSRSRTR=4
- SET ISTATUS=0
- +19 ; Set 'PAT NAME' column
- SET $PIECE(LINE,"^",1)=$$PNAME^IBTRH1A(DFN,RFLG,.PNAME)
- +20 ; Ward or Clinic
- SET $PIECE(LINE,"^",4)=$$PATLOC^IBTRH1A(EVENT)
- +21 ; Insurance Multiple IEN
- SET IMIEN=$PIECE(EVENT,"^",3)
- SET IENS=IMIEN_","_DFN_","
- +22 ; Insurance Company IEN
- SET IIEN=$$GET1^DIQ(2.312,IENS,.01,"I")
- +23 ; Insurance Group IEN
- SET IGROUP=$$GET1^DIQ(2.312,IENS,.18,"I")
- +24 ; Insurance Company Name
- if +IIEN
- SET INAME=$$GET1^DIQ(36,IIEN_",",.01)
- +25 if INAME=""
- SET INAME="**DELETED**"
- +26 ; Level of COB External Display
- SET ICOB=$$GET1^DIQ(2.312,IENS,.2,"I")
- +27 if ICOB=""
- SET ICOB=1
- +28 ; Level of COB External Display
- SET $PIECE(LINE,"^",5)=$SELECT(ICOB=1:"P",ICOB=2:"S",1:"T")
- +29 SET CERTCDE=$$GET1^DIQ(356.22,EIEN_",",103.01)
- +30 SET $PIECE(LINE,"^",6)=$EXTRACT(INAME,1,14)
- +31 ; Oldest event first
- IF +HCSRSRTR=1
- SET HS1=ADATE
- SET HS2=PNAME
- SET HS3=ICOB
- +32 ; Newest event first
- IF +HCSRSRTR=2
- SET HS1=ADATE*-1
- SET HS2=PNAME
- SET HS3=ICOB
- +33 ; Appointments first
- IF +HCSRSRTR=3
- SET HS1=ISTATUS
- SET HS2=PNAME
- SET HS3=ICOB
- +34 ; Admissions sort
- IF +HCSRSRTR=4
- SET HS1=ISTATUS
- SET HS2=PNAME
- SET HS3=ICOB
- +35 ; Insurance name sort
- IF +HCSRSRTR=5
- Begin DoDot:1
- +36 SET HS1=$$UP^XLFSTR(INAME)
- SET HS2=PNAME
- SET HS3=ICOB
- End DoDot:1
- +37 ; Certification Action sort
- IF +HCSRSRTR=6
- SET HS1=CERTCDE
- SET HS2=PNAME
- SET HS3=ADATE
- +38 SET $PIECE(LINE,"^",7)=CERTCDE
- +39 SET ^TMP($JOB,"IBTRH5S",HS1,HS2,HS3,EIEN)=LINE
- +40 QUIT
- +41 ;
- SELEVENT(FULL,PROMPT,DLINE) ;EP
- +1 ; Select an Event to perform an action upon
- +2 ; upon
- +3 ; Input: FULL - 1 - full screen mode, 0 otherwise
- +4 ; PROMPT - Prompt to be displayed to the user
- +5 ; ^TMP("IBTRH5",$J) - Array of displayed events
- +6 ; ^TMP($J,"IBTRH5IX") - Index of displayed lines
- +7 ; Output: DLINE - Line # of the selected event
- +8 ; Returns: EIN - IEN of the selected event or
- +9 ; 0 if none selected
- +10 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,EIEN,X,Y
- +11 if FULL
- DO FULL^VALM1
- +12 ; User selection with action
- SET DLINE=$PIECE($PIECE($GET(XQORNOD(0)),"^",4),"=",2)
- +13 IF $DATA(^TMP($JOB,"IBTRH5IX",+DLINE))
- Begin DoDot:1
- +14 SET EIEN=^TMP($JOB,"IBTRH5IX",DLINE)
- End DoDot:1
- QUIT EIEN
- +15 ; Select an event from screen
- SET DIR(0)="NO^"_VALMBG_":"_VALMLST_":0"
- +16 SET DIR("A")=PROMPT
- +17 DO ^DIR
- KILL DIR
- +18 if 'Y
- QUIT 0
- +19 SET DLINE=Y
- SET EIEN=^TMP($JOB,"IBTRH5IX",DLINE)
- +20 QUIT EIEN
- +21 ;
- REFRESH ;EP
- +1 ; Protocol action to search for new Responses, reset filter
- +2 ; and redisplay the HCSR Response Worklist
- +3 ; Input: HCSSORTR - Current sort selection
- +4 ; Output: IBFILTSR() - Array of filter criteria
- +5 ; NOTE: Any modifications done to these filters
- +6 ; are not returned back to HCSR Worklist.
- +7 ; ^TMP("IBTRH5",$J) - Body lines to display
- +8 ; ^TMP($J,"IBTRH5S") - Sorted Body lines to display
- +9 ; ^TMP($J,"IBTRH5IX") - Index of Event IENs by display line
- +10 ;
- +11 ; First check to see if we can create more event entries
- +12 DO FULL^VALM1
- +13 SET VALMBCK="R"
- +14 ; Reset Filter criteria
- if '$$FILTERS^IBTRH1A(.IBFILTSR)
- QUIT
- +15 DO SORT(1)
- +16 ;;3/21/16 JWS don't need to D HDR,INIT - already done in SORT(1) above
- +17 ;D HDR ; Redisplay the header
- +18 ;D INIT ; Rebuild the worklist
- +19 QUIT
- +20 ;
- SEND278(EIEN) ;EP
- +1 ; Protocol action to create a new 278 request from a response. Copies the
- +2 ; Request data from the response's original request and then allows the
- +3 ; user to edit it before sending the request
- +4 ; Input: EIEN - IEN of the Response Entry to create a new worklist
- +5 ; entry from. Optional, only set when called from
- +6 ; Protocol IBT HCSR RESPONSE EE SEND278 - SR from
- +7 ; the EE action off of the Response Worklist.
- +8 NEW DLINE,IBTRENT,IBTRIEN,PROMPT,REIEN,SEIEN,IBRESP
- +9 SET SEIEN=$SELECT($DATA(EIEN):EIEN,1:"")
- +10 ;
- +11 ; First select the entry to create a request for from the worklist
- +12 SET PROMPT="Select the worklist entry"
- +13 if SEIEN=""
- SET SEIEN=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,0,"IBTRH5IX")
- +14 IF SEIEN=""
- SET VALMBCK="R"
- QUIT
- +15 ; do not allow multiple 278s to be created from the same response
- +16 IF $PIECE(^IBT(356.22,SEIEN,0),"^",27)
- Begin DoDot:1
- +17 WRITE !,*7,">>>> A 278 request has already been created from this response message."
- +18 DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +19 ;
- +20 ; Next Lock the response entry
- +21 IF '$$LOCKEV^IBTRH1(SEIEN)
- Begin DoDot:1
- +22 WRITE !,*7,">>>> Someone else is editing this entry. Try again later."
- +23 DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +24 ; Copy the request
- +25 ; Original Request entry
- SET REIEN=$PIECE(^IBT(356.22,SEIEN,0),"^",13)
- +26 ; Copy the original request
- SET IBTRIEN=$$CRTENTRY^IBTRH5C(REIEN,SEIEN,"","",1)
- +27 ; Unlock the response entry
- DO UNLOCKEV^IBTRH1(SEIEN)
- +28 ; Copy was unsuccessful
- if IBTRIEN=0
- QUIT
- +29 ; Next Lock the new request entry
- +30 IF '$$LOCKEV^IBTRH1(IBTRIEN)
- Begin DoDot:1
- +31 WRITE !,*7,">>>> Someone else is editing entry. Try again later."
- +32 DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +33 ; Flag to indicate origin from here
- SET IBTRENT=2
- +34 ; Create and Send the request
- DO SEND278^IBTRH2
- +35 ; Unlock the request entry
- DO UNLOCKEV^IBTRH1(IBTRIEN)
- +36 WRITE !,"A new HCSR Worklist entry has been created for Response."
- +37 DO PAUSE^VALM1
- +38 QUIT
- +39 ;
- DELAY ;EP
- +1 ; Protocol action to create a new request from the response but delay its
- +2 ; viewing on the HCSR Worklist until admission of the entry has been
- +3 ; discharged.
- +4 ; Input: ^TMP("IBTRH5",$J) - Current Array of displayed entries
- +5 ; ^TMP($J,"IBTRH5IX") - Current Index of displayed entries
- +6 ; Output: A new Request is created from the Selected Entry (potentially)
- +7 NEW DDATE,DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,EIEN,EIENS,FIELD,GOOD
- +8 NEW IX,LINE,MSG,PROMPT,REIEN,SDATA
- +9 SET VALMBCK="R"
- SET GOOD=0
- +10 SET MSG="Are you sure you want to delay "
- +11 SET PROMPT="Select the worklist entry(s) to be delayed"
- +12 ; First select the entry(s) to be delay review from the worklist
- +13 SET EIENS=$$SELEVENT^IBTRH1(1,PROMPT,.DLINE,1,"IBTRH5IX")
- +14 IF EIENS=""
- SET VALMBCK="R"
- QUIT
- +15 ; Get delay date
- SET DDATE=$$GETDDATE^IBTRH1B(DLINE)
- +16 if DDATE=""
- QUIT
- +17 SET MSG=MSG_$SELECT(DLINE[",":"Entries ",1:"Entry ")_DLINE_" until "
- +18 SET MSG=MSG_$SELECT(DDATE="D":"Discharge",1:$$FMTE^XLFDT(DDATE,"2Z"))
- +19 ; Final warning
- if '$$ASKSURE^IBTRH1(DLINE,MSG,1)
- QUIT
- +20 FOR IX=1:1:$LENGTH(EIENS,",")
- Begin DoDot:1
- +21 SET EIEN=$PIECE(EIENS,",",IX)
- +22 SET LINE=$PIECE(DLINE,",",IX)
- +23 ; do not allow multiple 278s to be created from the same response
- +24 IF $PIECE(^IBT(356.22,EIEN,0),"^",27)
- Begin DoDot:2
- +25 WRITE !,*7,">>>> A 278 request has already been created from this response message."
- End DoDot:2
- QUIT
- +26 ; Only allow delay of events for Inpatients
- +27 IF $PIECE(^IBT(356.22,EIEN,0),"^",4)="O"
- Begin DoDot:2
- +28 WRITE !,*7,">>>> Entry ",LINE," is for an Outpatient and cannot be delayed"
- End DoDot:2
- QUIT
- +29 ; Next set the delay date of the entry
- +30 IF '$$LOCKEV^IBTRH1(EIEN)
- Begin DoDot:2
- +31 WRITE !,*7,">>>> Someone else is editing entry ",LINE,". Try again later."
- End DoDot:2
- QUIT
- +32 ; Copy the request
- +33 SET GOOD=1
- +34 ; Original Request entry
- SET REIEN=$PIECE(^IBT(356.22,EIEN,0),"^",13)
- +35 ; Copy original request
- SET IBTRIEN=$$CRTENTRY^IBTRH5C(EIEN,REIEN,"","",1,DDATE)
- +36 DO UNLOCKEV^IBTRH1(EIEN)
- End DoDot:1
- +37 KILL DIR
- +38 IF GOOD
- Begin DoDot:1
- +39 WRITE !!,$SELECT(DLINE[",":"Entries ",1:"Entry ")_DLINE
- +40 WRITE $SELECT(DLINE[",":" have_",1:" has ")_"been delayed"
- End DoDot:1
- +41 DO PAUSE^VALM1
- +42 QUIT
- +43 ;