AMHRBV2 ; IHS/CMI/LAB - gather billable visits 03 Jun 2009 1:01 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;CMI/TUCSON/LAB - 09/22/97 - modified activity data to not bomb if null
;SEARCH VISIT FILE FOR DATE RANGE AND GENERATE CLINIC COUNTS
;
S AMHJOB=$J,AMHBT=$H
K ^XTMP("AMHRBV",AMHJOB,AMHBT)
D XTMP^AMHUTIL("AMHRBV","BH - BILLABLE VISITS")
S AMHS=AMHSD-.000001
D @AMHPROC
S AMHET=$H
Q
1 F X="03","04","30","31" S Y=$O(^AUTTBEN("C",X,"")) S AMHCOAR(Y)="" S AMHCOPN(Y)=$P(^AUTTBEN(Y,0),U)
D V
;
Q
V ;
F I=0:0 S AMHS=$O(^AMHREC("B",AMHS)) Q:AMHS=""!($P(AMHS,".")>AMHED) D V1
Q
V1 ;
S AMHVDFN="" F J=0:0 S AMHVDFN=$O(^AMHREC("B",AMHS,AMHVDFN)) Q:AMHVDFN="" I $$ALLOWVI^AMHUTIL(DUZ,AMHVDFN) S AMHVN0=^AMHREC(AMHVDFN,0) S DFN=$P(AMHVN0,U,8) I DFN]"" D @(AMHPROC_"2")
Q
12 ;
Q:'$D(^AUPNPAT(DFN,41,AMHSU,0))
Q:'$D(^AUPNPAT(DFN,11))
S AMHCOP=$P(^AUPNPAT(DFN,11),U,11) Q:AMHCOP=""
Q:'$D(AMHCOAR(AMHCOP))
VC ;
S AMHACT=$P(AMHVN0,U,6) Q:'AMHACT Q:'$P(^AMHTACT(AMHACT,0),U,6) ;do not use non patient activities CMI/TUCSON/LAB - added Q:'AMHACT to not bomb if activity null
S AMHVISIT=$P(AMHVN0,U,16)
Q:'$D(^AMHRPROV("AD",AMHVDFN))
Q:'$D(^AMHRPRO("AD",AMHVDFN))
Q:$P(AMHVN0,U,4)'=AMHSU
S AMHPN=$P(^DPT(DFN,0),U)
S ^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN,DFN,AMHVDFN)=""
Q
2 ;
S AMHVAL=$S(AMHPROC=2:"A",1:"B")
S AMHPROC=2
D V
Q
22 ;
Q:'$D(^DPT(DFN,0))
Q:'$D(^AUPNMCR(DFN,11))
Q:'$D(^AUPNPAT(DFN,41,AMHSU,0))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(AMHS,".") Q
K AMHGOT S AMHMDFN=0 F S AMHMDFN=$O(^AUPNMCR(DFN,11,AMHMDFN)) Q:AMHMDFN'=+AMHMDFN!($D(AMHGOT)) D 23
Q:'$D(AMHGOT)
S AMHPN=$P(^DPT(DFN,0),U)
D VC
Q
;
23 ;
Q:AMHVAL'[$P(^AUPNMCR(DFN,11,AMHMDFN,0),U,3)
Q:$P(^AUPNMCR(DFN,11,AMHMDFN,0),U)>$P(AMHS,".")
I $P(^AUPNMCR(DFN,11,AMHMDFN,0),U,2)]"",$P(^(0),U,2)<$P(AMHS,".") Q
S AMHGOT=""
Q
;
3 ;
D 2
Q
;
5 ;
D V
Q
52 ;
Q:'$D(^AUPNPRVT(DFN,11))
Q:'$D(^AUPNPAT(DFN,41,AMHSU))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(AMHS,".") Q
S AMHPN=$P(^DPT(DFN,0),U)
K AMHGOT S AMHMDFN=0 F S AMHMDFN=$O(^AUPNPRVT(DFN,11,AMHMDFN)) Q:AMHMDFN'=+AMHMDFN D 53
Q:'$D(AMHGOT)
D VC
Q
53 ;
Q:$P(^AUPNPRVT(DFN,11,AMHMDFN,0),U)=""
S AMHNAME=$P(^AUPNPRVT(DFN,11,AMHMDFN,0),U) Q:AMHNAME=""
S AMHNAME=$P(^AUTNINS(AMHNAME,0),U) I AMHNAME["AHCCCS" Q
Q:$P(^AUPNPRVT(DFN,11,AMHMDFN,0),U,6)=""
Q:$P(^AUPNPRVT(DFN,11,AMHMDFN,0),U,6)>$P(AMHS,".")
I $P(^AUPNPRVT(DFN,11,AMHMDFN,0),U,7)]"",$P(^(0),U,7)<$P(AMHS,".") Q
S AMHGOT=""
Q
;
4 ;
D V
Q
42 ;
Q:'$D(^AUPNPAT(DFN,41,AMHSU))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(AMHS,".") Q
S AMHPN=$P(^DPT(DFN,0),U)
K AMHGOT S AMHMDFN=0 S AMHMDFN=$O(^AUPNMCD("B",DFN,AMHMDFN)) Q:AMHMDFN'=+AMHMDFN!($D(AMHGOT)) D 43
Q:'$D(AMHGOT)
D VC
Q
43 ;
Q:'$D(^AUPNMCD(AMHMDFN,11))
K AMHGOT S AMHNDFN=0 F S AMHNDFN=$O(^AUPNMCD(AMHMDFN,11,AMHNDFN)) Q:AMHNDFN'=+AMHNDFN!($D(AMHGOT)) S AMHREC=^AUPNMCD(AMHMDFN,11,AMHNDFN,0) D 44
Q
44 ;
Q:AMHNDFN>$P(AMHS,".")
I $P(AMHREC,U,2)]"",$P(AMHREC,U,2)<$P(AMHS,".") Q
S AMHGOT=""
Q
;
6 ;NON INDIANS
D V
Q
62 ;
Q:'$D(^AUPNPAT(DFN,41,AMHSU))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(AMHS,".") Q
Q:'$D(^AUPNPAT(DFN,11))
Q:$P(^AUPNPAT(DFN,11),U,8)=""
S AMHTRI=$P(^AUPNPAT(DFN,11),U,8)
Q:'$D(^AUTTTRI(AMHTRI))
S AMHTRIC=$P(^AUTTTRI(AMHTRI,0),U,2)
Q:(+AMHTRIC&(AMHTRIC<969))
D VC
Q
AMHRBV2 ; IHS/CMI/LAB - gather billable visits 03 Jun 2009 1:01 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;CMI/TUCSON/LAB - 09/22/97 - modified activity data to not bomb if null
+4 ;SEARCH VISIT FILE FOR DATE RANGE AND GENERATE CLINIC COUNTS
+5 ;
+6 SET AMHJOB=$JOB
SET AMHBT=$HOROLOG
+7 KILL ^XTMP("AMHRBV",AMHJOB,AMHBT)
+8 DO XTMP^AMHUTIL("AMHRBV","BH - BILLABLE VISITS")
+9 SET AMHS=AMHSD-.000001
+10 DO @AMHPROC
+11 SET AMHET=$HOROLOG
+12 QUIT
1 FOR X="03","04","30","31"
SET Y=$ORDER(^AUTTBEN("C",X,""))
SET AMHCOAR(Y)=""
SET AMHCOPN(Y)=$PIECE(^AUTTBEN(Y,0),U)
+1 DO V
+2 ;
+3 QUIT
V ;
+1 FOR I=0:0
SET AMHS=$ORDER(^AMHREC("B",AMHS))
IF AMHS=""!($PIECE(AMHS,".")>AMHED)
QUIT
DO V1
+2 QUIT
V1 ;
+1 SET AMHVDFN=""
FOR J=0:0
SET AMHVDFN=$ORDER(^AMHREC("B",AMHS,AMHVDFN))
IF AMHVDFN=""
QUIT
IF $$ALLOWVI^AMHUTIL(DUZ,AMHVDFN)
SET AMHVN0=^AMHREC(AMHVDFN,0)
SET DFN=$PIECE(AMHVN0,U,8)
IF DFN]""
DO @(AMHPROC_"2")
+2 QUIT
12 ;
+1 IF '$DATA(^AUPNPAT(DFN,41,AMHSU,0))
QUIT
+2 IF '$DATA(^AUPNPAT(DFN,11))
QUIT
+3 SET AMHCOP=$PIECE(^AUPNPAT(DFN,11),U,11)
IF AMHCOP=""
QUIT
+4 IF '$DATA(AMHCOAR(AMHCOP))
QUIT
VC ;
+1 ;do not use non patient activities CMI/TUCSON/LAB - added Q:'AMHACT to not bomb if activity null
SET AMHACT=$PIECE(AMHVN0,U,6)
IF 'AMHACT
QUIT
IF '$PIECE(^AMHTACT(AMHACT,0),U,6)
QUIT
+2 SET AMHVISIT=$PIECE(AMHVN0,U,16)
+3 IF '$DATA(^AMHRPROV("AD",AMHVDFN))
QUIT
+4 IF '$DATA(^AMHRPRO("AD",AMHVDFN))
QUIT
+5 IF $PIECE(AMHVN0,U,4)'=AMHSU
QUIT
+6 SET AMHPN=$PIECE(^DPT(DFN,0),U)
+7 SET ^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN,DFN,AMHVDFN)=""
+8 QUIT
2 ;
+1 SET AMHVAL=$SELECT(AMHPROC=2:"A",1:"B")
+2 SET AMHPROC=2
+3 DO V
+4 QUIT
22 ;
+1 IF '$DATA(^DPT(DFN,0))
QUIT
+2 IF '$DATA(^AUPNMCR(DFN,11))
QUIT
+3 IF '$DATA(^AUPNPAT(DFN,41,AMHSU,0))
QUIT
+4 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<$PIECE(AMHS,".")
QUIT
+5 KILL AMHGOT
SET AMHMDFN=0
FOR
SET AMHMDFN=$ORDER(^AUPNMCR(DFN,11,AMHMDFN))
IF AMHMDFN'=+AMHMDFN!($DATA(AMHGOT))
QUIT
DO 23
+6 IF '$DATA(AMHGOT)
QUIT
+7 SET AMHPN=$PIECE(^DPT(DFN,0),U)
+8 DO VC
+9 QUIT
+10 ;
23 ;
+1 IF AMHVAL'[$PIECE(^AUPNMCR(DFN,11,AMHMDFN,0),U,3)
QUIT
+2 IF $PIECE(^AUPNMCR(DFN,11,AMHMDFN,0),U)>$PIECE(AMHS,".")
QUIT
+3 IF $PIECE(^AUPNMCR(DFN,11,AMHMDFN,0),U,2)]""
IF $PIECE(^(0),U,2)<$PIECE(AMHS,".")
QUIT
+4 SET AMHGOT=""
+5 QUIT
+6 ;
3 ;
+1 DO 2
+2 QUIT
+3 ;
5 ;
+1 DO V
+2 QUIT
52 ;
+1 IF '$DATA(^AUPNPRVT(DFN,11))
QUIT
+2 IF '$DATA(^AUPNPAT(DFN,41,AMHSU))
QUIT
+3 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<$PIECE(AMHS,".")
QUIT
+4 SET AMHPN=$PIECE(^DPT(DFN,0),U)
+5 KILL AMHGOT
SET AMHMDFN=0
FOR
SET AMHMDFN=$ORDER(^AUPNPRVT(DFN,11,AMHMDFN))
IF AMHMDFN'=+AMHMDFN
QUIT
DO 53
+6 IF '$DATA(AMHGOT)
QUIT
+7 DO VC
+8 QUIT
53 ;
+1 IF $PIECE(^AUPNPRVT(DFN,11,AMHMDFN,0),U)=""
QUIT
+2 SET AMHNAME=$PIECE(^AUPNPRVT(DFN,11,AMHMDFN,0),U)
IF AMHNAME=""
QUIT
+3 SET AMHNAME=$PIECE(^AUTNINS(AMHNAME,0),U)
IF AMHNAME["AHCCCS"
QUIT
+4 IF $PIECE(^AUPNPRVT(DFN,11,AMHMDFN,0),U,6)=""
QUIT
+5 IF $PIECE(^AUPNPRVT(DFN,11,AMHMDFN,0),U,6)>$PIECE(AMHS,".")
QUIT
+6 IF $PIECE(^AUPNPRVT(DFN,11,AMHMDFN,0),U,7)]""
IF $PIECE(^(0),U,7)<$PIECE(AMHS,".")
QUIT
+7 SET AMHGOT=""
+8 QUIT
+9 ;
4 ;
+1 DO V
+2 QUIT
42 ;
+1 IF '$DATA(^AUPNPAT(DFN,41,AMHSU))
QUIT
+2 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<$PIECE(AMHS,".")
QUIT
+3 SET AMHPN=$PIECE(^DPT(DFN,0),U)
+4 KILL AMHGOT
SET AMHMDFN=0
SET AMHMDFN=$ORDER(^AUPNMCD("B",DFN,AMHMDFN))
IF AMHMDFN'=+AMHMDFN!($DATA(AMHGOT))
QUIT
DO 43
+5 IF '$DATA(AMHGOT)
QUIT
+6 DO VC
+7 QUIT
43 ;
+1 IF '$DATA(^AUPNMCD(AMHMDFN,11))
QUIT
+2 KILL AMHGOT
SET AMHNDFN=0
FOR
SET AMHNDFN=$ORDER(^AUPNMCD(AMHMDFN,11,AMHNDFN))
IF AMHNDFN'=+AMHNDFN!($DATA(AMHGOT))
QUIT
SET AMHREC=^AUPNMCD(AMHMDFN,11,AMHNDFN,0)
DO 44
+3 QUIT
44 ;
+1 IF AMHNDFN>$PIECE(AMHS,".")
QUIT
+2 IF $PIECE(AMHREC,U,2)]""
IF $PIECE(AMHREC,U,2)<$PIECE(AMHS,".")
QUIT
+3 SET AMHGOT=""
+4 QUIT
+5 ;
6 ;NON INDIANS
+1 DO V
+2 QUIT
62 ;
+1 IF '$DATA(^AUPNPAT(DFN,41,AMHSU))
QUIT
+2 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<$PIECE(AMHS,".")
QUIT
+3 IF '$DATA(^AUPNPAT(DFN,11))
QUIT
+4 IF $PIECE(^AUPNPAT(DFN,11),U,8)=""
QUIT
+5 SET AMHTRI=$PIECE(^AUPNPAT(DFN,11),U,8)
+6 IF '$DATA(^AUTTTRI(AMHTRI))
QUIT
+7 SET AMHTRIC=$PIECE(^AUTTTRI(AMHTRI,0),U,2)
+8 IF (+AMHTRIC&(AMHTRIC<969))
QUIT
+9 DO VC
+10 QUIT
