Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRC4

IBTRC4.m

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