| 1 | IBOUNP5 ;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
|
|---|
| 11 | LOOP ; 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
|
|---|
| 16 | LOOP1 ; 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
|
|---|
| 22 | LOOP2 ; 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
|
|---|
| 29 | PROC ;
|
|---|
| 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
|
|---|
| 32 | VET ; checks if patient is a vet
|
|---|
| 33 | S QUIT=1 D ELIG^VADPT Q:VAERR S:VAEL(4) QUIT=0
|
|---|
| 34 | Q
|
|---|
| 35 | DONE ; checks if patient already on report
|
|---|
| 36 | S:$D(^TMP($J,"PATIENTS",DFN)) QUIT=1
|
|---|
| 37 | Q
|
|---|
| 38 | INDEX ; 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
|
|---|
| 48 | UNK ; 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
|
|---|
| 52 | EXP ; 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
|
|---|
| 57 | UNI ; 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
|
|---|
| 61 | CKINS ; 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
|
|---|
| 64 | DIV ; 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
|
|---|
