APCLBV1.m

APCLBV1 ; IHS/CMI/LAB - PRNT BILL VSTS ;

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 ;

 ;cmi/anch/maw 9/10/2007 code set versioning in WPOV

 ;

START ;

 S APCL80E="==============================================================================="

 S APCL80D="-------------------------------------------------------------------------------"

 S (APCLPG,APCLPN)=0

 I '$D(^XTMP("APCLBV",APCLJOB,APCLBT)) D HEAD W !,"No visits to report",! G DONE

 G:$D(APCLPALL) ALL

 S APCLPN=0 K APCLQUIT

 D HEAD F  S APCLPN=$O(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN)) Q:APCLPN=""!($D(APCLQUIT))  D DFN

 I $Y>(IOSL-4) D HEAD G:$D(APCLQUIT) DONE

 I APCLRNUM=1 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT1

 I APCLRNUM=2 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT2

 I APCLRNUM=3 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT3

 I APCLRNUM=4 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT4

 I APCLRNUM=5 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT5

 I APCLRNUM=6 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT6

 W !

 D DONE

 Q

 ;

ALL ;print ALL coverage reports

 F APCLCNTR=1:1:6 Q:$D(APCLQUIT)  S (APCLPROC,APCLRNUM)=APCLCNTR D ALL1 Q:$D(APCLQUIT)  D PTN

 I $Y>(IOSL-4) D HEAD G:$D(APCLQUIT) DONE

 W !!,"Total Number of Visits:  ",APCLTOTV

 D DONE

 Q

ALL1 ;

 D HEAD Q:$D(APCLQUIT)

 I '$D(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM)) W !,"No visits to report",! S APCLPN=0 K APCLQUIT

 Q

DONE ;

 D DONE^APCLOSUT

 K ^XTMP("APCLBV",APCLJOB,APCLBT)

 Q

PTN ;process patient name level

 F  S APCLPN=$O(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN)) Q:APCLPN=""!(APCLPROC'=APCLRNUM)!($D(APCLQUIT))  D DFN

 ;write totals

 I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)

 I APCLRNUM=1 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT1

 I APCLRNUM=2 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT2

 I APCLRNUM=3 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT3

 I APCLRNUM=4 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT4

 I APCLRNUM=5 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT5

 I APCLRNUM=6 W !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT6

 W !

 Q

DFN ;

 S DFN="" F  S DFN=$O(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN,DFN)) Q:DFN=""!($D(APCLQUIT))  D @APCLPROC

 Q

VISIT ;ENTRY POINT

 W !?8,"Visit Date",?21,"Category",?37,"PRV",?41,"ICD DX",?51,"PROVIDER NARRATIVE"

 W !?8 F I=1:1:71 W "-"

 S APCLVDFN=0 F  S APCLVDFN=$O(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN,DFN,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN!($D(APCLQUIT))  S APCLVREC=^AUPNVSIT(APCLVDFN,0) D VWRT

 Q

VWRT ;

 I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)

 S Y=$P(+APCLVREC,".") D DD^%DT S APCLDATE=Y

 K ^UTILITY("DIQ1",$J)

 K DIQ,DIC,DA,DR

 S DIC="^AUPNVSIT(",DR=".07",DA=APCLVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ

 S APCLCAT=^UTILITY("DIQ1",$J,9000010,APCLVDFN,.07,"E")

 S (APCL1,APCL2)=0 F  S APCL2=$O(^AUPNVPRV("AD",APCLVDFN,APCL2)) Q:APCL2=""  I $P(^AUPNVPRV(APCL2,0),U,4)="P" S APCL1=APCL1+1,APCLAP=$P(^(0),U)

 I APCL1=0 Q

 S APCLDISC="" D CHKDISC

 W !?8,APCLDATE,?21,APCLCAT,?37,APCLDISC

 S (APCL1,APCL2)=0 F  S APCL1=$O(^AUPNVPOV("AD",APCLVDFN,APCL1)) Q:APCL1'=+APCL1!($D(APCLQUIT))  S APCLX=^AUPNVPOV(APCL1,0),APCL2=APCL2+1 D WPOV

 I $D(^AUPNVINP("AD",APCLVDFN)) S Y=$O(^AUPNVINP("AD",APCLVDFN,"")),Y=$P(^AUPNVINP(Y,0),U) D DD^%DT W !?8,"DISCHARGE DATE:  ",Y

 Q

