IBTRC4 ;ALB/AAS - CLAIMS TRACKING - PRINT REVIEW WORKSHEET ; 14-JUL-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% G RWM
;
RW ; -- print Review Worksheet from lm action from ibtre
D FULL^VALM1
D PRINT(DFN)
RWQ S VALMBCK="R" Q
;
RWM ; -- print review worksheet from menu
W !,"Print Insurance Review Worksheet",!
RWM1 ;
; -- select patient
D PAT^IBCNSM I $D(VALMQUIT)!('$G(DFN)) G RWMQ
;
; -- print the sheet, reask patient
I $G(DFN) D PRINT(DFN),RWMQ W !! G RWM1
Q
;
RWMQ K I,J,X,Y,DIC,DFN,VALMQUIT
Q
;
PRINT(DFN) ; -- print one worksheet
;
N I,J,X,Y,VA,VA200,VAERR,VAIN,IBINS,IBCNT,IBX,TAB,TAB2,POP
;
S %ZIS="QM" D ^%ZIS G:POP PRINTQ
I $D(IO("Q")) K IO("Q") S ZTRTN="DQ1^IBTRC4",ZTSAVE("DFN")="",ZTSAVE("IB*")="",ZTDESC="IB - Print Review Worksheet" D ^%ZTLOAD K ZTSK D HOME^%ZIS G PRINTQ
;
U IO
;
DQ1 D DQ G RWMQ
Q
DQ ; -- entry point from taskman
S VA200="",TAB=3,TAB2=$S(IOM>120:80,1:44)
D INP^VADPT,PID^VADPT,INS
;
TOP W !!,?(IOM-26/2),"INSURANCE REVIEW WORKSHEET",!?(IOM-22),$$HTE^XLFDT($H)
W !!?TAB," Specialty: ",$E($P($G(VAIN(3)),"^",2),1,23)
W ?TAB2+8,"Ward: ",$P($G(VAIN(4)),"^",2)
W !!?TAB," Name: ",$E($P($G(^DPT(DFN,0)),"^",1),1,23)
W ?TAB2,"Insurance Co: ",$G(IBX(1))
W !?TAB," Pt ID: ",VA("PID"),?(TAB2+14),$G(IBX(2))
W !?TAB," DOB: ",$$FMTE^XLFDT($P($G(^DPT(DFN,0)),"^",3)),?(TAB2+14),$G(IBX(3))
W !!?TAB,"Admission Date: ",$P($G(VAIN(7)),"^",2)
W ?TAB2," DC Date: ________ LOS: _____"
W !!?TAB," Attending MD: ",$E($P($G(VAIN(11)),"^",2),1,20)
W ?TAB2," Primary MD: ",$E($P($G(VAIN(2)),"^",2),1,20)
W !!?TAB,"Complaint/Hist: ",$$LINE("_",IOM-TAB-17)
W !!?TAB," ",$$LINE("_",IOM-TAB-17)
W !!?TAB," Treatment: ",$$LINE("_",IOM-TAB-17)
W !!?TAB," ",$$LINE("_",IOM-TAB-17)
I $E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) G PRINTQ
;
MID ;
W !!?TAB,$$LINE("=",IOM-TAB-1)
W !?TAB,"|Date",?12,"|Diagnosis",?37,"|Procedure",?64,"|DRG",?71,"|LOS |" W:IOM>130 "Notes",?130,"|"
I $E(IOST,1,2)'="C-" W $C(13)," ",$$LINE("_",IOM-TAB-1)
F I=1:1:8 D BLINE
W !?TAB,$$LINE("=",IOM-TAB-1)
I $E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) G PRINTQ
;
BOT ;
W !?TAB,"|Insurance Contact: ",$$LINE("_",26)," Phone: ",$$LINE("_",20),"|"
W !?TAB,"|",$$LINE("_",IOM-TAB-3),"|"
W !?TAB,"|Date |Comments (#day approved, next review date, etc.)",?IOM-2,"|"
I $E(IOST,1,2)'="C-" W $C(13)," ",$$LINE("_",IOM-TAB-1)
F I=1:1:5 D BLINE2
W !?TAB,$$LINE("=",IOM-TAB-1)
W !!?TAB,"Reviewer: _____________________________________ Date: ____________________"
I $E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) G PRINTQ
;
PRINTQ W !
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
Q
;
LINE(CHAR,LEN) ; -- return line of length len of character char
I '$G(LEN) S LEN=IOM
I $G(CHAR)="" S CHAR="-"
Q $TR($J(" ",LEN)," ",CHAR)
;
BLINE ; -- print line with bars
W !?TAB,"| | | | | |" W:IOM>130 " |"
W !?TAB,"|________|________________________|__________________________|______|______|" W:IOM>130 "___________________________________________________|"
Q
BLINE2 ; -- print line with bars
W !?TAB,"| | " W:IOM<130 "|" W:IOM>130 " |"
W !?TAB,"|________|_________________________________________________________________" W:IOM<130 "|" W:IOM>130 "____________________________________________________|"
Q
;
INS ; -- print insurance info
D ALL^IBCNS1(DFN,"IBINS",1,$S(+VAIN(8):+VAIN(8),1:DT))
K IBX
I $G(IBINS(0))<1 S IBX(1)="No Active Insurance" G INSQ
S I=0,IBCNT=0 F S I=$O(IBINS(I)) Q:'I S IBCNT=$G(IBCNT)+1,IBX(IBCNT)=$E($P($G(^DIC(36,+IBINS(I,0),0)),"^"),1,20) Q:IBCNT>3
;
INSQ Q
IBTRC4 ;ALB/AAS - CLAIMS TRACKING - PRINT REVIEW WORKSHEET ; 14-JUL-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% GOTO RWM
+1 ;
RW ; -- print Review Worksheet from lm action from ibtre
+1 DO FULL^VALM1
+2 DO PRINT(DFN)
RWQ SET VALMBCK="R"
QUIT
+1 ;
RWM ; -- print review worksheet from menu
+1 WRITE !,"Print Insurance Review Worksheet",!
RWM1 ;
+1 ; -- select patient
+2 DO PAT^IBCNSM
IF $DATA(VALMQUIT)!('$GET(DFN))
GOTO RWMQ
+3 ;
+4 ; -- print the sheet, reask patient
+5 IF $GET(DFN)
DO PRINT(DFN)
DO RWMQ
WRITE !!
GOTO RWM1
+6 QUIT
+7 ;
RWMQ KILL I,J,X,Y,DIC,DFN,VALMQUIT
+1 QUIT
+2 ;
PRINT(DFN) ; -- print one worksheet
+1 ;
+2 NEW I,J,X,Y,VA,VA200,VAERR,VAIN,IBINS,IBCNT,IBX,TAB,TAB2,POP
+3 ;
+4 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO PRINTQ
+5 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="DQ1^IBTRC4"
SET ZTSAVE("DFN")=""
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - Print Review Worksheet"
DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
GOTO PRINTQ
+6 ;
+7 USE IO
+8 ;
DQ1 DO DQ
GOTO RWMQ
+1 QUIT
DQ ; -- entry point from taskman
+1 SET VA200=""
SET TAB=3
SET TAB2=$SELECT(IOM>120:80,1:44)
+2 DO INP^VADPT
DO PID^VADPT
DO INS
+3 ;
TOP WRITE !!,?(IOM-26/2),"INSURANCE REVIEW WORKSHEET",!?(IOM-22),$$HTE^XLFDT($HOROLOG)
+1 WRITE !!?TAB," Specialty: ",$EXTRACT($PIECE($GET(VAIN(3)),"^",2),1,23)
+2 WRITE ?TAB2+8,"Ward: ",$PIECE($GET(VAIN(4)),"^",2)
+3 WRITE !!?TAB," Name: ",$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^",1),1,23)
+4 WRITE ?TAB2,"Insurance Co: ",$GET(IBX(1))
+5 WRITE !?TAB," Pt ID: ",VA("PID"),?(TAB2+14),$GET(IBX(2))
+6 WRITE !?TAB," DOB: ",$$FMTE^XLFDT($PIECE($GET(^DPT(DFN,0)),"^",3)),?(TAB2+14),$GET(IBX(3))
+7 WRITE !!?TAB,"Admission Date: ",$PIECE($GET(VAIN(7)),"^",2)
+8 WRITE ?TAB2," DC Date: ________ LOS: _____"
+9 WRITE !!?TAB," Attending MD: ",$EXTRACT($PIECE($GET(VAIN(11)),"^",2),1,20)
+10 WRITE ?TAB2," Primary MD: ",$EXTRACT($PIECE($GET(VAIN(2)),"^",2),1,20)
+11 WRITE !!?TAB,"Complaint/Hist: ",$$LINE("_",IOM-TAB-17)
+12 WRITE !!?TAB," ",$$LINE("_",IOM-TAB-17)
+13 WRITE !!?TAB," Treatment: ",$$LINE("_",IOM-TAB-17)
+14 WRITE !!?TAB," ",$$LINE("_",IOM-TAB-17)
+15 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
IF $DATA(DIRUT)
GOTO PRINTQ
+16 ;
MID ;
+1 WRITE !!?TAB,$$LINE("=",IOM-TAB-1)
+2 WRITE !?TAB,"|Date",?12,"|Diagnosis",?37,"|Procedure",?64,"|DRG",?71,"|LOS |"
IF IOM>130
WRITE "Notes",?130,"|"
+3 IF $EXTRACT(IOST,1,2)'="C-"
WRITE $CHAR(13)," ",$$LINE("_",IOM-TAB-1)
+4 FOR I=1:1:8
DO BLINE
+5 WRITE !?TAB,$$LINE("=",IOM-TAB-1)
+6 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
IF $DATA(DIRUT)
GOTO PRINTQ
+7 ;
BOT ;
+1 WRITE !?TAB,"|Insurance Contact: ",$$LINE("_",26)," Phone: ",$$LINE("_",20),"|"
+2 WRITE !?TAB,"|",$$LINE("_",IOM-TAB-3),"|"
+3 WRITE !?TAB,"|Date |Comments (#day approved, next review date, etc.)",?IOM-2,"|"
+4 IF $EXTRACT(IOST,1,2)'="C-"
WRITE $CHAR(13)," ",$$LINE("_",IOM-TAB-1)
+5 FOR I=1:1:5
DO BLINE2
+6 WRITE !?TAB,$$LINE("=",IOM-TAB-1)
+7 WRITE !!?TAB,"Reviewer: _____________________________________ Date: ____________________"
+8 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
IF $DATA(DIRUT)
GOTO PRINTQ
+9 ;
PRINTQ WRITE !
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 DO ^%ZISC
+3 QUIT
+4 ;
LINE(CHAR,LEN) ; -- return line of length len of character char
+1 IF '$GET(LEN)
SET LEN=IOM
+2 IF $GET(CHAR)=""
SET CHAR="-"
+3 QUIT $TRANSLATE($JUSTIFY(" ",LEN)," ",CHAR)
+4 ;
BLINE ; -- print line with bars
+1 WRITE !?TAB,"| | | | | |"
IF IOM>130
WRITE " |"
+2 WRITE !?TAB,"|________|________________________|__________________________|______|______|"
IF IOM>130
WRITE "___________________________________________________|"
+3 QUIT
BLINE2 ; -- print line with bars
+1 WRITE !?TAB,"| | "
IF IOM<130
WRITE "|"
IF IOM>130
WRITE " |"
+2 WRITE !?TAB,"|________|_________________________________________________________________"
IF IOM<130
WRITE "|"
IF IOM>130
WRITE "____________________________________________________|"
+3 QUIT
+4 ;
INS ; -- print insurance info
+1 DO ALL^IBCNS1(DFN,"IBINS",1,$SELECT(+VAIN(8):+VAIN(8),1:DT))
+2 KILL IBX
+3 IF $GET(IBINS(0))<1
SET IBX(1)="No Active Insurance"
GOTO INSQ
+4 SET I=0
SET IBCNT=0
FOR
SET I=$ORDER(IBINS(I))
IF 'I
QUIT
SET IBCNT=$GET(IBCNT)+1
SET IBX(IBCNT)=$EXTRACT($PIECE($GET(^DIC(36,+IBINS(I,0),0)),"^"),1,20)
IF IBCNT>3
QUIT
+5 ;
INSQ QUIT
