AMHRBV2.m

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