WPOV ;

 I $Y>(IOSL-6),APCL2>1 D HEAD Q:$D(APCLQUIT)

 Q:$P(APCLX,U)=""

 Q:$P(APCLX,U,4)=""

 ;W:APCL2>1 ! W ?41,$P(^ICD9($P(APCLX,U),0),U),?49,$E($P(^AUTNPOV($P(APCLX,U,4),0),U),1,20)  ;cmi/anch/maw 9/10/2007 orig line

 W:APCL2>1 ! W ?41,$P($$ICDDX^ICDEX($P(APCLX,U)),U,2),?51,$E($$VAL^XBDIQ1(9000010.07,APCL1,.04),1,20)  ;cmi/anch/maw 9/10/2007 code set versioning

 Q

CHKDISC ;

 I $P(^DD(9000010.06,.01,0),U,2)[6 G CHKDISC6

 S APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP)

 Q

CHKDISC6 ;

 Q:'$D(^DIC(6,APCLAP))

 S APCLY=$P(^DIC(6,APCLAP,0),U,4)

 Q:APCLY=""

 Q:'$D(^DIC(7,APCLY,9999999))

 S APCLDISC=$P(^DIC(7,APCLY,9999999),U)

 Q

HD ;ENTRY POINT

 S (DOB,Y)=$P(^DPT(DFN,0),U,3) I DOB]"" D DD^%DT S DOB=Y

 S APCLHRN=$P(^AUPNPAT(DFN,41,APCLSU,0),U,2)

 S SSN=$P(^DPT(DFN,0),U,9)

 W !!,APCLHRN,?8,APCLPN,?40,DOB,?60,SSN

 Q

1 ;Commissioned Officers/Dependents

 D 1^APCLBV11

 Q

2 ;Medicare Part A

 D 2^APCLBV11

 Q

3 ;Medicare Part B

 D 2^APCLBV11

 Q

5 ;Medicaid

 D 5^APCLBV11

 Q

4 ;Private Insurance

 D 4^APCLBV11

 Q

6 ;Non-Indians

 D 6^APCLBV11

 Q

HEAD ;ENTRY POINT

 I 'APCLPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q

HEAD1 ;

 W:$D(IOF) @IOF S APCLPG=APCLPG+1

 W ?(80-$L($P(^DIC(4,APCLSU,0),U))/2),$P(^DIC(4,APCLSU,0),U),?72,"Page ",APCLPG,!

 S APCLLENG=32+$L(APCLNAR(APCLRNUM))

 W ?((80-APCLLENG)/2),"POTENTIALLY BILLABLE VISITS FOR:  ",APCLNAR(APCLRNUM),!

 W ?19,"Visit Dates:  ",APCLSDY," and ",APCLEDY,!

 S APCLLENG=$L(APCLSCP)+28 W ?((80-APCLLENG)/2),"SERVICE CATEGORY OF VISIT:  ",APCLSCP

 ;

 I APCLCLN W ! S APCLLENG=$L($P(^DIC(40.7,APCLCLN,0),U))+0 W ?((80-APCLLENG)/2),"CLINIC:  ",$P(^DIC(40.7,APCLCLN,0),U)

 W !!?2,"HRCN",?8,"Patient Name",?40,"Date of Birth",?60,"   SSN"

 W !,APCL80D

 Q

APCLBV1   ; IHS/CMI/LAB - PRNT BILL VSTS ;

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 +2       ;

 +3       ;cmi/anch/maw 9/10/2007 code set versioning in WPOV

 +4       ;

START     ;

 +1        SET APCL80E="==============================================================================="

 +2        SET APCL80D="-------------------------------------------------------------------------------"

 +3        SET (APCLPG,APCLPN)=0

 +4        IF '$DATA(^XTMP("APCLBV",APCLJOB,APCLBT))

               DO HEAD

               WRITE !,"No visits to report",!

               GOTO DONE

 +5        IF $DATA(APCLPALL)

               GOTO ALL

 +6        SET APCLPN=0

           KILL APCLQUIT

 +7        DO HEAD

           FOR 

               SET APCLPN=$ORDER(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN))

               IF APCLPN=""!($DATA(APCLQUIT))

                   QUIT 

               DO DFN

 +8        IF $Y>(IOSL-4)

               DO HEAD

               IF $DATA(APCLQUIT)

                   GOTO DONE

 +9        IF APCLRNUM=1

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT1

 +10       IF APCLRNUM=2

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT2

 +11       IF APCLRNUM=3

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT3

 +12       IF APCLRNUM=4

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT4

 +13       IF APCLRNUM=5

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT5

 +14       IF APCLRNUM=6

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT6

 +15       WRITE !

 +16       DO DONE

 +17       QUIT 

 +18      ;

