IBOUNP5.m

IBOUNP5 ;ALB/CJM - INPATIENT INSURANCE REPORT ;JAN 25,1992

 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 ; TIME appointment or admission time time

 ; CTG category vet is in (no,expired,unknow)

 ; INS =1 in there is insurance data

 ; RPTD =1 if appt should appear on report

 ; IBOPICK ="D" if the user chose to enter a date range, otherwise ="C"

 ;              for the current date

 ; END2 30 days into the future, starting either from the curren date

 ;       or END, depending on IBOPICK

LOOP ; loops through inpatients

 N DIV,DFN,PAT,TIME,CTG,INS,QUIT,RPTD,END2

 I IBOPICK="C" D LOOP1

 I IBOPICK="D" D LOOP2

 Q

LOOP1 ; finds current admissions for selected divisions

 N TDY,WRD,WRDN,ADM,DTH,R S WRD=0

 D NOW^%DTC S (TDY,X1)=X,X2=30 D C^%DTC S END2=X

 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

 . 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

 Q

LOOP2 ; finds admissions during selected date range for selected divisions

 N WRD0,WRDN

 N T S X1=IBOEND,X2=30 D C^%DTC S END2=X

 S T=(IBOBEG-.0001)

 F  S T=$O(^DGPM("AMV1",T)) Q:'T!(T>(IBOEND+.99))  D

 .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

 Q

PROC ;

 D DIV:IBOPICK'="C",DONE:'QUIT,VET:'QUIT S RPTD=0 D:'QUIT UNK:IBOUK,EXP:'RPTD&IBOEXP,UNI:'RPTD&IBOUI,INDEX:RPTD

 Q

VET ; checks if patient is a vet

 S QUIT=1 D ELIG^VADPT Q:VAERR  S:VAEL(4) QUIT=0

 Q

DONE ; checks if patient already on report

 S:$D(^TMP($J,"PATIENTS",DFN)) QUIT=1

 Q

INDEX ; indexes appointment,also indexs vet so he won't be reported twice

 N NAME,D

 S D=""

 I DIV S D=$P($G(^DG(40.8,DIV,0)),"^",1)

 I D="" S D="NOT KNOWN"

 I WRDN="" S WRDN="NOT KNOWN"

 S NAME=$P($G(^DPT(DFN,0)),"^",1) Q:NAME'[""

 S ^TMP($J,CTG,D,$S(IBOBYWRD:WRDN,1:"ALL WARDS"),NAME,DFN)=TIME_"^"_WRDN

 S ^TMP($J,"PATIENTS",DFN)=""

 Q

UNK ; goes in 'unknown' category if the field COVERED BY HEALTH INSURANCE

 ; was not answered, was answered unknown, and there is no insurance data

 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

 Q

EXP ; goes in expired category only if there is insurance and

 ; all of it expired before end of specified period + 30 days

 S RPTD=0 N T,E D CKINS I 'INS Q

 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

 Q

UNI ; goes in unisured category if there is no insurance data and 

 ; the field COVERED BY HEALTH INSURANCE was answered YES or NO

 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

 Q

CKINS ; checks if any insurance in insurance multiple of patient record

 S INS=0 I $O(^DPT(DFN,.312,0)) S INS=1

 Q

DIV ; checks if the division is on the list VAUTD()

 S QUIT=0 I VAUTD=1 Q

 I 'DIV S QUIT=1 Q

 I '$D(VAUTD(+DIV)) S QUIT=1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBOUNP5   3156     printed  Feb 18, 2025@23:52:49                                                                                                                                                                                                     Page 2

IBOUNP5   ;ALB/CJM - INPATIENT INSURANCE REPORT ;JAN 25,1992

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ; TIME appointment or admission time time

 +3       ; CTG category vet is in (no,expired,unknow)

 +4       ; INS =1 in there is insurance data

 +5       ; RPTD =1 if appt should appear on report

 +6       ; IBOPICK ="D" if the user chose to enter a date range, otherwise ="C"

 +7       ;              for the current date

 +8       ; END2 30 days into the future, starting either from the curren date

 +9       ;       or END, depending on IBOPICK

LOOP      ; loops through inpatients

 +1        NEW DIV,DFN,PAT,TIME,CTG,INS,QUIT,RPTD,END2

 +2        IF IBOPICK="C"

               DO LOOP1

 +3        IF IBOPICK="D"

               DO LOOP2

 +4        QUIT 

LOOP1     ; finds current admissions for selected divisions

 +1        NEW TDY,WRD,WRDN,ADM,DTH,R

           SET WRD=0

 +2        DO NOW^%DTC

           SET (TDY,X1)=X

           SET X2=30

           DO C^%DTC

           SET END2=X

 +3        FOR 

               SET WRD=$ORDER(^DIC(42,WRD))

               if WRD'>0

                   QUIT 

               SET R=$GET(^(WRD,0))

               SET DIV=$PIECE(R,"^",11)

               SET WRDN=$PIECE(R,"^",1)

               DO DIV

               IF 'QUIT&(WRDN]"")

                   Begin DoDot:1

 +4                    SET DFN=0

                       FOR 

                           SET DFN=$ORDER(^DPT("CN",WRDN,DFN))

                           if DFN'>0

                               QUIT 

                           SET ADM=^(DFN)

                           IF ADM]""

                               IF $PIECE($GET(^DGPM(+ADM,0)),"^",2)=1

                                   SET TIME=+^(0)

                                   SET DTH=+$GET(^DPT(DFN,.35))

                                   if 'DTH!((DTH\1)=TDY)

                                       DO PROC

                   End DoDot:1

 +5        QUIT 

