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
