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 Dec 13, 2024@02:28:07 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 ;