LOOP2     ; finds admissions during selected date range for selected divisions

 +1        NEW WRD0,WRDN

 +2        NEW T

           SET X1=IBOEND

           SET X2=30

           DO C^%DTC

           SET END2=X

 +3        SET T=(IBOBEG-.0001)

 +4        FOR 

               SET T=$ORDER(^DGPM("AMV1",T))

               if 'T!(T>(IBOEND+.99))

                   QUIT 

               Begin DoDot:1

 +5                SET DFN=0

                   FOR 

                       SET DFN=$ORDER(^DGPM("AMV1",T,DFN))

                       if 'DFN

                           QUIT 

                       SET DIV=""

                       SET DIV=$ORDER(^DGPM("AMV1",T,DFN,DIV))

                       if DIV'>0

                           QUIT 

                       SET WRD0=$GET(^DIC(42,+$PIECE($GET(^DGPM(DIV,0)),U,6),0))

                       SET DIV=+$PIECE(WRD0,U,11)

                       SET WRDN=$PIECE(WRD0,"^")

                       SET TIME=T

                       SET QUIT=0

                       if DIV

                           DO PROC

               End DoDot:1

 +6        QUIT 

PROC      ;

 +1        if IBOPICK'="C"

               DO DIV

           if 'QUIT

               DO DONE

           if 'QUIT

               DO VET

           SET RPTD=0

           if 'QUIT

               if IBOUK

                   DO UNK

               if 'RPTD&IBOEXP

                   DO EXP

               if 'RPTD&IBOUI

                   DO UNI

               if RPTD

                   DO INDEX

 +2        QUIT 

VET       ; checks if patient is a vet

 +1        SET QUIT=1

           DO ELIG^VADPT

           if VAERR

               QUIT 

           if VAEL(4)

               SET QUIT=0

 +2        QUIT 

DONE      ; checks if patient already on report

 +1        if $DATA(^TMP($JOB,"PATIENTS",DFN))

               SET QUIT=1

 +2        QUIT 

INDEX     ; indexes appointment,also indexs vet so he won't be reported twice

 +1        NEW NAME,D

 +2        SET D=""

 +3        IF DIV

               SET D=$PIECE($GET(^DG(40.8,DIV,0)),"^",1)

 +4        IF D=""

               SET D="NOT KNOWN"

 +5        IF WRDN=""

               SET WRDN="NOT KNOWN"

 +6        SET NAME=$PIECE($GET(^DPT(DFN,0)),"^",1)

           if NAME'[""

               QUIT 

 +7        SET ^TMP($JOB,CTG,D,$SELECT(IBOBYWRD:WRDN,1:"ALL WARDS"),NAME,DFN)=TIME_"^"_WRDN

 +8        SET ^TMP($JOB,"PATIENTS",DFN)=""

 +9        QUIT 

UNK       ; goes in 'unknown' category if the field COVERED BY HEALTH INSURANCE

 +1       ; was not answered, was answered unknown, and there is no insurance data

 +2        SET RPTD=0

           NEW T

           SET T=$PIECE($GET(^DPT(DFN,.31)),"^",11)

           IF T="U"!(T="")

               DO CKINS

               IF 'INS

                   SET CTG="UNKNOWN"

                   SET RPTD=1

                   QUIT 

 +3        QUIT 

EXP       ; goes in expired category only if there is insurance and

 +1       ; all of it expired before end of specified period + 30 days

 +2        SET RPTD=0

           NEW T,E

           DO CKINS

           IF 'INS

               QUIT 

 +3        SET RPTD=1

           SET CTG="EXPIRED"

           FOR T=0:0

               SET T=$ORDER(^DPT(DFN,.312,T))

               if T'>0

                   QUIT 

               SET E=$PIECE($GET(^(T,0)),"^",4)

               IF E=""!(E>END2)

                   SET RPTD=0

                   QUIT 

 +4        QUIT 

UNI       ; goes in unisured category if there is no insurance data and 

 +1       ; the field COVERED BY HEALTH INSURANCE was answered YES or NO

 +2        SET RPTD=0

           NEW T

           SET T=$PIECE($GET(^DPT(DFN,.31)),"^",11)

           IF T="N"!(T="Y")

               DO CKINS

               IF 'INS

                   SET CTG="NO"

                   SET RPTD=1

 +3        QUIT 

CKINS     ; checks if any insurance in insurance multiple of patient record

 +1        SET INS=0

           IF $ORDER(^DPT(DFN,.312,0))

               SET INS=1

 +2        QUIT 

DIV       ; checks if the division is on the list VAUTD()

 +1        SET QUIT=0

           IF VAUTD=1

               QUIT 

 +2        IF 'DIV

               SET QUIT=1

               QUIT 

 +3        IF '$DATA(VAUTD(+DIV))

               SET QUIT=1

 +4        QUIT