IBOHLSE ;ALB/BAA - IB HELD CHARGES LIST MANAGER ;08-SEP-2015
;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- main entry point for HELD CHARGES EXPAND
; add code to do filters here
;
D EN^VALM("IB HELD CHARGES EXPAND")
Q
;
HDR ; -- header code
;
S VALM("TITLE")=" Expanded Held Charges"
S XQORM("B")="QUIT"
Q
;
INIT ; -- init variables and list array
; input - none
; output ^TMP($J,"IBOHLSE")
N DFN,CNT,NAME,IBIEN,REC,CLINIC,LST
S REC=^TMP($J,"IBOHLSE")
S DFN=$P(REC,U,1),CNT=$P(REC,U,2)
S NAME=$P(REC,U,3),IBIEN=$P(REC,U,4)
S LST=$P(REC,U,5),CLINIC=$P(REC,U,6)
D BLD
Q
;
BLD ; build data to display
N CNT,SS,LINE,XX,RX,GMT,IB0,IB1,PATIEN,XX
N EADAT,EAWHO,LUDAT,LUWHO
S (CNT,VALMCNT)=0
S IB0=^IB(IBIEN,0)
S IB1=^IB(IBIEN,1)
S SS=$$GET1^DIQ(2,DFN,.09)
;
D FULL^VALM1
D SET^VALM10(1,"PATIENT : "_NAME_" - "_SS,"")
;
D SET^VALM10(2,"TYPE : "_$$GET1^DIQ(350.1,$P(IB0,U,3),.01),"")
;
D SET^VALM10(3,"RESULTING FROM : "_$P(IB0,U,4),"")
;
S LINE="",LINE=$$SETL(LINE,$$GET1^DIQ(350.21,$P(IB0,U,5),.01),"STATUS : ",1,38)
S LINE=$$SETL(LINE,$$FMTE^XLFDT($P(IB0,U,17),"2DZ"),"EVENT DATE : ",40,38)
D SET^VALM10(4,LINE,"")
;
S LINE="",LINE=$$SETL(LINE,$P(IB0,U,9),"PARENT : ",1,38)
S LINE=$$SETL(LINE,$P(IB0,U,7),"CHARGE : ",40,38)
D SET^VALM10(5,LINE,"")
;
D SET^VALM10(6,"INSTITUTION : "_$$GET1^DIQ(4,$P(IB0,U,13),.01)_" : "_LST_" - "_CLINIC,"")
;
D SET^VALM10(7,"BILLED : "_$$FMTE^XLFDT($P(IB0,U,14),"2DZ")_" - "_$$FMTE^XLFDT($P(IB0,U,15),"2DZ"),"")
;
S LINE="",LINE=$$SETL(LINE,$$GET1^DIQ(4,$P(IB0,U,13),.01),"AR BILL # : ",1,38)
S LINE=$$SETL(LINE,$$FMTE^XLFDT($P(IB0,U,18),"2DZ"),"LAST BILLED : ",40,38)
D SET^VALM10(8,LINE,"")
;
D SET^VALM10(9,"IB COPAY TRANS # : "_$$GET1^DIQ(354.71,$P(IB0,U,19),.01),"")
D SET^VALM10(10,"CLINIC STOP : "_$$GET1^DIQ(352.5,$P(IB0,U,20),.01),"")
;
S GMT=$P(IB0,U,21)
D SET^VALM10(11,"GMT RELATED : "_$S(GMT=1:"Yes",1:"No"),"")
D SET^VALM10(12,"PFSS ACCT REF : "_$$GET1^DIQ(375,$P(IB0,U,22),.01),"")
;
S EAWHO=$$GET1^DIQ(200,$P(IB1,U,1),.01)
S EADAT=$$FMTE^XLFDT($P(IB1,U,2),"2DZ")
D SET^VALM10(13,"ENTRY ADDED : "_EAWHO_" "_EADAT,"")
;
S LUWHO=$$GET1^DIQ(200,$P(IB1,U,3),.01)
S LUDAT=$$FMTE^XLFDT($P(IB1,U,4),"2DZ")
D SET^VALM10(14,"LAST UPDATED : "_LUWHO_" "_LUDAT,"")
;
D SET^VALM10(15,"CHAMPVA ADM DATE : "_$$FMTE^XLFDT($P(IB1,U,5),"2DZ"),"")
D SET^VALM10(16,"ON HOLD DATE : "_$$FMTE^XLFDT($P(IB1,U,6),"2DZ"),"")
D SET^VALM10(17,"HOLD-REVIEW DATE : "_$$FMTE^XLFDT($P(IB1,U,7),"2DZ"),"")
S VALMBCK="R",VALMBG=1,VALMCNT=16
Q
;
HELP ; -- help code
N X
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
;K ^TMP($J)
D ^%ZISC
I
S VALMBCK="R" Q
Q
;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
; of the worklist
; Input: LINE - Current line being created
; DATA - Information to be added to the end of the current line
; LABEL - Label to describe the information being added
; COL - Column position in line to add information add
; LNG - Maximum length of data information to include on the line
; Returns: Line updated with added information
;S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
N NEW
S NEW=LABEL_$E(DATA,1,LNG)
S $E(LINE,COL)=NEW
Q LINE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOHLSE 3410 printed Oct 16, 2024@18:26:18 Page 2
IBOHLSE ;ALB/BAA - IB HELD CHARGES LIST MANAGER ;08-SEP-2015
+1 ;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- main entry point for HELD CHARGES EXPAND
+1 ; add code to do filters here
+2 ;
+3 DO EN^VALM("IB HELD CHARGES EXPAND")
+4 QUIT
+5 ;
HDR ; -- header code
+1 ;
+2 SET VALM("TITLE")=" Expanded Held Charges"
+3 SET XQORM("B")="QUIT"
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 ; input - none
+2 ; output ^TMP($J,"IBOHLSE")
+3 NEW DFN,CNT,NAME,IBIEN,REC,CLINIC,LST
+4 SET REC=^TMP($JOB,"IBOHLSE")
+5 SET DFN=$PIECE(REC,U,1)
SET CNT=$PIECE(REC,U,2)
+6 SET NAME=$PIECE(REC,U,3)
SET IBIEN=$PIECE(REC,U,4)
+7 SET LST=$PIECE(REC,U,5)
SET CLINIC=$PIECE(REC,U,6)
+8 DO BLD
+9 QUIT
+10 ;
BLD ; build data to display
+1 NEW CNT,SS,LINE,XX,RX,GMT,IB0,IB1,PATIEN,XX
+2 NEW EADAT,EAWHO,LUDAT,LUWHO
+3 SET (CNT,VALMCNT)=0
+4 SET IB0=^IB(IBIEN,0)
+5 SET IB1=^IB(IBIEN,1)
+6 SET SS=$$GET1^DIQ(2,DFN,.09)
+7 ;
+8 DO FULL^VALM1
+9 DO SET^VALM10(1,"PATIENT : "_NAME_" - "_SS,"")
+10 ;
+11 DO SET^VALM10(2,"TYPE : "_$$GET1^DIQ(350.1,$PIECE(IB0,U,3),.01),"")
+12 ;
+13 DO SET^VALM10(3,"RESULTING FROM : "_$PIECE(IB0,U,4),"")
+14 ;
+15 SET LINE=""
SET LINE=$$SETL(LINE,$$GET1^DIQ(350.21,$PIECE(IB0,U,5),.01),"STATUS : ",1,38)
+16 SET LINE=$$SETL(LINE,$$FMTE^XLFDT($PIECE(IB0,U,17),"2DZ"),"EVENT DATE : ",40,38)
+17 DO SET^VALM10(4,LINE,"")
+18 ;
+19 SET LINE=""
SET LINE=$$SETL(LINE,$PIECE(IB0,U,9),"PARENT : ",1,38)
+20 SET LINE=$$SETL(LINE,$PIECE(IB0,U,7),"CHARGE : ",40,38)
+21 DO SET^VALM10(5,LINE,"")
+22 ;
+23 DO SET^VALM10(6,"INSTITUTION : "_$$GET1^DIQ(4,$PIECE(IB0,U,13),.01)_" : "_LST_" - "_CLINIC,"")
+24 ;
+25 DO SET^VALM10(7,"BILLED : "_$$FMTE^XLFDT($PIECE(IB0,U,14),"2DZ")_" - "_$$FMTE^XLFDT($PIECE(IB0,U,15),"2DZ"),"")
+26 ;
+27 SET LINE=""
SET LINE=$$SETL(LINE,$$GET1^DIQ(4,$PIECE(IB0,U,13),.01),"AR BILL # : ",1,38)
+28 SET LINE=$$SETL(LINE,$$FMTE^XLFDT($PIECE(IB0,U,18),"2DZ"),"LAST BILLED : ",40,38)
+29 DO SET^VALM10(8,LINE,"")
+30 ;
+31 DO SET^VALM10(9,"IB COPAY TRANS # : "_$$GET1^DIQ(354.71,$PIECE(IB0,U,19),.01),"")
+32 DO SET^VALM10(10,"CLINIC STOP : "_$$GET1^DIQ(352.5,$PIECE(IB0,U,20),.01),"")
+33 ;
+34 SET GMT=$PIECE(IB0,U,21)
+35 DO SET^VALM10(11,"GMT RELATED : "_$SELECT(GMT=1:"Yes",1:"No"),"")
+36 DO SET^VALM10(12,"PFSS ACCT REF : "_$$GET1^DIQ(375,$PIECE(IB0,U,22),.01),"")
+37 ;
+38 SET EAWHO=$$GET1^DIQ(200,$PIECE(IB1,U,1),.01)
+39 SET EADAT=$$FMTE^XLFDT($PIECE(IB1,U,2),"2DZ")
+40 DO SET^VALM10(13,"ENTRY ADDED : "_EAWHO_" "_EADAT,"")
+41 ;
+42 SET LUWHO=$$GET1^DIQ(200,$PIECE(IB1,U,3),.01)
+43 SET LUDAT=$$FMTE^XLFDT($PIECE(IB1,U,4),"2DZ")
+44 DO SET^VALM10(14,"LAST UPDATED : "_LUWHO_" "_LUDAT,"")
+45 ;
+46 DO SET^VALM10(15,"CHAMPVA ADM DATE : "_$$FMTE^XLFDT($PIECE(IB1,U,5),"2DZ"),"")
+47 DO SET^VALM10(16,"ON HOLD DATE : "_$$FMTE^XLFDT($PIECE(IB1,U,6),"2DZ"),"")
+48 DO SET^VALM10(17,"HOLD-REVIEW DATE : "_$$FMTE^XLFDT($PIECE(IB1,U,7),"2DZ"),"")
+49 SET VALMBCK="R"
SET VALMBG=1
SET VALMCNT=16
+50 QUIT
+51 ;
HELP ; -- help code
+1 NEW X
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 ;K ^TMP($J)
+2 DO ^%ZISC
+3 IF $TEST
+4 SET VALMBCK="R"
QUIT
+5 QUIT
+6 ;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
+1 ; of the worklist
+2 ; Input: LINE - Current line being created
+3 ; DATA - Information to be added to the end of the current line
+4 ; LABEL - Label to describe the information being added
+5 ; COL - Column position in line to add information add
+6 ; LNG - Maximum length of data information to include on the line
+7 ; Returns: Line updated with added information
+8 ;S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
+9 NEW NEW
+10 SET NEW=LABEL_$EXTRACT(DATA,1,LNG)
+11 SET $EXTRACT(LINE,COL)=NEW
+12 QUIT LINE
