APCLBV2 ; IHS/CMI/LAB - gather billable visits ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;SEARCH VISIT FILE FOR DATE RANGE AND GENERATE CLINIC COUNTS
;
S APCLJOB=$J,APCLBT=$H
K ^XTMP("APCLBV",APCLJOB,APCLBT)
D XTMP^APCLOSUT("APCLBV","PCC - POTENTIALLY BILLABLE VISITS")
S (APCLS,APCLSAVE)=APCLSD-.000001
;Set total visit counters
S (APCLT1,APCLT2,APCLT3,APCLT4,APCLT5,APCLT6,APCLTOTV)=0
D:$D(APCLPALL) ALL
I '$D(APCLPALL) D @APCLPROC
S APCLET=$H
Q
ALL ;process ALL coverage reports
S (APCLPROC,APCLRNUM)=1 D 1
S (APCLPROC,APCLRNUM)=2 D 2
S (APCLPROC,APCLRNUM)=3 D 3
S (APCLPROC,APCLRNUM)=4 D 4
S (APCLPROC,APCLRNUM)=5 D 5
S (APCLPROC,APCLRNUM)=6 D 6
Q
1 F X="03","04","30","31" S Y=$O(^AUTTBEN("C",X,"")) S APCLCOAR(Y)="" S APCLCOPN(Y)=$P(^AUTTBEN(Y,0),U)
D V
;
Q
V ;
S APCLS=APCLSAVE
F I=0:0 S APCLS=$O(^AUPNVSIT("B",APCLS)) Q:APCLS=""!($P(APCLS,".")>APCLED) D V1
Q
V1 ;
S APCLVDFN="" F J=0:0 S APCLVDFN=$O(^AUPNVSIT("B",APCLS,APCLVDFN)) Q:APCLVDFN="" S APCLVN0=^AUPNVSIT(APCLVDFN,0) D @(APCLPROC_"2")
Q
12 S DFN=$P(APCLVN0,U,5) Q:DFN="" Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
Q:$P(APCLVN0,U,11)
Q:'$D(^AUPNPAT(DFN,41,APCLSU,0))
Q:'$D(^AUPNPAT(DFN,11))
S APCLCOP=$P(^AUPNPAT(DFN,11),U,11) Q:APCLCOP=""
Q:'$D(APCLCOAR(APCLCOP))
VC ;
Q:$$DEMO^APCLUTL($P(APCLVN0,U,5),$G(APCLDEMO))
Q:APCLSC'[$P(APCLVN0,U,7)
Q:'$P(APCLVN0,U,9)
I APCLCLN,$P(APCLVN0,U,8)'=APCLCLN Q
Q:'$D(^AUPNVPOV("AD",APCLVDFN))
Q:'$D(^AUPNVPRV("AD",APCLVDFN))
Q:$P(APCLVN0,U,6)'=APCLSU
S APCLPN=$P(^DPT(DFN,0),U)
S ^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN,DFN,APCLVDFN)=""
I APCLRNUM=1 S APCLT1=APCLT1+1
I APCLRNUM=2 S APCLT2=APCLT2+1
I APCLRNUM=3 S APCLT3=APCLT3+1
I APCLRNUM=4 S APCLT4=APCLT4+1
I APCLRNUM=5 S APCLT5=APCLT5+1
I APCLRNUM=6 S APCLT6=APCLT6+1
S APCLTOTV=APCLTOTV+1
Q
2 ;
S APCLVAL=$S(APCLPROC=2:"A",1:"B")
S APCLPROC=2
D V
Q
22 ;
Q:$P(APCLVN0,U,11)
S DFN=$P(APCLVN0,U,5) Q:DFN=""
Q:'$D(^DPT(DFN,0))
Q:'$D(^AUPNMCR(DFN,11))
Q:'$D(^AUPNPAT(DFN,41,APCLSU,0))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(APCLS,".") Q
K APCLGOT S APCLMDFN=0 F S APCLMDFN=$O(^AUPNMCR(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLGOT)) D 23
Q:'$D(APCLGOT)
S APCLPN=$P(^DPT(DFN,0),U)
D VC
Q
;
23 ;
Q:APCLVAL'[$P(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
Q:$P(^AUPNMCR(DFN,11,APCLMDFN,0),U)>$P(APCLS,".")
I $P(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]"",$P(^(0),U,2)<$P(APCLS,".") Q
S APCLGOT=""
Q
;
3 ;
D 2
Q
;
5 ;
D V
Q
52 ;
Q:$P(APCLVN0,U,11)
S DFN=$P(^AUPNVSIT(APCLVDFN,0),U,5) Q:DFN=""
Q:'$D(^AUPNPRVT(DFN,11))
Q:'$D(^AUPNPAT(DFN,41,APCLSU))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(APCLS,".") Q
S APCLPN=$P(^DPT(DFN,0),U)
K APCLGOT S APCLMDFN=0 F S APCLMDFN=$O(^AUPNPRVT(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN D 53
Q:'$D(APCLGOT)
D VC
Q
53 ;
Q:$P(^AUPNPRVT(DFN,11,APCLMDFN,0),U)=""
S APCLNAME=$P(^AUPNPRVT(DFN,11,APCLMDFN,0),U) Q:APCLNAME=""
S APCLNAME=$P(^AUTNINS(APCLNAME,0),U) I APCLNAME["AHCCCS" Q
Q:$P(^AUPNPRVT(DFN,11,APCLMDFN,0),U,6)=""
Q:$P(^AUPNPRVT(DFN,11,APCLMDFN,0),U,6)>$P(APCLS,".")
I $P(^AUPNPRVT(DFN,11,APCLMDFN,0),U,7)]"",$P(^(0),U,7)<$P(APCLS,".") Q
S APCLGOT=""
Q
;
4 ;
D V
Q
42 ;
Q:$P(APCLVN0,U,11)
S DFN=$P(^AUPNVSIT(APCLVDFN,0),U,5) Q:DFN=""
Q:'$D(^AUPNPAT(DFN,41,APCLSU))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(APCLS,".") Q
S APCLPN=$P(^DPT(DFN,0),U)
K APCLGOT S APCLMDFN=0 S APCLMDFN=$O(^AUPNMCD("B",DFN,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLGOT)) D 43
Q:'$D(APCLGOT)
D VC
Q
43 ;
Q:'$D(^AUPNMCD(APCLMDFN,11))
K APCLGOT S APCLNDFN=0 F S APCLNDFN=$O(^AUPNMCD(APCLMDFN,11,APCLNDFN)) Q:APCLNDFN'=+APCLNDFN!($D(APCLGOT)) S APCLREC=^AUPNMCD(APCLMDFN,11,APCLNDFN,0) D 44
Q
44 ;
Q:APCLNDFN>$P(APCLS,".")
I $P(APCLREC,U,2)]"",$P(APCLREC,U,2)<$P(APCLS,".") Q
S APCLGOT=""
Q
;
6 ;NON INDIANS
D V
Q
62 ;
Q:$P(APCLVN0,U,11)
S DFN=$P(^AUPNVSIT(APCLVDFN,0),U,5) Q:DFN=""
Q:'$D(^AUPNPAT(DFN,41,APCLSU))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(APCLS,".") Q
Q:'$D(^AUPNPAT(DFN,11))
Q:$P(^AUPNPAT(DFN,11),U,11)=01
Q:$P(^AUPNPAT(DFN,11),U,8)=""
S APCLTRI=$P(^AUPNPAT(DFN,11),U,8)
Q:'$D(^AUTTTRI(APCLTRI))
S APCLTRIC=$P(^AUTTTRI(APCLTRI,0),U,2)
Q:(+APCLTRIC&(APCLTRIC<969))
D VC
Q
APCLBV2 ; IHS/CMI/LAB - gather billable visits ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;SEARCH VISIT FILE FOR DATE RANGE AND GENERATE CLINIC COUNTS
+3 ;
+4 SET APCLJOB=$JOB
SET APCLBT=$HOROLOG
+5 KILL ^XTMP("APCLBV",APCLJOB,APCLBT)
+6 DO XTMP^APCLOSUT("APCLBV","PCC - POTENTIALLY BILLABLE VISITS")
+7 SET (APCLS,APCLSAVE)=APCLSD-.000001
+8 ;Set total visit counters
+9 SET (APCLT1,APCLT2,APCLT3,APCLT4,APCLT5,APCLT6,APCLTOTV)=0
+10 IF $DATA(APCLPALL)
DO ALL
+11 IF '$DATA(APCLPALL)
DO @APCLPROC
+12 SET APCLET=$HOROLOG
+13 QUIT
ALL ;process ALL coverage reports
+1 SET (APCLPROC,APCLRNUM)=1
DO 1
+2 SET (APCLPROC,APCLRNUM)=2
DO 2
+3 SET (APCLPROC,APCLRNUM)=3
DO 3
+4 SET (APCLPROC,APCLRNUM)=4
DO 4
+5 SET (APCLPROC,APCLRNUM)=5
DO 5
+6 SET (APCLPROC,APCLRNUM)=6
DO 6
+7 QUIT
1 FOR X="03","04","30","31"
SET Y=$ORDER(^AUTTBEN("C",X,""))
SET APCLCOAR(Y)=""
SET APCLCOPN(Y)=$PIECE(^AUTTBEN(Y,0),U)
+1 DO V
+2 ;
+3 QUIT
V ;
+1 SET APCLS=APCLSAVE
+2 FOR I=0:0
SET APCLS=$ORDER(^AUPNVSIT("B",APCLS))
IF APCLS=""!($PIECE(APCLS,".")>APCLED)
QUIT
DO V1
+3 QUIT
V1 ;
+1 SET APCLVDFN=""
FOR J=0:0
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLS,APCLVDFN))
IF APCLVDFN=""
QUIT
SET APCLVN0=^AUPNVSIT(APCLVDFN,0)
DO @(APCLPROC_"2")
+2 QUIT
12 SET DFN=$PIECE(APCLVN0,U,5)
IF DFN=""
QUIT
IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+1 IF $PIECE(APCLVN0,U,11)
QUIT
+2 IF '$DATA(^AUPNPAT(DFN,41,APCLSU,0))
QUIT
+3 IF '$DATA(^AUPNPAT(DFN,11))
QUIT
+4 SET APCLCOP=$PIECE(^AUPNPAT(DFN,11),U,11)
IF APCLCOP=""
QUIT
+5 IF '$DATA(APCLCOAR(APCLCOP))
QUIT
VC ;
+1 IF $$DEMO^APCLUTL($PIECE(APCLVN0,U,5),$GET(APCLDEMO))
QUIT
+2 IF APCLSC'[$PIECE(APCLVN0,U,7)
QUIT
+3 IF '$PIECE(APCLVN0,U,9)
QUIT
+4 IF APCLCLN
IF $PIECE(APCLVN0,U,8)'=APCLCLN
QUIT
+5 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
QUIT
+6 IF '$DATA(^AUPNVPRV("AD",APCLVDFN))
QUIT
+7 IF $PIECE(APCLVN0,U,6)'=APCLSU
QUIT
+8 SET APCLPN=$PIECE(^DPT(DFN,0),U)
+9 SET ^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN,DFN,APCLVDFN)=""
+10 IF APCLRNUM=1
SET APCLT1=APCLT1+1
+11 IF APCLRNUM=2
SET APCLT2=APCLT2+1
+12 IF APCLRNUM=3
SET APCLT3=APCLT3+1
+13 IF APCLRNUM=4
SET APCLT4=APCLT4+1
+14 IF APCLRNUM=5
SET APCLT5=APCLT5+1
+15 IF APCLRNUM=6
SET APCLT6=APCLT6+1
+16 SET APCLTOTV=APCLTOTV+1
+17 QUIT
2 ;
+1 SET APCLVAL=$SELECT(APCLPROC=2:"A",1:"B")
+2 SET APCLPROC=2
+3 DO V
+4 QUIT
22 ;
+1 IF $PIECE(APCLVN0,U,11)
QUIT
+2 SET DFN=$PIECE(APCLVN0,U,5)
IF DFN=""
QUIT
+3 IF '$DATA(^DPT(DFN,0))
QUIT
+4 IF '$DATA(^AUPNMCR(DFN,11))
QUIT
+5 IF '$DATA(^AUPNPAT(DFN,41,APCLSU,0))
QUIT
+6 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<$PIECE(APCLS,".")
QUIT
+7 KILL APCLGOT
SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^AUPNMCR(DFN,11,APCLMDFN))
IF APCLMDFN'=+APCLMDFN!($DATA(APCLGOT))
QUIT
DO 23
+8 IF '$DATA(APCLGOT)
QUIT
+9 SET APCLPN=$PIECE(^DPT(DFN,0),U)
+10 DO VC
+11 QUIT
+12 ;
23 ;
+1 IF APCLVAL'[$PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
QUIT
+2 IF $PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U)>$PIECE(APCLS,".")
QUIT
+3 IF $PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]""
IF $PIECE(^(0),U,2)<$PIECE(APCLS,".")
QUIT
+4 SET APCLGOT=""
+5 QUIT
+6 ;
3 ;
+1 DO 2
+2 QUIT
+3 ;
5 ;
+1 DO V
+2 QUIT
52 ;
+1 IF $PIECE(APCLVN0,U,11)
QUIT
+2 SET DFN=$PIECE(^AUPNVSIT(APCLVDFN,0),U,5)
IF DFN=""
QUIT
+3 IF '$DATA(^AUPNPRVT(DFN,11))
QUIT
+4 IF '$DATA(^AUPNPAT(DFN,41,APCLSU))
QUIT
+5 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<$PIECE(APCLS,".")
QUIT
+6 SET APCLPN=$PIECE(^DPT(DFN,0),U)
+7 KILL APCLGOT
SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^AUPNPRVT(DFN,11,APCLMDFN))
IF APCLMDFN'=+APCLMDFN
QUIT
DO 53
+8 IF '$DATA(APCLGOT)
QUIT
+9 DO VC
+10 QUIT
53 ;
+1 IF $PIECE(^AUPNPRVT(DFN,11,APCLMDFN,0),U)=""
QUIT
+2 SET APCLNAME=$PIECE(^AUPNPRVT(DFN,11,APCLMDFN,0),U)
IF APCLNAME=""
QUIT
+3 SET APCLNAME=$PIECE(^AUTNINS(APCLNAME,0),U)
IF APCLNAME["AHCCCS"
QUIT
+4 IF $PIECE(^AUPNPRVT(DFN,11,APCLMDFN,0),U,6)=""
QUIT
+5 IF $PIECE(^AUPNPRVT(DFN,11,APCLMDFN,0),U,6)>$PIECE(APCLS,".")
QUIT
+6 IF $PIECE(^AUPNPRVT(DFN,11,APCLMDFN,0),U,7)]""
IF $PIECE(^(0),U,7)<$PIECE(APCLS,".")
QUIT
+7 SET APCLGOT=""
+8 QUIT
+9 ;
4 ;
+1 DO V
+2 QUIT
42 ;
+1 IF $PIECE(APCLVN0,U,11)
QUIT
+2 SET DFN=$PIECE(^AUPNVSIT(APCLVDFN,0),U,5)
IF DFN=""
QUIT
+3 IF '$DATA(^AUPNPAT(DFN,41,APCLSU))
QUIT
+4 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<$PIECE(APCLS,".")
QUIT
+5 SET APCLPN=$PIECE(^DPT(DFN,0),U)
+6 KILL APCLGOT
SET APCLMDFN=0
SET APCLMDFN=$ORDER(^AUPNMCD("B",DFN,APCLMDFN))
IF APCLMDFN'=+APCLMDFN!($DATA(APCLGOT))
QUIT
DO 43
+7 IF '$DATA(APCLGOT)
QUIT
+8 DO VC
+9 QUIT
43 ;
+1 IF '$DATA(^AUPNMCD(APCLMDFN,11))
QUIT
+2 KILL APCLGOT
SET APCLNDFN=0
FOR
SET APCLNDFN=$ORDER(^AUPNMCD(APCLMDFN,11,APCLNDFN))
IF APCLNDFN'=+APCLNDFN!($DATA(APCLGOT))
QUIT
SET APCLREC=^AUPNMCD(APCLMDFN,11,APCLNDFN,0)
DO 44
+3 QUIT
44 ;
+1 IF APCLNDFN>$PIECE(APCLS,".")
QUIT
+2 IF $PIECE(APCLREC,U,2)]""
IF $PIECE(APCLREC,U,2)<$PIECE(APCLS,".")
QUIT
+3 SET APCLGOT=""
+4 QUIT
+5 ;
6 ;NON INDIANS
+1 DO V
+2 QUIT
62 ;
+1 IF $PIECE(APCLVN0,U,11)
QUIT
+2 SET DFN=$PIECE(^AUPNVSIT(APCLVDFN,0),U,5)
IF DFN=""
QUIT
+3 IF '$DATA(^AUPNPAT(DFN,41,APCLSU))
QUIT
+4 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<$PIECE(APCLS,".")
QUIT
+5 IF '$DATA(^AUPNPAT(DFN,11))
QUIT
+6 IF $PIECE(^AUPNPAT(DFN,11),U,11)=01
QUIT
+7 IF $PIECE(^AUPNPAT(DFN,11),U,8)=""
QUIT
+8 SET APCLTRI=$PIECE(^AUPNPAT(DFN,11),U,8)
+9 IF '$DATA(^AUTTTRI(APCLTRI))
QUIT
+10 SET APCLTRIC=$PIECE(^AUTTTRI(APCLTRI,0),U,2)
+11 IF (+APCLTRIC&(APCLTRIC<969))
QUIT
+12 DO VC
+13 QUIT
