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
