AMHRBV1 ; IHS/CMI/LAB - PRNT BILL VSTS ;
;;4.0;IHS BEHAVIORAL HEALTH;**5**;JUN 02, 2010;Build 18
START ;
S AMH80E="==============================================================================="
S AMH80D="-------------------------------------------------------------------------------"
S AMHPG=0 D HEAD I '$D(^XTMP("AMHRBV",AMHJOB,AMHBT)) W !,"No visits to report",! G DONE
S AMHPN=0 K AMHQUIT
F S AMHPN=$O(^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN)) Q:AMHPN=""!($D(AMHQUIT)) D DFN
G:$D(AMHQUIT) DONE
I $Y>(IOSL-6) D HEAD G:$D(AMHQUIT) DONE
DONE ;
D DONE^AMHLEIN,^AMHEKL
K ^XTMP("AMHRBV",AMHJOB,AMHBT)
Q
DFN ;
S DFN="" F S DFN=$O(^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN,DFN)) Q:DFN=""!($D(AMHQUIT)) D @AMHPROC
Q
VISIT ;ENTRY POINT
W !?8," DATE",?16,"VISIT",?24,"PD",?27,"PRV",?31,"ACT",?35,"MIN",?40,"DSM/PC",?47,"BH PROVIDER NARRATIVE",?73,"ICD DX"
W !?7 F I=1:1:72 W "-"
S AMHRDFN=0 F S AMHRDFN=$O(^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN,DFN,AMHRDFN)) Q:AMHRDFN'=+AMHRDFN!($D(AMHQUIT)) S AMHREC=^AMHREC(AMHRDFN,0) D VWRT
Q
VWRT ;
I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
S Y=$P(+AMHREC,".") S AMHDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AMHREC(",DR=".07",DA=AMHRDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S AMHCAT=$E(^UTILITY("DIQ1",$J,9002011,AMHRDFN,.07,"E"),1,7)
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AMHREC(",DR=".06",DA=AMHRDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S AMHACT=$E(^UTILITY("DIQ1",$J,9002011,AMHRDFN,.06,"E"),1,2)
S AMHMIN=$P(AMHREC,U,12)
K ^UTILITY("DIQ1",$J)
S (AMH1,AMH2)=0 F S AMH2=$O(^AMHRPROV("AD",AMHRDFN,AMH2)) Q:AMH2="" I $P(^AMHRPROV(AMH2,0),U,4)="P" S AMH1=AMH1+1,AMHAP=$P(^(0),U)
I AMH1=0 Q
S AMHDISC="",AMHINI="" D CHKDISC
W !?7,AMHDATE,?16,AMHCAT,?24,AMHDISC,?27,AMHINI,?31,AMHACT,?35,AMHMIN
S (AMH1,AMH2)=0 F S AMH1=$O(^AMHRPRO("AD",AMHRDFN,AMH1)) Q:AMH1'=+AMH1!($D(AMHQUIT)) S AMHX=^AMHRPRO(AMH1,0),AMH2=AMH2+1 D WPOV
I $P(AMHREC,U,29) W !,?7,"Evaluation & Management: ",$$VAL^XBDIQ1(9002011,AMHRDFN,.29)
CPTS ;display cpt codes
S (AMH1,AMH2)=0 F S AMH1=$O(^AMHRPROC("AD",AMHRDFN,AMH1)) Q:AMH1'=+AMH1!($D(AMHQUIT)) S AMHX=^AMHRPROC(AMH1,0),AMH2=AMH2+1 D WCPT
Q
WPOV ;
I $Y>(IOSL-6),AMH2>1 D HEAD Q:$D(AMHQUIT)
Q:$P(AMHX,U)=""
;W:AMH2>1 !
W ?40,$P(^AMHPROB($P(AMHX,U),0),U) W ?47,$E($$GET1^DIQ(9002011.01,AMHX,.04),1,25),?73,$P(^AMHPROB($P(AMHX,U),0),U,5)
W !
Q
WCPT ;
I $Y>(IOSL-6),AMH2>1 D HEAD Q:$D(AMHQUIT)
Q:$P(AMHX,U)=""
W:AMH2>1 ! W ?40,$P($$CPT^ICPTCOD($P(AMHX,U),$P($P(^AMHREC(AMHRDFN,0),U),".")),U,2)," ",$E($P($$CPT^ICPTCOD($P(AMHX,U),$P($P(^AMHREC(AMHRDFN,0),U),".")),U,3),1,25)
Q
CHKDISC ;
Q:'$D(^VA(200,AMHAP))
S AMHDISC=$$PPCLSC^AMHUTIL(AMHRDFN)
S AMHINI=$$PPINI^AMHUTIL(AMHRDFN)
Q
1 ;
I $Y>(IOSL-9) D HEAD Q:$D(AMHQUIT)
S AMHCHMP=$O(^AUTNINS("B","CHAMPUS",0))
D HD
Q:'$D(^AUPNPAT(DFN,11))
S X=$P(^AUPNPAT(DFN,11),U,11)
W !?8,AMHCOPN(X)
I ($P(^AUTTBEN(X,0),U,2)="04"!($P(^AUTTBEN(X,0),U,2)="31")),AMHCHMP]"" D PRVT1
D VISIT
Q
PRVT1 ;
Q:AMHCHMP=""
S Y=$O(^AUPNPRVT("AB",AMHCHMP,DFN,0)) Q:Y=""
S AMHX=^AUPNPRVT(DFN,11,Y,0) W ?40,"Sponsor: ",$P(AMHX,U,4),?65,"SSN: " S X=$P(AMHX,U,2) W $E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9)
Q
HD ;ENTRY POINT
S (DOB,Y)=$P(^DPT(DFN,0),U,3) I DOB]"" D DD^%DT S DOB=Y
S AMHHRN=$P(^AUPNPAT(DFN,41,AMHSU,0),U,2)
S ABHN=$P(^DPT(DFN,0),U,9)
W !!,AMHHRN,?8,AMHPN,?40,DOB,?60,ABHN
Q
2 ;
I $Y>(IOSL-9) D HEAD Q:$D(AMHQUIT)
D HD
S AMHMN=$S($D(^AUPNMCR(DFN,21)):$P(^AUPNMCR(DFN,21),U),1:"")
S AMHMDOB=$S($D(^AUPNMCR(DFN,21)):$P(^AUPNMCR(DFN,21),U,2),1:"") I AMHMDOB]"" S Y=AMHMDOB D DD^%DT S AMHMDOB=Y
S AMHMEDN=$P(^AUPNMCR(DFN,0),U,3)_$S($P(^(0),U,4)]"":$P(^AUTTMCS($P(^(0),U,4),0),U),1:"")
W !?8,"Medicare Name: ",AMHMN,?56,"DOB: ",DOB
S AMHMDFN=0 F S AMHMDFN=$O(^AUPNMCR(DFN,11,AMHMDFN)) Q:AMHMDFN'=+AMHMDFN!($D(AMHQUIT)) I $D(^AUPNMCR(DFN,11,AMHMDFN,0)) S AMHREC=^(0) D 22
D VISIT
Q
22 ;
Q:AMHVAL'[$P(^AUPNMCR(DFN,11,AMHMDFN,0),U,3)
Q:$P(^AUPNMCR(DFN,11,AMHMDFN,0),U)>AMHED
I $P(^AUPNMCR(DFN,11,AMHMDFN,0),U,2)]"",$P(^(0),U,2)<AMHSD Q
I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
W !?8,"Coverage:",?19,$P(AMHREC,U,3) S Y=$P(AMHREC,U) D:Y]"" DD^%DT W ?23,"Beg. Date: ",?34,Y S Y=$P(AMHREC,U,2) D:Y]"" DD^%DT W ?49,"End. Date: ",?61,Y,!?8,"Medicare #: ",AMHMEDN,!
Q
5 ;
D 5^AMHRBV11
Q
4 ;
D 4^AMHRBV11
Q
6 ;
D 6^AMHRBV11
Q
HEAD ;ENTRY POINT
I 'AMHPG 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 AMHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S AMHPG=AMHPG+1
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !?(80-$L($P(^DIC(4,AMHSU,0),U))/2),$P(^DIC(4,AMHSU,0),U),?72,"Page ",AMHPG,!
S AMHLENG=64+$L(AMHNAR)
W ?((80-AMHLENG)/2),"POTENTIALLY BILLABLE BEHAVIORAL HEALTH VISITS FOR ",AMHNAR,!
W ?19,"Visit Dates: ",AMHSDY," and ",AMHEDY,!
W !!?2,"HRCN",?8,"Patient Name",?40,"Date of Birth",?60," SSN"
W !,AMH80D
Q
AMHRBV1 ; IHS/CMI/LAB - PRNT BILL VSTS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**5**;JUN 02, 2010;Build 18
START ;
+1 SET AMH80E="==============================================================================="
+2 SET AMH80D="-------------------------------------------------------------------------------"
+3 SET AMHPG=0
DO HEAD
IF '$DATA(^XTMP("AMHRBV",AMHJOB,AMHBT))
WRITE !,"No visits to report",!
GOTO DONE
+4 SET AMHPN=0
KILL AMHQUIT
+5 FOR
SET AMHPN=$ORDER(^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN))
IF AMHPN=""!($DATA(AMHQUIT))
QUIT
DO DFN
+6 IF $DATA(AMHQUIT)
GOTO DONE
+7 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(AMHQUIT)
GOTO DONE
DONE ;
+1 DO DONE^AMHLEIN
DO ^AMHEKL
+2 KILL ^XTMP("AMHRBV",AMHJOB,AMHBT)
+3 QUIT
DFN ;
+1 SET DFN=""
FOR
SET DFN=$ORDER(^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN,DFN))
IF DFN=""!($DATA(AMHQUIT))
QUIT
DO @AMHPROC
+2 QUIT
VISIT ;ENTRY POINT
+1 WRITE !?8," DATE",?16,"VISIT",?24,"PD",?27,"PRV",?31,"ACT",?35,"MIN",?40,"DSM/PC",?47,"BH PROVIDER NARRATIVE",?73,"ICD DX"
+2 WRITE !?7
FOR I=1:1:72
WRITE "-"
+3 SET AMHRDFN=0
FOR
SET AMHRDFN=$ORDER(^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN,DFN,AMHRDFN))
IF AMHRDFN'=+AMHRDFN!($DATA(AMHQUIT))
QUIT
SET AMHREC=^AMHREC(AMHRDFN,0)
DO VWRT
+4 QUIT
VWRT ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+2 SET Y=$PIECE(+AMHREC,".")
SET AMHDATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
+3 KILL ^UTILITY("DIQ1",$JOB)
+4 KILL DIQ,DIC,DA,DR
+5 SET DIC="^AMHREC("
SET DR=".07"
SET DA=AMHRDFN
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+6 SET AMHCAT=$EXTRACT(^UTILITY("DIQ1",$JOB,9002011,AMHRDFN,.07,"E"),1,7)
+7 KILL ^UTILITY("DIQ1",$JOB)
+8 KILL DIQ,DIC,DA,DR
+9 SET DIC="^AMHREC("
SET DR=".06"
SET DA=AMHRDFN
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+10 SET AMHACT=$EXTRACT(^UTILITY("DIQ1",$JOB,9002011,AMHRDFN,.06,"E"),1,2)
+11 SET AMHMIN=$PIECE(AMHREC,U,12)
+12 KILL ^UTILITY("DIQ1",$JOB)
+13 SET (AMH1,AMH2)=0
FOR
SET AMH2=$ORDER(^AMHRPROV("AD",AMHRDFN,AMH2))
IF AMH2=""
QUIT
IF $PIECE(^AMHRPROV(AMH2,0),U,4)="P"
SET AMH1=AMH1+1
SET AMHAP=$PIECE(^(0),U)
+14 IF AMH1=0
QUIT
+15 SET AMHDISC=""
SET AMHINI=""
DO CHKDISC
+16 WRITE !?7,AMHDATE,?16,AMHCAT,?24,AMHDISC,?27,AMHINI,?31,AMHACT,?35,AMHMIN
+17 SET (AMH1,AMH2)=0
FOR
SET AMH1=$ORDER(^AMHRPRO("AD",AMHRDFN,AMH1))
IF AMH1'=+AMH1!($DATA(AMHQUIT))
QUIT
SET AMHX=^AMHRPRO(AMH1,0)
SET AMH2=AMH2+1
DO WPOV
+18 IF $PIECE(AMHREC,U,29)
WRITE !,?7,"Evaluation & Management: ",$$VAL^XBDIQ1(9002011,AMHRDFN,.29)
CPTS ;display cpt codes
+1 SET (AMH1,AMH2)=0
FOR
SET AMH1=$ORDER(^AMHRPROC("AD",AMHRDFN,AMH1))
IF AMH1'=+AMH1!($DATA(AMHQUIT))
QUIT
SET AMHX=^AMHRPROC(AMH1,0)
SET AMH2=AMH2+1
DO WCPT
+2 QUIT
WPOV ;
+1 IF $Y>(IOSL-6)
IF AMH2>1
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+2 IF $PIECE(AMHX,U)=""
QUIT
+3 ;W:AMH2>1 !
+4 WRITE ?40,$PIECE(^AMHPROB($PIECE(AMHX,U),0),U)
WRITE ?47,$EXTRACT($$GET1^DIQ(9002011.01,AMHX,.04),1,25),?73,$PIECE(^AMHPROB($PIECE(AMHX,U),0),U,5)
+5 WRITE !
+6 QUIT
WCPT ;
+1 IF $Y>(IOSL-6)
IF AMH2>1
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+2 IF $PIECE(AMHX,U)=""
QUIT
+3 IF AMH2>1
WRITE !
WRITE ?40,$PIECE($$CPT^ICPTCOD($PIECE(AMHX,U),$PIECE($PIECE(^AMHREC(AMHRDFN,0),U),".")),U,2)," ",$EXTRACT($PIECE($$CPT^ICPTCOD($PIECE(AMHX,U),$PIECE($PIECE(^AMHREC(AMHRDFN,0),U),".")),U,3),1,25)
+4 QUIT
CHKDISC ;
+1 IF '$DATA(^VA(200,AMHAP))
QUIT
+2 SET AMHDISC=$$PPCLSC^AMHUTIL(AMHRDFN)
+3 SET AMHINI=$$PPINI^AMHUTIL(AMHRDFN)
+4 QUIT
1 ;
+1 IF $Y>(IOSL-9)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+2 SET AMHCHMP=$ORDER(^AUTNINS("B","CHAMPUS",0))
+3 DO HD
+4 IF '$DATA(^AUPNPAT(DFN,11))
QUIT
+5 SET X=$PIECE(^AUPNPAT(DFN,11),U,11)
+6 WRITE !?8,AMHCOPN(X)
+7 IF ($PIECE(^AUTTBEN(X,0),U,2)="04"!($PIECE(^AUTTBEN(X,0),U,2)="31"))
IF AMHCHMP]""
DO PRVT1
+8 DO VISIT
+9 QUIT
PRVT1 ;
+1 IF AMHCHMP=""
QUIT
+2 SET Y=$ORDER(^AUPNPRVT("AB",AMHCHMP,DFN,0))
IF Y=""
QUIT
+3 SET AMHX=^AUPNPRVT(DFN,11,Y,0)
WRITE ?40,"Sponsor: ",$PIECE(AMHX,U,4),?65,"SSN: "
SET X=$PIECE(AMHX,U,2)
WRITE $EXTRACT(X,1,3),"-",$EXTRACT(X,4,5),"-",$EXTRACT(X,6,9)
+4 QUIT
HD ;ENTRY POINT
+1 SET (DOB,Y)=$PIECE(^DPT(DFN,0),U,3)
IF DOB]""
DO DD^%DT
SET DOB=Y
+2 SET AMHHRN=$PIECE(^AUPNPAT(DFN,41,AMHSU,0),U,2)
+3 SET ABHN=$PIECE(^DPT(DFN,0),U,9)
+4 WRITE !!,AMHHRN,?8,AMHPN,?40,DOB,?60,ABHN
+5 QUIT
2 ;
+1 IF $Y>(IOSL-9)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+2 DO HD
+3 SET AMHMN=$SELECT($DATA(^AUPNMCR(DFN,21)):$PIECE(^AUPNMCR(DFN,21),U),1:"")
+4 SET AMHMDOB=$SELECT($DATA(^AUPNMCR(DFN,21)):$PIECE(^AUPNMCR(DFN,21),U,2),1:"")
IF AMHMDOB]""
SET Y=AMHMDOB
DO DD^%DT
SET AMHMDOB=Y
+5 SET AMHMEDN=$PIECE(^AUPNMCR(DFN,0),U,3)_$SELECT($PIECE(^(0),U,4)]"":$PIECE(^AUTTMCS($PIECE(^(0),U,4),0),U),1:"")
+6 WRITE !?8,"Medicare Name: ",AMHMN,?56,"DOB: ",DOB
+7 SET AMHMDFN=0
FOR
SET AMHMDFN=$ORDER(^AUPNMCR(DFN,11,AMHMDFN))
IF AMHMDFN'=+AMHMDFN!($DATA(AMHQUIT))
QUIT
IF $DATA(^AUPNMCR(DFN,11,AMHMDFN,0))
SET AMHREC=^(0)
DO 22
+8 DO VISIT
+9 QUIT
22 ;
+1 IF AMHVAL'[$PIECE(^AUPNMCR(DFN,11,AMHMDFN,0),U,3)
QUIT
+2 IF $PIECE(^AUPNMCR(DFN,11,AMHMDFN,0),U)>AMHED
QUIT
+3 IF $PIECE(^AUPNMCR(DFN,11,AMHMDFN,0),U,2)]""
IF $PIECE(^(0),U,2)<AMHSD
QUIT
+4 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+5 WRITE !?8,"Coverage:",?19,$PIECE(AMHREC,U,3)
SET Y=$PIECE(AMHREC,U)
IF Y]""
DO DD^%DT
WRITE ?23,"Beg. Date: ",?34,Y
SET Y=$PIECE(AMHREC,U,2)
IF Y]""
DO DD^%DT
WRITE ?49,"End. Date: ",?61,Y,!?8,"Medicare #: ",AMHMEDN,!
+6 QUIT
5 ;
+1 DO 5^AMHRBV11
+2 QUIT
4 ;
+1 DO 4^AMHRBV11
+2 QUIT
6 ;
+1 DO 6^AMHRBV11
+2 QUIT
HEAD ;ENTRY POINT
+1 IF 'AMHPG
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 AMHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHPG=AMHPG+1
+2 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+3 WRITE !?(80-$LENGTH($PIECE(^DIC(4,AMHSU,0),U))/2),$PIECE(^DIC(4,AMHSU,0),U),?72,"Page ",AMHPG,!
+4 SET AMHLENG=64+$LENGTH(AMHNAR)
+5 WRITE ?((80-AMHLENG)/2),"POTENTIALLY BILLABLE BEHAVIORAL HEALTH VISITS FOR ",AMHNAR,!
+6 WRITE ?19,"Visit Dates: ",AMHSDY," and ",AMHEDY,!
+7 WRITE !!?2,"HRCN",?8,"Patient Name",?40,"Date of Birth",?60," SSN"
+8 WRITE !,AMH80D
+9 QUIT
