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

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBOUNP5 ;ALB/CJM - INPATIENT INSURANCE REPORT ;JAN 25,1992
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ; TIME appointment or admission time time
4 ; CTG category vet is in (no,expired,unknow)
5 ; INS =1 in there is insurance data
6 ; RPTD =1 if appt should appear on report
7 ; IBOPICK ="D" if the user chose to enter a date range, otherwise ="C"
8 ; for the current date
9 ; END2 30 days into the future, starting either from the curren date
10 ; or END, depending on IBOPICK
11LOOP ; loops through inpatients
12 N DIV,DFN,PAT,TIME,CTG,INS,QUIT,RPTD,END2
13 I IBOPICK="C" D LOOP1
14 I IBOPICK="D" D LOOP2
15 Q
16LOOP1 ; finds current admissions for selected divisions
17 N TDY,WRD,WRDN,ADM,DTH,R S WRD=0
18 D NOW^%DTC S (TDY,X1)=X,X2=30 D C^%DTC S END2=X
19 F S WRD=$O(^DIC(42,WRD)) Q:WRD'>0 S R=$G(^(WRD,0)),DIV=$P(R,"^",11),WRDN=$P(R,"^",1) D DIV I 'QUIT&(WRDN]"") D
20 . S DFN=0 F S DFN=$O(^DPT("CN",WRDN,DFN)) Q:DFN'>0 S ADM=^(DFN) I ADM]"",$P($G(^DGPM(+ADM,0)),"^",2)=1 S TIME=+^(0),DTH=+$G(^DPT(DFN,.35)) D:'DTH!((DTH\1)=TDY) PROC
21 Q
22LOOP2 ; finds admissions during selected date range for selected divisions
23 N WRD0,WRDN
24 N T S X1=IBOEND,X2=30 D C^%DTC S END2=X
25 S T=(IBOBEG-.0001)
26 F S T=$O(^DGPM("AMV1",T)) Q:'T!(T>(IBOEND+.99)) D
27 .S DFN=0 F S DFN=$O(^DGPM("AMV1",T,DFN)) Q:'DFN S DIV="",DIV=$O(^DGPM("AMV1",T,DFN,DIV)) Q:DIV'>0 S WRD0=$G(^DIC(42,+$P($G(^DGPM(DIV,0)),U,6),0)),DIV=+$P(WRD0,U,11),WRDN=$P(WRD0,"^"),TIME=T,QUIT=0 D:DIV PROC
28 Q
29PROC ;
30 D DIV:IBOPICK'="C",DONE:'QUIT,VET:'QUIT S RPTD=0 D:'QUIT UNK:IBOUK,EXP:'RPTD&IBOEXP,UNI:'RPTD&IBOUI,INDEX:RPTD
31 Q
32VET ; checks if patient is a vet
33 S QUIT=1 D ELIG^VADPT Q:VAERR S:VAEL(4) QUIT=0
34 Q
35DONE ; checks if patient already on report
36 S:$D(^TMP($J,"PATIENTS",DFN)) QUIT=1
37 Q
38INDEX ; indexes appointment,also indexs vet so he won't be reported twice
39 N NAME,D
40 S D=""
41 I DIV S D=$P($G(^DG(40.8,DIV,0)),"^",1)
42 I D="" S D="NOT KNOWN"
43 I WRDN="" S WRDN="NOT KNOWN"
44 S NAME=$P($G(^DPT(DFN,0)),"^",1) Q:NAME'[""
45 S ^TMP($J,CTG,D,$S(IBOBYWRD:WRDN,1:"ALL WARDS"),NAME,DFN)=TIME_"^"_WRDN
46 S ^TMP($J,"PATIENTS",DFN)=""
47 Q
48UNK ; goes in 'unknown' category if the field COVERED BY HEALTH INSURANCE
49 ; was not answered, was answered unknown, and there is no insurance data
50 S RPTD=0 N T S T=$P($G(^DPT(DFN,.31)),"^",11) I T="U"!(T="") D CKINS I 'INS S CTG="UNKNOWN",RPTD=1 Q
51 Q
52EXP ; goes in expired category only if there is insurance and
53 ; all of it expired before end of specified period + 30 days
54 S RPTD=0 N T,E D CKINS I 'INS Q
55 S RPTD=1,CTG="EXPIRED" F T=0:0 S T=$O(^DPT(DFN,.312,T)) Q:T'>0 S E=$P($G(^(T,0)),"^",4) I E=""!(E>END2) S RPTD=0 Q
56 Q
57UNI ; goes in unisured category if there is no insurance data and
58 ; the field COVERED BY HEALTH INSURANCE was answered YES or NO
59 S RPTD=0 N T S T=$P($G(^DPT(DFN,.31)),"^",11) I T="N"!(T="Y") D CKINS I 'INS S CTG="NO",RPTD=1
60 Q
61CKINS ; checks if any insurance in insurance multiple of patient record
62 S INS=0 I $O(^DPT(DFN,.312,0)) S INS=1
63 Q
64DIV ; checks if the division is on the list VAUTD()
65 S QUIT=0 I VAUTD=1 Q
66 I 'DIV S QUIT=1 Q
67 I '$D(VAUTD(+DIV)) S QUIT=1
68 Q
Note: See TracBrowser for help on using the repository browser.