ALL       ;print ALL coverage reports

 +1        FOR APCLCNTR=1:1:6

               IF $DATA(APCLQUIT)

                   QUIT 

               SET (APCLPROC,APCLRNUM)=APCLCNTR

               DO ALL1

               IF $DATA(APCLQUIT)

                   QUIT 

               DO PTN

 +2        IF $Y>(IOSL-4)

               DO HEAD

               IF $DATA(APCLQUIT)

                   GOTO DONE

 +3        WRITE !!,"Total Number of Visits:  ",APCLTOTV

 +4        DO DONE

 +5        QUIT 

ALL1      ;

 +1        DO HEAD

           IF $DATA(APCLQUIT)

               QUIT 

 +2        IF '$DATA(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM))

               WRITE !,"No visits to report",!

               SET APCLPN=0

               KILL APCLQUIT

 +3        QUIT 

DONE      ;

 +1        DO DONE^APCLOSUT

 +2        KILL ^XTMP("APCLBV",APCLJOB,APCLBT)

 +3        QUIT 

PTN       ;process patient name level

 +1        FOR 

               SET APCLPN=$ORDER(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN))

               IF APCLPN=""!(APCLPROC'=APCLRNUM)!($DATA(APCLQUIT))

                   QUIT 

               DO DFN

 +2       ;write totals

 +3        IF $Y>(IOSL-4)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT 

 +4        IF APCLRNUM=1

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT1

 +5        IF APCLRNUM=2

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT2

 +6        IF APCLRNUM=3

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT3

 +7        IF APCLRNUM=4

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT4

 +8        IF APCLRNUM=5

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT5

 +9        IF APCLRNUM=6

               WRITE !!,"Total Number of Visits for ",APCLNAR(APCLRNUM),":  ",APCLT6

 +10       WRITE !

 +11       QUIT 

DFN       ;

 +1        SET DFN=""

           FOR 

               SET DFN=$ORDER(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN,DFN))

               IF DFN=""!($DATA(APCLQUIT))

                   QUIT 

               DO @APCLPROC

 +2        QUIT 

VISIT     ;ENTRY POINT

 +1        WRITE !?8,"Visit Date",?21,"Category",?37,"PRV",?41,"ICD DX",?51,"PROVIDER NARRATIVE"

 +2        WRITE !?8

           FOR I=1:1:71

               WRITE "-"

 +3        SET APCLVDFN=0

           FOR 

               SET APCLVDFN=$ORDER(^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN,DFN,APCLVDFN))

               IF APCLVDFN'=+APCLVDFN!($DATA(APCLQUIT))

                   QUIT 

               SET APCLVREC=^AUPNVSIT(APCLVDFN,0)

               DO VWRT

 +4        QUIT 

VWRT      ;

 +1        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT 

 +2        SET Y=$PIECE(+APCLVREC,".")

           DO DD^%DT

           SET APCLDATE=Y

 +3        KILL ^UTILITY("DIQ1",$JOB)

 +4        KILL DIQ,DIC,DA,DR

 +5        SET DIC="^AUPNVSIT("

           SET DR=".07"

           SET DA=APCLVDFN

           SET DIQ(0)="E"

           DO EN^DIQ1

           KILL DIC,DA,DR,DIQ

 +6        SET APCLCAT=^UTILITY("DIQ1",$JOB,9000010,APCLVDFN,.07,"E")

 +7        SET (APCL1,APCL2)=0

           FOR 

               SET APCL2=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCL2))

               IF APCL2=""

                   QUIT 

               IF $PIECE(^AUPNVPRV(APCL2,0),U,4)="P"

                   SET APCL1=APCL1+1

                   SET APCLAP=$PIECE(^(0),U)

 +8        IF APCL1=0

               QUIT 

 +9        SET APCLDISC=""

           DO CHKDISC

 +10       WRITE !?8,APCLDATE,?21,APCLCAT,?37,APCLDISC

 +11       SET (APCL1,APCL2)=0

           FOR 

               SET APCL1=$ORDER(^AUPNVPOV("AD",APCLVDFN,APCL1))

               IF APCL1'=+APCL1!($DATA(APCLQUIT))

                   QUIT 

               SET APCLX=^AUPNVPOV(APCL1,0)

               SET APCL2=APCL2+1

               DO WPOV

 +12       IF $DATA(^AUPNVINP("AD",APCLVDFN))

               SET Y=$ORDER(^AUPNVINP("AD",APCLVDFN,""))

               SET Y=$PIECE(^AUPNVINP(Y,0),U)

               DO DD^%DT

               WRITE !?8,"DISCHARGE DATE:  ",Y

 +13       QUIT 

