IBTRH2 ;ALB/YMG - HCSR worklist expand entry ;18-JUN-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; main entry point for IBT HCSR ENTRY
N DFN,DLINE,EVENTDT,IEN312,IEN36,INSNODE0,NODE0,IBTRNM,IBTRENT
S VALMBCK="R"
S IBTRNM="IBTRH2",IBTRENT=0
S IBTRIEN=+$$SELEVENT^IBTRH1(0,"Select entry",.DLINE) ; select entry to expand
I IBTRIEN'>0 Q
; try to lock the entry
I '$$LOCKEV^IBTRH1(IBTRIEN) D LOCKERR^IBTRH2A S VALMSG="?Await #In-Prog -RespErr !Unable +Pend *NextRev" D MSG^VALM10(VALMSG) Q
D EN^VALM("IBT HCSR ENTRY")
; unlock entry
D UNLOCKEV^IBTRH1(IBTRIEN)
Q
;
EN2(IBTRNM,IBTRIEN) ; Secondary entry point.
; IBTRNM is the calling routine name.
; IBTRIEN is the internal id for ^IBT(356.22)
I $G(IBTRNM)="" S VALMQUIT="" Q
I '$G(IBTRIEN) S VALMQUIT="" Q
N DFN,EVENTDT,IEN312,INSNODE0,NODE0
D INIT
Q
;
HDR ; header code
N VADM,VA,VAERR,Z
S Z=""
I +$G(DFN) D DEM^VADPT S Z=$E(VADM(1),1,28),Z=Z_$J("",35-$L(Z))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4)
S VALMHDR(1)=Z
Q
;
INIT ; init variables and list array
K ^TMP(IBTRNM,$J)
I '$G(IBTRIEN) S VALMQUIT="" Q
S NODE0=$G(^IBT(356.22,IBTRIEN,0))
S DFN=+$P(NODE0,U,2)
S IEN312=+$P(NODE0,U,3)
S INSNODE0="" S:IEN312>0 INSNODE0=$G(^DPT(DFN,.312,IEN312,0)) ; 0-node in file 2.312
S IEN36=+$P(INSNODE0,U)
S EVENTDT=$P(NODE0,U,7)
D BLD
Q
;
HELP ; help code
D FULL^VALM1
W !!,"This screen displays an expanded view of a Healthcare Services Review Worklist entry."
W !!,"The actions allow editing of data and transmission of HCSR inquiry."
D PAUSE^VALM1 S VALMBCK="R"
Q
;
EXIT ; exit code
K ^TMP(IBTRNM,$J)
D CLEAR^VALM1,CLEAN^VALM10
Q
;
BLD ; build screen array
N AAADATA,ADDR,CMTDATA,DATA36,DATA3553,IBL,IBLINE,IBY,IEN3553,IENS,PNDDATA,RESPONSE,STATUS,TMPARY,Z,Z0,Z1,Z2
S IEN3553=+$P(INSNODE0,U,18),STATUS=$$STATUS(IBTRIEN),RESPONSE=+$P($G(^IBT(356.22,IBTRIEN,0)),U,14)
I $P($G(^IBT(356.22,IBTRIEN,0)),U,20)=2 S RESPONSE=IBTRIEN
S VALMCNT=0
;
S IENS=IEN36_","
D GETS^DIQ(36,IENS,".01;1;.131:.133","EI","DATA36")
D SET(" ") S IBY=$J("",26)_"Insurance Company Information" D SET(IBY,"B") S IBLINE=""
S IBL="Name: ",IBY=$G(DATA36(36,IENS,.01,"E")),IBLINE=$$SETL("",IBY,IBL,10,30)
S IBL="Reimburse?: ",IBY=$G(DATA36(36,IENS,1,"E")),IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
D SET(IBLINE) S IBLINE=""
S IBL="Phone: ",IBY=$G(DATA36(36,IENS,.131,"E")),IBLINE=$$SETL(IBLINE,IBY,IBL,10,20)
S IBL="Billing Phone: ",IBY=$G(DATA36(36,IENS,.132,"E")),IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
D SET(IBLINE) S IBLINE=""
S IBL="Precert Phone: ",IBY=$G(DATA36(36,IENS,.133,"E")),IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
D SET(IBLINE) S IBLINE=""
D ADDR^IBTRH2A(36,IEN36,.111,.112,.113,.114,.115,.116,.ADDR)
S IBL="Address: ",IBY=ADDR(1),IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
D SET(IBLINE) S IBLINE=""
F Z=2:1:9 S IBL="",IBY=$G(ADDR(Z)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) D SET(IBLINE) S IBLINE=""
;
S IENS=IEN3553_","
D GETS^DIQ(355.3,IENS,".02:.09;.12;6.02;6.03;11",,"DATA3553")
D SET(" ") S IBY=$J("",29)_"Group/Plan Information" D SET(IBY,"B") S IBLINE=""
S IBL="Type Of Plan: ",IBY=$G(DATA3553(355.3,IENS,.09)),IBLINE=$$SETL("",IBY,IBL,16,40)
S IBL="Require UR: ",IBY=$G(DATA3553(355.3,IENS,.05)),IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
S IBL="Group?: ",IBY=$G(DATA3553(355.3,IENS,.02)),IBLINE=$$SETL("",IBY,IBL,16,3)
S IBL="Require Amb Cert: ",IBY=$G(DATA3553(355.3,IENS,.12)),IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
S IBL="Group Name: ",IBY=$G(DATA3553(355.3,IENS,.03)),IBLINE=$$SETL("",IBY,IBL,16,20)
S IBL="Require Pre-Cert: ",IBY=$G(DATA3553(355.3,IENS,.06)),IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
S IBL="Group Number: ",IBY=$G(DATA3553(355.3,IENS,.04)),IBLINE=$$SETL("",IBY,IBL,16,17)
S IBL="Exclude Pre-Cond: ",IBY=$G(DATA3553(355.3,IENS,.07)),IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
S IBL="BIN: ",IBY=$G(DATA3553(355.3,IENS,6.02)),IBLINE=$$SETL("",IBY,IBL,16,10)
S IBL="Benefits Assignable: ",IBY=$G(DATA3553(355.3,IENS,.08)),IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
S IBL="PCN: ",IBY=$G(DATA3553(355.3,IENS,6.03)),IBLINE=$$SETL("",IBY,IBL,16,20)
D SET(IBLINE) S IBLINE=""
D SET(" ")
S IBL="Plan Comments: ",IBY="",IBLINE=$$SETL("",IBY,IBL,10,69)
D SET(IBLINE) S IBLINE=""
S IBL="",Z0=0 F S Z0=$O(DATA3553(355.3,IENS,11,Z0)) Q:'Z0 D
.S IBY=$G(DATA3553(355.3,IENS,11,Z0)),IBLINE=$$SETL("",IBY,IBL,10,69) D SET(IBLINE) S IBLINE=""
.Q
D SET(" ") S IBY=$J("",26)_"Policy/Subscriber Information" D SET(IBY,"B") S IBLINE=""
S IBL="Insured's Name: ",IBY=$P(INSNODE0,U,17),IBLINE=$$SETL("",IBY,IBL,18,30)
S IBL="Effective: ",IBY=$$FMTE^XLFDT($P(INSNODE0,U,8),5),IBLINE=$$SETL(IBLINE,IBY,IBL,62,10)
D SET(IBLINE) S IBLINE=""
S IBL="Subscriber Id: ",IBY=$P(INSNODE0,U,2),IBLINE=$$SETL("",IBY,IBL,18,20)
S IBL="Expiration: ",IBY=$$FMTE^XLFDT($P(INSNODE0,U,4),5),IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
D SET(IBLINE) S IBLINE=""
S IBL="Relationship: ",IBY=$$EXPAND^IBTRE(2.312,4.03,$P($G(^DPT(DFN,.312,IEN312,4)),U,3)),IBLINE=$$SETL("",IBY,IBL,18,16)
S IBL="Coord of Benefits: ",IBY=$$EXPAND^IBTRE(2.312,.2,$P(INSNODE0,U,20)),IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
D SET(IBLINE) S IBLINE=""
S IBL="Insured's DOB: ",IBY=$$FMTE^XLFDT($P($G(^DPT(DFN,.312,IEN312,3)),U),5),IBLINE=$$SETL("",IBY,IBL,18,10)
D SET(IBLINE) S IBLINE=""
S IBL="Employer Sponsored Group Health Plan?: ",IBY=$$EXPAND^IBTRE(2.312,2.1,$P($G(^DPT(DFN,.312,IEN312,2)),U))
S IBLINE=$$SETL("",IBY,IBL,40,3)
D SET(IBLINE) S IBLINE=""
D SET(" ") S IBY=$J("",23)_"User Added Comments for This Entry" D SET(IBY,"B") S IBLINE=""
S IENS=IBTRIEN_"," D GETS^DIQ(356.22,IENS,"1*","IE","CMTDATA")
S Z0="" F S Z0=$O(CMTDATA(356.221,Z0)) Q:Z0="" D
.I $G(CMTDATA(356.221,Z0,.01,"I"))="" Q
.S IBL="User's Name: ",IBY=$G(CMTDATA(356.221,Z0,.02,"E")),IBLINE=$$SETL("",IBY,IBL,10,30)
.S IBL="Date Comment Entered: ",IBY=$$FMTE^XLFDT(CMTDATA(356.221,Z0,.01,"I"),5),IBLINE=$$SETL(IBLINE,IBY,IBL,60,19)
.D SET(IBLINE) S IBLINE=""
.S IBL="Comment: ",IBY="",IBLINE=$$SETL("",IBY,IBL,10,69) D SET(IBLINE) S IBLINE=""
.K TMPARY D FSTRNG^IBJU1($$WP2STR^IBTRHLO2(356.221,.03,Z0),75,.TMPARY)
.S IBL=" " F Z1=1:1:TMPARY S IBY=TMPARY(Z1),IBLINE=$$SETL("",IBY,IBL,1,75) D SET(IBLINE) S IBLINE=""
.D SET(" ")
.Q
; STATUS = "03" - unable to send, STATUS = "04" - negative response received
I STATUS="03"!(STATUS="04") D
.I STATUS="04",RESPONSE'>0 Q ; no response pointer
.S IENS=$S(STATUS="04":RESPONSE,1:IBTRIEN)_","
.D SET(" ")
.S IBY=$S(STATUS="03":$J("",16)_"Unable to send request for the following reasons",1:$J("",26)_"278 response error condition")
.D SET(IBY,"B") S IBLINE=""
.D GETS^DIQ(356.22,IENS,"101*","IE","AAADATA")
.S Z0="" F S Z0=$O(AAADATA(356.22101,Z0)) Q:Z0="" D
..I STATUS="04" D
...S Z1=+$G(AAADATA(356.22101,Z0,.02,"I")) I Z1>0 D
....S IBL="Error Source: ",IBY=$P($G(^IBE(365.027,Z1,0)),U,2)_" (Loop "_$G(AAADATA(356.22101,Z0,.02,"E"))_")"
....S IBLINE=$$SETL("",IBY,IBL,10,69) D SET(IBLINE) S IBLINE=""
...S IBL="Reject Reason Code: ",IBY=$G(AAADATA(356.22101,Z0,.04,"E"))
...I IBY'="" S IBLINE=$$SETL("",IBY,IBL,20,59) D SET(IBLINE) S IBLINE=""
...S Z1=+$G(AAADATA(356.22101,Z0,.04,"I"))
...I Z1>0 S IBL="Reject Reason Text: ",IBY=$P($G(^IBE(365.017,Z1,0)),U,2),IBLINE=$$SETL("",IBY,IBL,20,59) D SET(IBLINE) S IBLINE=""
...S IBL="Action Code: ",IBY=$G(AAADATA(356.22101,Z0,.05,"E"))
...I IBY'="" S IBLINE=$$SETL("",IBY,IBL,20,59) D SET(IBLINE) S IBLINE=""
...S Z1=+$G(AAADATA(356.22101,Z0,.05,"I"))
...I Z1>0 S IBL="Action Text: ",IBY=$P($G(^IBE(365.018,Z1,0)),U,2),IBLINE=$$SETL("",IBY,IBL,20,59) D SET(IBLINE) S IBLINE=""
...Q
..S Z1=$G(AAADATA(356.22101,Z0,1,"E")) I Z1'="" D
...;D SET(" ")
...S IBL=$S(STATUS="04":"Error message:",1:""),IBY="",IBLINE=$$SETL("",IBY,IBL,10,69) D SET(IBLINE) S IBLINE=""
...K TMPARY D FSTRNG^IBJU1(Z1,75,.TMPARY)
...S IBL="" F Z2=1:1:TMPARY S IBY=TMPARY(Z2),IBLINE=$$SETL("",IBY,IBL,1,79) D SET(IBLINE)
...Q
..D SET(" ")
..Q
.Q
; "Pending" response received
I RESPONSE>0 D
.S IENS=RESPONSE_","
.D GETS^DIQ(356.22,IENS,"11*;12;17.02;103.01;103.03","IE","PNDDATA")
.I $G(PNDDATA(356.22,IENS,103.01,"E"))'="A4" Q ; only display this section if Certification Action Code = A4
.D SET(" ") S IBY=$J("",23)_"278 Response with 'Pending' status" D SET(IBY,"B") S IBLINE=""
.D SET(" ")
.S IBL="Admin Reference #: ",IBY=$G(PNDDATA(356.22,IENS,17.02,"E")),IBLINE=$$SETL("",IBY,IBL,10,69)
.D SET(IBLINE) S IBLINE=""
.S IBL="Review Decision Reason Code: ",IBY=$G(PNDDATA(356.22,IENS,103.03,"E")),IBLINE=$$SETL("",IBY,IBL,10,69)
.D SET(IBLINE) S IBLINE=""
.S IBL="Review Decision Reason Text: ",IBY=$P($G(^IBT(356.021,+$G(PNDDATA(356.22,IENS,103.03,"I")),0)),U,2)
.S IBLINE=$$SETL("",IBY,IBL,10,69)
.D SET(IBLINE) S IBLINE=""
.I $D(PNDDATA(356.22,IENS,12)) D
..S IBL="Message: ",IBY="",IBLINE=$$SETL("",IBY,IBL,1,79)
..D SET(IBLINE) S IBLINE="",IBL=""
..S Z0=0 F S Z0=$O(PNDDATA(356.22,IENS,12,Z0)) Q:Z0'=+Z0 D
...S Z1=$G(PNDDATA(356.22,IENS,12,Z0))
...K TMPARY D FSTRNG^IBJU1(Z1,75,.TMPARY)
...S IBL="" F Z2=1:1:TMPARY S IBY=TMPARY(Z2),IBLINE=$$SETL("",IBY,IBL,1,79) D SET(IBLINE)
...S IBLINE=""
...Q
..Q
.I $D(PNDDATA(356.2211)) D
..D SET(" ")
..S IBL="Reports: ",IBY="",IBLINE=$$SETL("",IBY,IBL,40,9)
..D SET(IBLINE) S IBLINE=""
..D SET(" ")
..S Z="" F S Z=$O(PNDDATA(356.2211,Z)) Q:Z="" D
...S IBL="Attachment Report Type Code: ",IBY=$P($G(^IBT(356.018,+$G(PNDDATA(356.2211,Z,.01,"I")),0)),U)
...S IBLINE=$$SETL("",IBY,IBL,1,79) D SET(IBLINE) S IBLINE=""
...S IBL="Attachment Report Type Text: ",IBY=$G(PNDDATA(356.2211,Z,.01,"E"))
...S IBLINE=$$SETL("",IBY,IBL,1,79) D SET(IBLINE) S IBLINE=""
...S IBL="Report Transmission Code: ",IBY=$G(PNDDATA(356.2211,Z,.02,"I"))
...S IBLINE=$$SETL("",IBY,IBL,1,79) D SET(IBLINE) S IBLINE=""
...S IBL="Report Transmission Text: ",IBY=$G(PNDDATA(356.2211,Z,.02,"E"))
...S IBLINE=$$SETL("",IBY,IBL,1,79) D SET(IBLINE) S IBLINE=""
...S IBL="Report Control #: ",IBY=$G(PNDDATA(356.2211,Z,.03,"E"))
...S IBLINE=$$SETL("",IBY,IBL,1,79) D SET(IBLINE) S IBLINE=""
...S IBL="Attachment Description: ",IBY="",IBLINE=$$SETL("",IBY,IBL,1,79)
...D SET(IBLINE) S IBLINE=""
...S IBL="",IBY=$G(PNDDATA(356.2211,Z,.04,"E")),IBLINE=$$SETL("",IBY,IBL,1,79)
...D SET(IBLINE) S IBLINE=""
...D SET(" ")
...Q
..Q
.Q
S Z=+$O(^TMP(IBTRNM,$J,""),-1) I Z,$G(^TMP(IBTRNM,$J,Z,0))=" " K ^TMP(IBTRNM,$J,Z) S VALMCNT=VALMCNT-1
Q
;
SETL(LINE,DATA,LABEL,COL,LNG) ;
S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
Q LINE
;
SET(LINE,SPEC) ;
S VALMCNT=VALMCNT+1
S ^TMP(IBTRNM,$J,VALMCNT,0)=LINE
I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
Q
;
ADDCMT(FROMWL) ; add entry comment
; called from action protocol IBT HCSR ADD COMMENT
; Input: FROMWL - Optional, only sent when adding a comment to entry
; directly from the main worklist.
; Defaults to 0
N CMTIEN,DA,DD,DIC,DIE,DIK,DINUM,DLAYGO,DO,DR,DTOUT,DUOUT,DIRUT,X,Y
S:'$D(FROMWL) FROMWL=0
S VALMBCK="R"
; create new entry in the comments multiple (356.221)
S DA(1)=IBTRIEN,DLAYGO=356.221,DIC(0)="L",DIC="^IBT(356.22,"_DA(1)_",1,",X=$$NOW^XLFDT()
D FILE^DICN K DD,DO S (CMTIEN,DA)=+Y I DA<1 Q
; prompt for the comment
S DIE="^IBT(356.22,"_DA(1)_",1,",DR=".02////"_DUZ_";.03" D ^DIE
; if no comment was added, delete the entry in 356.221 we just created
I $G(^IBT(356.22,IBTRIEN,1,CMTIEN,1,1,0))="" S DIK=DIE,DA(1)=IBTRIEN,DA=CMTIEN D ^DIK Q
;
; If called from the main worklist, skip the next line
Q:FROMWL
;
; rebuild the listman screen in order to show the newly added comment
D INIT^IBTRH2,HDR^IBTRH2
Q
;
SEND278 ; send 278 request
N ADMIEN,DDT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EDT,DISIEN,IBEXIT,IENS,STATUS,X,Y
; IBTRENT - where this action is called from:
; 0 = from HCSR Worklist (full view)
; 1 = from HCSR Worklist (short view)
; 2 = from HCSR Response Worklist
; 3 = from Insurance Review Editor or Claims Tracking Editor
S IBTRENT=+$G(IBTRENT)
S:'$D(IBRESP) IBRESP=0
S VALMBCK="R"
D FULL^VALM1
I $G(IBTRIEN)="" S IBTRENT=3 D ; coming from either Insurance Review Editor or Claims Tracking Editor
.I $G(IBTRN)'="" D
..S IENS=IBTRN_",",DDT=""
..S EDT=$$GET1^DIQ(356,IENS,.06,"I") ; get event date from file 356
..S ADMIEN=+$$GET1^DIQ(356,IENS,.05,"I") ; get admission (ptr to file 405) from file 356
..I ADMIEN>0 D
...S DISIEN=+$$GET1^DIQ(405,ADMIEN_",",.17,"I") ; get discharge (ptr to file 405) from file 405
...I DISIEN>0 S DDT=$$GET1^DIQ(405,DISIEN_",",.01,"I") ; get discharge date from file 405
...Q
..S IBTRIEN=$O(^IBT(356.22,"D",DFN,EDT_$S(DDT'="":"-"_DDT,1:""),""))
.Q
; if no valid 356.22 ien, complain and bail out
I +$G(IBTRIEN)'>0 D STATMSG^IBTRH2A(1) Q
;
S STATUS=$$STATUS(IBTRIEN)
; don't send a new request if we're waiting for response
I STATUS="02" D STATMSG^IBTRH2A(3) Q
; if status is pending, still waiting on payer
I STATUS="07" D STATMSG^IBTRH2A(4) Q
; Create the 278 request to be sent
I IBTRENT'=1 S IBEXIT=$$CRT278^IBTRH5I(IBTRIEN)
I IBTRENT=1 S IBEXIT=1
;
; Quit if the user '^' exited the template or if there is missing required fields
I $$REQMISS^IBTRH5I(IBTRIEN,IBEXIT) D Q
. D PAUSE^VALM1
. ; Refresh display
. I IBTRENT=0 D INIT^IBTRH2
;
S DIR("A")="Send Request? (Y/N): ",DIR("B")="N",DIR(0)="YAO" D ^DIR K DIR
I $G(DTOUT)!$G(DUOUT)!$G(DIROUT)!($G(Y)'=1) Q
D EN^IBTRHLO(IBTRIEN,0)
; check if message id got populated and display appropriate message
D STATMSG^IBTRH2A($S($P($G(^IBT(356.22,IBTRIEN,0)),U,12)="":2,1:0))
; refresh display
I IBTRENT=0 D INIT^IBTRH2
Q
;
STATUS(IBTRIEN) ; returns 356.22 entry status
; IBTRIEN - file 356.22 ien
;
N RES
S RES=""
I +$G(IBTRIEN)>0 S RES=$P($G(^IBT(356.22,IBTRIEN,0)),U,8)
Q RES
;
PRMARK(WHICH) ;EP
; Listman Protocol Action to Mark/Remove 'In-Progress' from a selected entry
; from the expand entry worklist
; Input: WHICH - 0 - Remove 'In-Progress' mark
; 1 - Set 'In-Progress' mark
; IBTRIEN - IEN of the Expanded Entry being marked/removed
D PRMARK^IBTRH1(WHICH,IBTRIEN)
I WHICH=1 D Q
. I +$$STATUS^IBTRH2(IBTRIEN)=1 S VALMSG="Entry has been Marked" Q
. S VALMSG="Nothing Done"
;
I +$$STATUS^IBTRH2(IBTRIEN)=0 S VALMSG="Entry has been Unmarked" Q
S VALMSG="Nothing Done"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH2 14764 printed Sep 23, 2025@20:04:22 Page 2
IBTRH2 ;ALB/YMG - HCSR worklist expand entry ;18-JUN-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 QUIT
+5 ;
EN ; main entry point for IBT HCSR ENTRY
+1 NEW DFN,DLINE,EVENTDT,IEN312,IEN36,INSNODE0,NODE0,IBTRNM,IBTRENT
+2 SET VALMBCK="R"
+3 SET IBTRNM="IBTRH2"
SET IBTRENT=0
+4 ; select entry to expand
SET IBTRIEN=+$$SELEVENT^IBTRH1(0,"Select entry",.DLINE)
+5 IF IBTRIEN'>0
QUIT
+6 ; try to lock the entry
+7 IF '$$LOCKEV^IBTRH1(IBTRIEN)
DO LOCKERR^IBTRH2A
SET VALMSG="?Await #In-Prog -RespErr !Unable +Pend *NextRev"
DO MSG^VALM10(VALMSG)
QUIT
+8 DO EN^VALM("IBT HCSR ENTRY")
+9 ; unlock entry
+10 DO UNLOCKEV^IBTRH1(IBTRIEN)
+11 QUIT
+12 ;
EN2(IBTRNM,IBTRIEN) ; Secondary entry point.
+1 ; IBTRNM is the calling routine name.
+2 ; IBTRIEN is the internal id for ^IBT(356.22)
+3 IF $GET(IBTRNM)=""
SET VALMQUIT=""
QUIT
+4 IF '$GET(IBTRIEN)
SET VALMQUIT=""
QUIT
+5 NEW DFN,EVENTDT,IEN312,INSNODE0,NODE0
+6 DO INIT
+7 QUIT
+8 ;
HDR ; header code
+1 NEW VADM,VA,VAERR,Z
+2 SET Z=""
+3 IF +$GET(DFN)
DO DEM^VADPT
SET Z=$EXTRACT(VADM(1),1,28)
SET Z=Z_$JUSTIFY("",35-$LENGTH(Z))_$PIECE(VADM(2),U,2)_" DOB: "_$PIECE(VADM(3),U,2)_" AGE: "_VADM(4)
+4 SET VALMHDR(1)=Z
+5 QUIT
+6 ;
INIT ; init variables and list array
+1 KILL ^TMP(IBTRNM,$JOB)
+2 IF '$GET(IBTRIEN)
SET VALMQUIT=""
QUIT
+3 SET NODE0=$GET(^IBT(356.22,IBTRIEN,0))
+4 SET DFN=+$PIECE(NODE0,U,2)
+5 SET IEN312=+$PIECE(NODE0,U,3)
+6 ; 0-node in file 2.312
SET INSNODE0=""
if IEN312>0
SET INSNODE0=$GET(^DPT(DFN,.312,IEN312,0))
+7 SET IEN36=+$PIECE(INSNODE0,U)
+8 SET EVENTDT=$PIECE(NODE0,U,7)
+9 DO BLD
+10 QUIT
+11 ;
HELP ; help code
+1 DO FULL^VALM1
+2 WRITE !!,"This screen displays an expanded view of a Healthcare Services Review Worklist entry."
+3 WRITE !!,"The actions allow editing of data and transmission of HCSR inquiry."
+4 DO PAUSE^VALM1
SET VALMBCK="R"
+5 QUIT
+6 ;
EXIT ; exit code
+1 KILL ^TMP(IBTRNM,$JOB)
+2 DO CLEAR^VALM1
DO CLEAN^VALM10
+3 QUIT
+4 ;
BLD ; build screen array
+1 NEW AAADATA,ADDR,CMTDATA,DATA36,DATA3553,IBL,IBLINE,IBY,IEN3553,IENS,PNDDATA,RESPONSE,STATUS,TMPARY,Z,Z0,Z1,Z2
+2 SET IEN3553=+$PIECE(INSNODE0,U,18)
SET STATUS=$$STATUS(IBTRIEN)
SET RESPONSE=+$PIECE($GET(^IBT(356.22,IBTRIEN,0)),U,14)
+3 IF $PIECE($GET(^IBT(356.22,IBTRIEN,0)),U,20)=2
SET RESPONSE=IBTRIEN
+4 SET VALMCNT=0
+5 ;
+6 SET IENS=IEN36_","
+7 DO GETS^DIQ(36,IENS,".01;1;.131:.133","EI","DATA36")
+8 DO SET(" ")
SET IBY=$JUSTIFY("",26)_"Insurance Company Information"
DO SET(IBY,"B")
SET IBLINE=""
+9 SET IBL="Name: "
SET IBY=$GET(DATA36(36,IENS,.01,"E"))
SET IBLINE=$$SETL("",IBY,IBL,10,30)
+10 SET IBL="Reimburse?: "
SET IBY=$GET(DATA36(36,IENS,1,"E"))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
+11 DO SET(IBLINE)
SET IBLINE=""
+12 SET IBL="Phone: "
SET IBY=$GET(DATA36(36,IENS,.131,"E"))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,10,20)
+13 SET IBL="Billing Phone: "
SET IBY=$GET(DATA36(36,IENS,.132,"E"))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
+14 DO SET(IBLINE)
SET IBLINE=""
+15 SET IBL="Precert Phone: "
SET IBY=$GET(DATA36(36,IENS,.133,"E"))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
+16 DO SET(IBLINE)
SET IBLINE=""
+17 DO ADDR^IBTRH2A(36,IEN36,.111,.112,.113,.114,.115,.116,.ADDR)
+18 SET IBL="Address: "
SET IBY=ADDR(1)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
+19 DO SET(IBLINE)
SET IBLINE=""
+20 FOR Z=2:1:9
SET IBL=""
SET IBY=$GET(ADDR(Z))
if IBY=""
QUIT
SET IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
DO SET(IBLINE)
SET IBLINE=""
+21 ;
+22 SET IENS=IEN3553_","
+23 DO GETS^DIQ(355.3,IENS,".02:.09;.12;6.02;6.03;11",,"DATA3553")
+24 DO SET(" ")
SET IBY=$JUSTIFY("",29)_"Group/Plan Information"
DO SET(IBY,"B")
SET IBLINE=""
+25 SET IBL="Type Of Plan: "
SET IBY=$GET(DATA3553(355.3,IENS,.09))
SET IBLINE=$$SETL("",IBY,IBL,16,40)
+26 SET IBL="Require UR: "
SET IBY=$GET(DATA3553(355.3,IENS,.05))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+27 DO SET(IBLINE)
SET IBLINE=""
+28 SET IBL="Group?: "
SET IBY=$GET(DATA3553(355.3,IENS,.02))
SET IBLINE=$$SETL("",IBY,IBL,16,3)
+29 SET IBL="Require Amb Cert: "
SET IBY=$GET(DATA3553(355.3,IENS,.12))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+30 DO SET(IBLINE)
SET IBLINE=""
+31 SET IBL="Group Name: "
SET IBY=$GET(DATA3553(355.3,IENS,.03))
SET IBLINE=$$SETL("",IBY,IBL,16,20)
+32 SET IBL="Require Pre-Cert: "
SET IBY=$GET(DATA3553(355.3,IENS,.06))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+33 DO SET(IBLINE)
SET IBLINE=""
+34 SET IBL="Group Number: "
SET IBY=$GET(DATA3553(355.3,IENS,.04))
SET IBLINE=$$SETL("",IBY,IBL,16,17)
+35 SET IBL="Exclude Pre-Cond: "
SET IBY=$GET(DATA3553(355.3,IENS,.07))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+36 DO SET(IBLINE)
SET IBLINE=""
+37 SET IBL="BIN: "
SET IBY=$GET(DATA3553(355.3,IENS,6.02))
SET IBLINE=$$SETL("",IBY,IBL,16,10)
+38 SET IBL="Benefits Assignable: "
SET IBY=$GET(DATA3553(355.3,IENS,.08))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+39 DO SET(IBLINE)
SET IBLINE=""
+40 SET IBL="PCN: "
SET IBY=$GET(DATA3553(355.3,IENS,6.03))
SET IBLINE=$$SETL("",IBY,IBL,16,20)
+41 DO SET(IBLINE)
SET IBLINE=""
+42 DO SET(" ")
+43 SET IBL="Plan Comments: "
SET IBY=""
SET IBLINE=$$SETL("",IBY,IBL,10,69)
+44 DO SET(IBLINE)
SET IBLINE=""
+45 SET IBL=""
SET Z0=0
FOR
SET Z0=$ORDER(DATA3553(355.3,IENS,11,Z0))
if 'Z0
QUIT
Begin DoDot:1
+46 SET IBY=$GET(DATA3553(355.3,IENS,11,Z0))
SET IBLINE=$$SETL("",IBY,IBL,10,69)
DO SET(IBLINE)
SET IBLINE=""
+47 QUIT
End DoDot:1
+48 DO SET(" ")
SET IBY=$JUSTIFY("",26)_"Policy/Subscriber Information"
DO SET(IBY,"B")
SET IBLINE=""
+49 SET IBL="Insured's Name: "
SET IBY=$PIECE(INSNODE0,U,17)
SET IBLINE=$$SETL("",IBY,IBL,18,30)
+50 SET IBL="Effective: "
SET IBY=$$FMTE^XLFDT($PIECE(INSNODE0,U,8),5)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,10)
+51 DO SET(IBLINE)
SET IBLINE=""
+52 SET IBL="Subscriber Id: "
SET IBY=$PIECE(INSNODE0,U,2)
SET IBLINE=$$SETL("",IBY,IBL,18,20)
+53 SET IBL="Expiration: "
SET IBY=$$FMTE^XLFDT($PIECE(INSNODE0,U,4),5)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
+54 DO SET(IBLINE)
SET IBLINE=""
+55 SET IBL="Relationship: "
SET IBY=$$EXPAND^IBTRE(2.312,4.03,$PIECE($GET(^DPT(DFN,.312,IEN312,4)),U,3))
SET IBLINE=$$SETL("",IBY,IBL,18,16)
+56 SET IBL="Coord of Benefits: "
SET IBY=$$EXPAND^IBTRE(2.312,.2,$PIECE(INSNODE0,U,20))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
+57 DO SET(IBLINE)
SET IBLINE=""
+58 SET IBL="Insured's DOB: "
SET IBY=$$FMTE^XLFDT($PIECE($GET(^DPT(DFN,.312,IEN312,3)),U),5)
SET IBLINE=$$SETL("",IBY,IBL,18,10)
+59 DO SET(IBLINE)
SET IBLINE=""
+60 SET IBL="Employer Sponsored Group Health Plan?: "
SET IBY=$$EXPAND^IBTRE(2.312,2.1,$PIECE($GET(^DPT(DFN,.312,IEN312,2)),U))
+61 SET IBLINE=$$SETL("",IBY,IBL,40,3)
+62 DO SET(IBLINE)
SET IBLINE=""
+63 DO SET(" ")
SET IBY=$JUSTIFY("",23)_"User Added Comments for This Entry"
DO SET(IBY,"B")
SET IBLINE=""
+64 SET IENS=IBTRIEN_","
DO GETS^DIQ(356.22,IENS,"1*","IE","CMTDATA")
+65 SET Z0=""
FOR
SET Z0=$ORDER(CMTDATA(356.221,Z0))
if Z0=""
QUIT
Begin DoDot:1
+66 IF $GET(CMTDATA(356.221,Z0,.01,"I"))=""
QUIT
+67 SET IBL="User's Name: "
SET IBY=$GET(CMTDATA(356.221,Z0,.02,"E"))
SET IBLINE=$$SETL("",IBY,IBL,10,30)
+68 SET IBL="Date Comment Entered: "
SET IBY=$$FMTE^XLFDT(CMTDATA(356.221,Z0,.01,"I"),5)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,60,19)
+69 DO SET(IBLINE)
SET IBLINE=""
+70 SET IBL="Comment: "
SET IBY=""
SET IBLINE=$$SETL("",IBY,IBL,10,69)
DO SET(IBLINE)
SET IBLINE=""
+71 KILL TMPARY
DO FSTRNG^IBJU1($$WP2STR^IBTRHLO2(356.221,.03,Z0),75,.TMPARY)
+72 SET IBL=" "
FOR Z1=1:1:TMPARY
SET IBY=TMPARY(Z1)
SET IBLINE=$$SETL("",IBY,IBL,1,75)
DO SET(IBLINE)
SET IBLINE=""
+73 DO SET(" ")
+74 QUIT
End DoDot:1
+75 ; STATUS = "03" - unable to send, STATUS = "04" - negative response received
+76 IF STATUS="03"!(STATUS="04")
Begin DoDot:1
+77 ; no response pointer
IF STATUS="04"
IF RESPONSE'>0
QUIT
+78 SET IENS=$SELECT(STATUS="04":RESPONSE,1:IBTRIEN)_","
+79 DO SET(" ")
+80 SET IBY=$SELECT(STATUS="03":$JUSTIFY("",16)_"Unable to send request for the following reasons",1:$JUSTIFY("",26)_"278 response error condition")
+81 DO SET(IBY,"B")
SET IBLINE=""
+82 DO GETS^DIQ(356.22,IENS,"101*","IE","AAADATA")
+83 SET Z0=""
FOR
SET Z0=$ORDER(AAADATA(356.22101,Z0))
if Z0=""
QUIT
Begin DoDot:2
+84 IF STATUS="04"
Begin DoDot:3
+85 SET Z1=+$GET(AAADATA(356.22101,Z0,.02,"I"))
IF Z1>0
Begin DoDot:4
+86 SET IBL="Error Source: "
SET IBY=$PIECE($GET(^IBE(365.027,Z1,0)),U,2)_" (Loop "_$GET(AAADATA(356.22101,Z0,.02,"E"))_")"
+87 SET IBLINE=$$SETL("",IBY,IBL,10,69)
DO SET(IBLINE)
SET IBLINE=""
End DoDot:4
+88 SET IBL="Reject Reason Code: "
SET IBY=$GET(AAADATA(356.22101,Z0,.04,"E"))
+89 IF IBY'=""
SET IBLINE=$$SETL("",IBY,IBL,20,59)
DO SET(IBLINE)
SET IBLINE=""
+90 SET Z1=+$GET(AAADATA(356.22101,Z0,.04,"I"))
+91 IF Z1>0
SET IBL="Reject Reason Text: "
SET IBY=$PIECE($GET(^IBE(365.017,Z1,0)),U,2)
SET IBLINE=$$SETL("",IBY,IBL,20,59)
DO SET(IBLINE)
SET IBLINE=""
+92 SET IBL="Action Code: "
SET IBY=$GET(AAADATA(356.22101,Z0,.05,"E"))
+93 IF IBY'=""
SET IBLINE=$$SETL("",IBY,IBL,20,59)
DO SET(IBLINE)
SET IBLINE=""
+94 SET Z1=+$GET(AAADATA(356.22101,Z0,.05,"I"))
+95 IF Z1>0
SET IBL="Action Text: "
SET IBY=$PIECE($GET(^IBE(365.018,Z1,0)),U,2)
SET IBLINE=$$SETL("",IBY,IBL,20,59)
DO SET(IBLINE)
SET IBLINE=""
+96 QUIT
End DoDot:3
+97 SET Z1=$GET(AAADATA(356.22101,Z0,1,"E"))
IF Z1'=""
Begin DoDot:3
+98 ;D SET(" ")
+99 SET IBL=$SELECT(STATUS="04":"Error message:",1:"")
SET IBY=""
SET IBLINE=$$SETL("",IBY,IBL,10,69)
DO SET(IBLINE)
SET IBLINE=""
+100 KILL TMPARY
DO FSTRNG^IBJU1(Z1,75,.TMPARY)
+101 SET IBL=""
FOR Z2=1:1:TMPARY
SET IBY=TMPARY(Z2)
SET IBLINE=$$SETL("",IBY,IBL,1,79)
DO SET(IBLINE)
+102 QUIT
End DoDot:3
+103 DO SET(" ")
+104 QUIT
End DoDot:2
+105 QUIT
End DoDot:1
+106 ; "Pending" response received
+107 IF RESPONSE>0
Begin DoDot:1
+108 SET IENS=RESPONSE_","
+109 DO GETS^DIQ(356.22,IENS,"11*;12;17.02;103.01;103.03","IE","PNDDATA")
+110 ; only display this section if Certification Action Code = A4
IF $GET(PNDDATA(356.22,IENS,103.01,"E"))'="A4"
QUIT
+111 DO SET(" ")
SET IBY=$JUSTIFY("",23)_"278 Response with 'Pending' status"
DO SET(IBY,"B")
SET IBLINE=""
+112 DO SET(" ")
+113 SET IBL="Admin Reference #: "
SET IBY=$GET(PNDDATA(356.22,IENS,17.02,"E"))
SET IBLINE=$$SETL("",IBY,IBL,10,69)
+114 DO SET(IBLINE)
SET IBLINE=""
+115 SET IBL="Review Decision Reason Code: "
SET IBY=$GET(PNDDATA(356.22,IENS,103.03,"E"))
SET IBLINE=$$SETL("",IBY,IBL,10,69)
+116 DO SET(IBLINE)
SET IBLINE=""
+117 SET IBL="Review Decision Reason Text: "
SET IBY=$PIECE($GET(^IBT(356.021,+$GET(PNDDATA(356.22,IENS,103.03,"I")),0)),U,2)
+118 SET IBLINE=$$SETL("",IBY,IBL,10,69)
+119 DO SET(IBLINE)
SET IBLINE=""
+120 IF $DATA(PNDDATA(356.22,IENS,12))
Begin DoDot:2
+121 SET IBL="Message: "
SET IBY=""
SET IBLINE=$$SETL("",IBY,IBL,1,79)
+122 DO SET(IBLINE)
SET IBLINE=""
SET IBL=""
+123 SET Z0=0
FOR
SET Z0=$ORDER(PNDDATA(356.22,IENS,12,Z0))
if Z0'=+Z0
QUIT
Begin DoDot:3
+124 SET Z1=$GET(PNDDATA(356.22,IENS,12,Z0))
+125 KILL TMPARY
DO FSTRNG^IBJU1(Z1,75,.TMPARY)
+126 SET IBL=""
FOR Z2=1:1:TMPARY
SET IBY=TMPARY(Z2)
SET IBLINE=$$SETL("",IBY,IBL,1,79)
DO SET(IBLINE)
+127 SET IBLINE=""
+128 QUIT
End DoDot:3
+129 QUIT
End DoDot:2
+130 IF $DATA(PNDDATA(356.2211))
Begin DoDot:2
+131 DO SET(" ")
+132 SET IBL="Reports: "
SET IBY=""
SET IBLINE=$$SETL("",IBY,IBL,40,9)
+133 DO SET(IBLINE)
SET IBLINE=""
+134 DO SET(" ")
+135 SET Z=""
FOR
SET Z=$ORDER(PNDDATA(356.2211,Z))
if Z=""
QUIT
Begin DoDot:3
+136 SET IBL="Attachment Report Type Code: "
SET IBY=$PIECE($GET(^IBT(356.018,+$GET(PNDDATA(356.2211,Z,.01,"I")),0)),U)
+137 SET IBLINE=$$SETL("",IBY,IBL,1,79)
DO SET(IBLINE)
SET IBLINE=""
+138 SET IBL="Attachment Report Type Text: "
SET IBY=$GET(PNDDATA(356.2211,Z,.01,"E"))
+139 SET IBLINE=$$SETL("",IBY,IBL,1,79)
DO SET(IBLINE)
SET IBLINE=""
+140 SET IBL="Report Transmission Code: "
SET IBY=$GET(PNDDATA(356.2211,Z,.02,"I"))
+141 SET IBLINE=$$SETL("",IBY,IBL,1,79)
DO SET(IBLINE)
SET IBLINE=""
+142 SET IBL="Report Transmission Text: "
SET IBY=$GET(PNDDATA(356.2211,Z,.02,"E"))
+143 SET IBLINE=$$SETL("",IBY,IBL,1,79)
DO SET(IBLINE)
SET IBLINE=""
+144 SET IBL="Report Control #: "
SET IBY=$GET(PNDDATA(356.2211,Z,.03,"E"))
+145 SET IBLINE=$$SETL("",IBY,IBL,1,79)
DO SET(IBLINE)
SET IBLINE=""
+146 SET IBL="Attachment Description: "
SET IBY=""
SET IBLINE=$$SETL("",IBY,IBL,1,79)
+147 DO SET(IBLINE)
SET IBLINE=""
+148 SET IBL=""
SET IBY=$GET(PNDDATA(356.2211,Z,.04,"E"))
SET IBLINE=$$SETL("",IBY,IBL,1,79)
+149 DO SET(IBLINE)
SET IBLINE=""
+150 DO SET(" ")
+151 QUIT
End DoDot:3
+152 QUIT
End DoDot:2
+153 QUIT
End DoDot:1
+154 SET Z=+$ORDER(^TMP(IBTRNM,$JOB,""),-1)
IF Z
IF $GET(^TMP(IBTRNM,$JOB,Z,0))=" "
KILL ^TMP(IBTRNM,$JOB,Z)
SET VALMCNT=VALMCNT-1
+155 QUIT
+156 ;
SETL(LINE,DATA,LABEL,COL,LNG) ;
+1 SET LINE=LINE_$JUSTIFY("",(COL-$LENGTH(LABEL)-$LENGTH(LINE)))_LABEL_$EXTRACT(DATA,1,LNG)
+2 QUIT LINE
+3 ;
SET(LINE,SPEC) ;
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP(IBTRNM,$JOB,VALMCNT,0)=LINE
+3 IF $GET(SPEC)="B"
DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
+4 QUIT
+5 ;
ADDCMT(FROMWL) ; add entry comment
+1 ; called from action protocol IBT HCSR ADD COMMENT
+2 ; Input: FROMWL - Optional, only sent when adding a comment to entry
+3 ; directly from the main worklist.
+4 ; Defaults to 0
+5 NEW CMTIEN,DA,DD,DIC,DIE,DIK,DINUM,DLAYGO,DO,DR,DTOUT,DUOUT,DIRUT,X,Y
+6 if '$DATA(FROMWL)
SET FROMWL=0
+7 SET VALMBCK="R"
+8 ; create new entry in the comments multiple (356.221)
+9 SET DA(1)=IBTRIEN
SET DLAYGO=356.221
SET DIC(0)="L"
SET DIC="^IBT(356.22,"_DA(1)_",1,"
SET X=$$NOW^XLFDT()
+10 DO FILE^DICN
KILL DD,DO
SET (CMTIEN,DA)=+Y
IF DA<1
QUIT
+11 ; prompt for the comment
+12 SET DIE="^IBT(356.22,"_DA(1)_",1,"
SET DR=".02////"_DUZ_";.03"
DO ^DIE
+13 ; if no comment was added, delete the entry in 356.221 we just created
+14 IF $GET(^IBT(356.22,IBTRIEN,1,CMTIEN,1,1,0))=""
SET DIK=DIE
SET DA(1)=IBTRIEN
SET DA=CMTIEN
DO ^DIK
QUIT
+15 ;
+16 ; If called from the main worklist, skip the next line
+17 if FROMWL
QUIT
+18 ;
+19 ; rebuild the listman screen in order to show the newly added comment
+20 DO INIT^IBTRH2
DO HDR^IBTRH2
+21 QUIT
+22 ;
SEND278 ; send 278 request
+1 NEW ADMIEN,DDT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EDT,DISIEN,IBEXIT,IENS,STATUS,X,Y
+2 ; IBTRENT - where this action is called from:
+3 ; 0 = from HCSR Worklist (full view)
+4 ; 1 = from HCSR Worklist (short view)
+5 ; 2 = from HCSR Response Worklist
+6 ; 3 = from Insurance Review Editor or Claims Tracking Editor
+7 SET IBTRENT=+$GET(IBTRENT)
+8 if '$DATA(IBRESP)
SET IBRESP=0
+9 SET VALMBCK="R"
+10 DO FULL^VALM1
+11 ; coming from either Insurance Review Editor or Claims Tracking Editor
IF $GET(IBTRIEN)=""
SET IBTRENT=3
Begin DoDot:1
+12 IF $GET(IBTRN)'=""
Begin DoDot:2
+13 SET IENS=IBTRN_","
SET DDT=""
+14 ; get event date from file 356
SET EDT=$$GET1^DIQ(356,IENS,.06,"I")
+15 ; get admission (ptr to file 405) from file 356
SET ADMIEN=+$$GET1^DIQ(356,IENS,.05,"I")
+16 IF ADMIEN>0
Begin DoDot:3
+17 ; get discharge (ptr to file 405) from file 405
SET DISIEN=+$$GET1^DIQ(405,ADMIEN_",",.17,"I")
+18 ; get discharge date from file 405
IF DISIEN>0
SET DDT=$$GET1^DIQ(405,DISIEN_",",.01,"I")
+19 QUIT
End DoDot:3
+20 SET IBTRIEN=$ORDER(^IBT(356.22,"D",DFN,EDT_$SELECT(DDT'="":"-"_DDT,1:""),""))
End DoDot:2
+21 QUIT
End DoDot:1
+22 ; if no valid 356.22 ien, complain and bail out
+23 IF +$GET(IBTRIEN)'>0
DO STATMSG^IBTRH2A(1)
QUIT
+24 ;
+25 SET STATUS=$$STATUS(IBTRIEN)
+26 ; don't send a new request if we're waiting for response
+27 IF STATUS="02"
DO STATMSG^IBTRH2A(3)
QUIT
+28 ; if status is pending, still waiting on payer
+29 IF STATUS="07"
DO STATMSG^IBTRH2A(4)
QUIT
+30 ; Create the 278 request to be sent
+31 IF IBTRENT'=1
SET IBEXIT=$$CRT278^IBTRH5I(IBTRIEN)
+32 IF IBTRENT=1
SET IBEXIT=1
+33 ;
+34 ; Quit if the user '^' exited the template or if there is missing required fields
+35 IF $$REQMISS^IBTRH5I(IBTRIEN,IBEXIT)
Begin DoDot:1
+36 DO PAUSE^VALM1
+37 ; Refresh display
+38 IF IBTRENT=0
DO INIT^IBTRH2
End DoDot:1
QUIT
+39 ;
+40 SET DIR("A")="Send Request? (Y/N): "
SET DIR("B")="N"
SET DIR(0)="YAO"
DO ^DIR
KILL DIR
+41 IF $GET(DTOUT)!$GET(DUOUT)!$GET(DIROUT)!($GET(Y)'=1)
QUIT
+42 DO EN^IBTRHLO(IBTRIEN,0)
+43 ; check if message id got populated and display appropriate message
+44 DO STATMSG^IBTRH2A($SELECT($PIECE($GET(^IBT(356.22,IBTRIEN,0)),U,12)="":2,1:0))
+45 ; refresh display
+46 IF IBTRENT=0
DO INIT^IBTRH2
+47 QUIT
+48 ;
STATUS(IBTRIEN) ; returns 356.22 entry status
+1 ; IBTRIEN - file 356.22 ien
+2 ;
+3 NEW RES
+4 SET RES=""
+5 IF +$GET(IBTRIEN)>0
SET RES=$PIECE($GET(^IBT(356.22,IBTRIEN,0)),U,8)
+6 QUIT RES
+7 ;
PRMARK(WHICH) ;EP
+1 ; Listman Protocol Action to Mark/Remove 'In-Progress' from a selected entry
+2 ; from the expand entry worklist
+3 ; Input: WHICH - 0 - Remove 'In-Progress' mark
+4 ; 1 - Set 'In-Progress' mark
+5 ; IBTRIEN - IEN of the Expanded Entry being marked/removed
+6 DO PRMARK^IBTRH1(WHICH,IBTRIEN)
+7 IF WHICH=1
Begin DoDot:1
+8 IF +$$STATUS^IBTRH2(IBTRIEN)=1
SET VALMSG="Entry has been Marked"
QUIT
+9 SET VALMSG="Nothing Done"
End DoDot:1
QUIT
+10 ;
+11 IF +$$STATUS^IBTRH2(IBTRIEN)=0
SET VALMSG="Entry has been Unmarked"
QUIT
+12 SET VALMSG="Nothing Done"
+13 QUIT
