source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOUNP3.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1IBOUNP3 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1991
2 ;;2.0;INTEGRATED BILLING;**249**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5REPORT ;
6 N QUIT,IBODIV,CLNC,TIME,DFN,CTG,HDR,HDR2,HDR1,PAGE,NOW,LINE,B,E,NAME,CRT,BOT,DIVTOT,CLNTOT,TOTAL,FIRST
7 S CRT=0,BOT=6,QUIT=0 I $E(IOST,1,2)="C-" S CRT=1,BOT=2
8 S FIRST=1
9 W:CRT @IOF
10 S HDR="OUTPATIENT VISITS FOR VETERANS",LINE="",$P(LINE,"-",126)=""
11 D NOW^%DTC S Y=X X ^DD("DD") S NOW=Y
12 S Y=IBOBEG X ^DD("DD") S B=Y
13 S Y=IBOEND X ^DD("DD") S E=Y
14 S HDR2="FOR APPOINTMENTS " S:E'=B HDR2=HDR2_"FROM "_B_" TO "_E
15 S:E=B HDR2=HDR2_"ON "_B
16 I IBOUI S CTG="NO",HDR1=HDR_" WITH NO INSURANCE" D LOOP G:QUIT Q
17 I IBOEXP S CTG="EXPIRED",HDR1=HDR_" WHOSE INSURANCE IS EXPIRED OR WILL EXPIRE WITHIN 30 DAYS" D LOOP G:QUIT Q
18 I IBOUK S CTG="UNKNOWN",HDR1=HDR_" WHOSE INSURANCE IS UNKNOWN" D LOOP
19 I CRT,'QUIT D PAUSE
20Q D KVAR^VADPT K VA
21 Q
22LOOP ;
23 S IBODIV="",PAGE=1,(CLNTOT,DIVTOT,TOTAL)=0
24 F D:DIVTOT DIVTOT S:DIVTOT TOTAL=TOTAL+DIVTOT,DIVTOT=0 S IBODIV=$O(^TMP("IBOUNP",$J,CTG,IBODIV)) Q:IBODIV=""!QUIT S CLNC="" D
25 .D HEADER Q:QUIT
26 .W !!?6,"Division: ",?31,IBODIV,!
27 .F S CLNC=$O(^TMP("IBOUNP",$J,CTG,IBODIV,CLNC)) S DIVTOT=DIVTOT+CLNTOT,CLNTOT=0 Q:CLNC=""!QUIT D:$Y>(IOSL-BOT-4) HEADER Q:QUIT W !!,?6,"Clinic: ",?31,CLNC,! S NAME="" D
28 ..F S NAME=$O(^TMP("IBOUNP",$J,CTG,IBODIV,CLNC,NAME)) Q:QUIT D:NAME=""&(CLNTOT>0) CLNTOT Q:NAME="" D
29 ... F DFN=0:0 S DFN=$O(^TMP("IBOUNP",$J,CTG,IBODIV,CLNC,NAME,DFN)) Q:DFN'>0 S TIME=^TMP("IBOUNP",$J,CTG,IBODIV,CLNC,NAME,DFN) D ITEM Q:QUIT
30 D:'QUIT TOTAL
31 Q
32CLNTOT ; prints subtotal for clinic
33 I $Y+BOT>(IOSL-1) D HEADER
34 W !?3,"________________________"
35 W !,?3,"Clinic Subtotal : ",CLNTOT
36 Q
37DIVTOT ; prints subtotal for division
38 I $Y+BOT>(IOSL-1) D HEADER
39 W !?3,"________________________"
40 W !,?3,"Division Subtotal: ",DIVTOT
41 Q
42TOTAL ; prints total for all clincis
43 I ($Y+BOT>(IOSL-1))!($Y'>1) D HEADER Q:QUIT
44 W !?3,"________________________"
45 W !?3,"Total : ",TOTAL
46 F Q:($Y>(IOSL-2)) W !
47 Q
48ITEM ; prints patient data for a single appt
49 N CNT,TM,E1,E2,PID,MS,ES,SC,AGE,INS,I,VAPA S (E1,E2,PID,MS,ES,SC,AGE)="",CNT=2,CLNTOT=CLNTOT+1
50DATA S Y=TIME X ^DD("DD") S TM=$P(Y,"@",1)_"@"_$E($P(Y,"@",2),1,5)
51 D DEM^VADPT I 'VAERR S MS=$P(VADM(10),"^",2),PID=VA("PID"),AGE=VADM(4)
52 D OPD^VADPT I 'VAERR S ES=$P(VAPD(7),"^",2)
53 D ELIG^VADPT I 'VAERR,+VAEL(3) S SC=$P(VAEL(3),"^",2)
54CKSPACE ; tries to keep vet's data on same page
55 S VAPA("P")="" D ADD^VADPT I 'VAERR D
56 . F I=2,3,4 S:VAPA(I)]"" CNT=CNT+1
57 S VAOA("A")=5 D OAD^VADPT I 'VAERR S E1=VAOA(9) I E1]"" D
58 . S CNT=CNT+1
59 . F I=1,2,3,4,5,6,8 S E1(I)=VAOA(I)
60 . F I=1,2,3 S:VAOA(I)]"" CNT=CNT+1
61 S VAOA("A")=6 D OAD^VADPT I 'VAERR S E2=VAOA(9) I E2]"" D
62 . S CNT=CNT+1
63 . F I=1,2,3,4,5,6,8 S E2(I)=VAOA(I)
64 . F I=1,2,3 S:VAOA(I)]"" CNT=CNT+1
65 S CNT=$P($G(^DPT(DFN,.312,0)),"^",4)+CNT
66 I CNT>(IOSL-($Y+BOT)) D HEADER Q:QUIT
67PRINT W !?3,$E(NAME,1,25),?31,PID,?51,TM,?74,AGE,?81,SC,?87,$E(MS,1,15),?104,$E(ES,1,20)
68 W !?31,"Address:",?51,VAPA(1),?87,"Tele: ",?104,VAPA(8) W:VAPA(2)]"" !?51,VAPA(2) W:VAPA(3)]"" !?51,VAPA(3) W:VAPA(4)]"" !?51,VAPA(4)_","_$P($G(^DIC(5,+VAPA(5),0)),"^",2)_" "_VAPA(6)
69 I E1]"" W !?31,"Employer:",?51,E1,?87,"Tele: ",?104,E1(8) W:E1(1)]"" !?51,E1(1) W:E1(2)]"" !?51,E1(2) W:E1(3)]"" !?51,E1(3) W:E1(4)]"" !?51,E1(4)_","_$P($G(^DIC(5,+E1(5),0)),"^",2)_" "_E1(6)
70 I E2]"" W !?31,"Sps's Emplr:",?51,E2,?87,"Tele: ",?104,E2(8) W:E2(1)]"" !?51,E2(1) W:E2(2)]"" !?51,E2(2) W:E2(3)]"" !?51,E2(3) W:E2(4)]"" !?51,E2(4)_","_$P($G(^DIC(5,+E2(5),0)),"^",2)_" "_E2(6)
71INS ; writes insurance data
72 N I,J S J=1 F I=0:0 S I=$O(^DPT(DFN,.312,I)) Q:I'>0 S INS=$G(^(I,0)) D:$Y>(IOSL-BOT) HEADER Q:QUIT W ! W:J ?31,"Insurance:" W ?51,$P($G(^DIC(36,$P(INS,"^",1),0)),"^",1),?87 W:J "Expiration:" S Y=$P(INS,"^",4),J=0 I Y>0 X ^DD("DD") W ?104,Y
73 Q
74HEADER ; writes the report header
75 I CRT,$Y>1,'FIRST D Q:QUIT
76 . F Q:$Y>(IOSL-1) W !
77 .D PAUSE
78 I 'FIRST W @IOF
79 I FIRST S FIRST=0
80 W !,HDR1,?104,NOW," PAGE ",PAGE,!,HDR2,!!
81 W ?3,"PATIENT NAME",?32,"PT ID",?51,"APPT DATE/TIME",?74,"AGE",?81,"%SC",?87,"MARITAL STATUS",?104,"EMPLOYMENT STATUS",!
82 W LINE
83 S PAGE=PAGE+1
84 Q
85PAUSE ;
86 N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S QUIT=1 Q
87 Q
Note: See TracBrowser for help on using the repository browser.