WPOV      ;

 +1        IF $Y>(IOSL-6)

               IF APCL2>1

                   DO HEAD

                   IF $DATA(APCLQUIT)

                       QUIT 

 +2        IF $PIECE(APCLX,U)=""

               QUIT 

 +3        IF $PIECE(APCLX,U,4)=""

               QUIT 

 +4       ;W:APCL2>1 ! W ?41,$P(^ICD9($P(APCLX,U),0),U),?49,$E($P(^AUTNPOV($P(APCLX,U,4),0),U),1,20)  ;cmi/anch/maw 9/10/2007 orig line

 +5       ;cmi/anch/maw 9/10/2007 code set versioning

           IF APCL2>1

               WRITE !

           WRITE ?41,$PIECE($$ICDDX^ICDEX($PIECE(APCLX,U)),U,2),?51,$EXTRACT($$VAL^XBDIQ1(9000010.07,APCL1,.04),1,20)

 +6        QUIT 

CHKDISC   ;

 +1        IF $PIECE(^DD(9000010.06,.01,0),U,2)[6

               GOTO CHKDISC6

 +2        SET APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP)

 +3        QUIT 

CHKDISC6  ;

 +1        IF '$DATA(^DIC(6,APCLAP))

               QUIT 

 +2        SET APCLY=$PIECE(^DIC(6,APCLAP,0),U,4)

 +3        IF APCLY=""

               QUIT 

 +4        IF '$DATA(^DIC(7,APCLY,9999999))

               QUIT 

 +5        SET APCLDISC=$PIECE(^DIC(7,APCLY,9999999),U)

 +6        QUIT 

HD        ;ENTRY POINT

 +1        SET (DOB,Y)=$PIECE(^DPT(DFN,0),U,3)

           IF DOB]""

               DO DD^%DT

               SET DOB=Y

 +2        SET APCLHRN=$PIECE(^AUPNPAT(DFN,41,APCLSU,0),U,2)

 +3        SET SSN=$PIECE(^DPT(DFN,0),U,9)

 +4        WRITE !!,APCLHRN,?8,APCLPN,?40,DOB,?60,SSN

 +5        QUIT 

1         ;Commissioned Officers/Dependents

 +1        DO 1^APCLBV11

 +2        QUIT 

2         ;Medicare Part A

 +1        DO 2^APCLBV11

 +2        QUIT 

3         ;Medicare Part B

 +1        DO 2^APCLBV11

 +2        QUIT 

5         ;Medicaid

 +1        DO 5^APCLBV11

 +2        QUIT 

4         ;Private Insurance

 +1        DO 4^APCLBV11

 +2        QUIT 

6         ;Non-Indians

 +1        DO 6^APCLBV11

 +2        QUIT 

HEAD      ;ENTRY POINT

 +1        IF 'APCLPG

               GOTO HEAD1

 +2        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET APCLQUIT=""

                       QUIT 

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET APCLPG=APCLPG+1

 +2        WRITE ?(80-$LENGTH($PIECE(^DIC(4,APCLSU,0),U))/2),$PIECE(^DIC(4,APCLSU,0),U),?72,"Page ",APCLPG,!

 +3        SET APCLLENG=32+$LENGTH(APCLNAR(APCLRNUM))

 +4        WRITE ?((80-APCLLENG)/2),"POTENTIALLY BILLABLE VISITS FOR:  ",APCLNAR(APCLRNUM),!

 +5        WRITE ?19,"Visit Dates:  ",APCLSDY," and ",APCLEDY,!

 +6        SET APCLLENG=$LENGTH(APCLSCP)+28

           WRITE ?((80-APCLLENG)/2),"SERVICE CATEGORY OF VISIT:  ",APCLSCP

 +7       ;

 +8        IF APCLCLN

               WRITE !

               SET APCLLENG=$LENGTH($PIECE(^DIC(40.7,APCLCLN,0),U))+0

               WRITE ?((80-APCLLENG)/2),"CLINIC:  ",$PIECE(^DIC(40.7,APCLCLN,0),U)

 +9        WRITE !!?2,"HRCN",?8,"Patient Name",?40,"Date of Birth",?60,"   SSN"

 +10       WRITE !,APCL80D

 +11       QUIT