AZXBV1.m

AZXBV1 ; IHS/OHPRD/TMJ - PRNT BILL VSTS ; [ 02/20/98  12:42 PM ]

 ;;3.0T3;IHS PCC REPORTS;;NOV 22, 1996

START ;

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

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

 S (APCLPG,APCLPN)=0

 G:$D(APCLPALL) ALL

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

 S APCLPN=0 K APCLQUIT

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

 G:APCLPN=""!($D(APCLQUIT)) DONE

 ;G:$D(APCLQUIT) DONE

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

ALL ;print ALL coverage reports

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

 G:$D(APCLQUIT) DONE

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

 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

 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,"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 

PROV ;Get Provider stuff

 W !

 S (APCLP,APCLP1)=0 F  S APCLP=$O(^AUPNVPRV("AD",APCLVDFN,APCLP)) Q:APCLP'=+APCLP!($D(APCLQUIT))  S APCLPPP=^AUPNVPRV(APCLP,0),APCLP1=APCLP1+1 D WPRV

 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,25)

 Q

WPRV ;Write Provider

 ;Q:$P(APCLP,U)=""

 ;Q:$P(APCLP,U,4)=""

 S APCLPS1=$P(^AUPNVPRV(APCLP,0),U)

 S APCLAPP=$S($P($G(^AUTTSITE(1,0)),U,22):$P(^VA(200,APCLPS1,0),U),1:$P(^DIC(16,$P(^DIC(6,APCLPS1,0),"^"),0),"^"))

 S APCLPSP=$P(^AUPNVPRV(APCLP,0),U,4)

 W:APCLP1>1 ! W ?10,APCLPSP,?15,$E(APCLAPP,1,20) I APCLP1>1 W ?41,"**POTENTIAL BILLABLE VISIT***"

 Q

CHKDISC ;

 I '$P($G(^AUTTSITE(1,0)),U,22) 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

AZXBV1    ; IHS/OHPRD/TMJ - PRNT BILL VSTS ; [ 02/20/98  12:42 PM ]

 +1       ;;3.0T3;IHS PCC REPORTS;;NOV 22, 1996

START     ;

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

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

 +3        SET (APCLPG,APCLPN)=0

 +4        IF $DATA(APCLPALL)

               GOTO ALL

 +5        DO HEAD

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

               WRITE !,"No visits to report",!

               GOTO DONE

 +6        SET APCLPN=0

           KILL APCLQUIT

 +7        IF '$DATA(APCLPALL)

               FOR 

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

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

                       QUIT 

                   DO DFN

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

               GOTO DONE

 +9       ;G:$D(APCLQUIT) DONE

 +10       IF $Y>(IOSL-6)

               DO HEAD

               IF $DATA(APCLQUIT)

                   GOTO DONE

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 $DATA(APCLQUIT)

               GOTO DONE

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

 +4        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        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,"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

PROV      ;Get Provider stuff

 +1        WRITE !

 +2        SET (APCLP,APCLP1)=0

           FOR 

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

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

                   QUIT 

               SET APCLPPP=^AUPNVPRV(APCLP,0)

               SET APCLP1=APCLP1+1

               DO WPRV

 +3        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

 +4        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        IF APCL2>1

               WRITE !

           WRITE ?41,$PIECE(^ICD9($PIECE(APCLX,U),0),U),?49,$EXTRACT($PIECE(^AUTNPOV($PIECE(APCLX,U,4),0),U),1,25)

 +5        QUIT 

WPRV      ;Write Provider

 +1       ;Q:$P(APCLP,U)=""

 +2       ;Q:$P(APCLP,U,4)=""

 +3        SET APCLPS1=$PIECE(^AUPNVPRV(APCLP,0),U)

 +4        SET APCLAPP=$SELECT($PIECE($GET(^AUTTSITE(1,0)),U,22):$PIECE(^VA(200,APCLPS1,0),U),1:$PIECE(^DIC(16,$PIECE(^DIC(6,APCLPS1,0),"^"),0),"^"))

 +5        SET APCLPSP=$PIECE(^AUPNVPRV(APCLP,0),U,4)

 +6        IF APCLP1>1

               WRITE !

           WRITE ?10,APCLPSP,?15,$EXTRACT(APCLAPP,1,20)

           IF APCLP1>1

               WRITE ?41,"**POTENTIAL BILLABLE VISIT***"

 +7        QUIT 

CHKDISC   ;

 +1        IF '$PIECE($GET(^AUTTSITE(1,0)),U,22)

               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