ABMDREL2.m

ABMDREL2 ; IHS/ASDST/DMJ - process billing report holders ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;TMD;

 ;

START ;

 S ABMD("BT")=$H

 S (ABMD("DFN"),ABMD("TOT"))=0 K ^TMP("ABMDBRH",ABMD("$J"))

 D @ABMD("PROC")

 Q

 ;

MCRA ;

 F  S ABMD("DFN")=$O(^AUPNMCR(ABMD("DFN"))) Q:'ABMD("DFN")  D MCRA2

 Q

MCRA2 ;

 Q:'$D(^AUPNMCR(ABMD("DFN"),11))

 Q:'$D(^AUPNPAT(ABMD("DFN"),41,ABMD("SU"),0))

 Q:'$D(^DPT(ABMD("DFN"),0))

 I $D(^DPT(ABMD("DFN"),.35)),$P(^(.35),U,1)]"",$P(^(.35),U,1)<ABMD("ACE") Q

 S ABMD("PN")=$P(^DPT(ABMD("DFN"),0),U)

 S ABMD("MDFN")=0 F  S ABMD("MDFN")=$O(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"))) Q:'ABMD("MDFN")  D MCRA3

 Q:'$D(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN")))

 S ABMD("TOT")=ABMD("TOT")+1

 K ABMD("PN")

 Q

 ;

MCRA3 ;

 Q:ABMD("VAL")'[$P(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"),0),U,3)

 Q:$P(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"),0),U,1)>ABMD("ACE")

 I $P(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"),0),U,2)]"",$P(^(0),U,2)<ABMD("ACE") Q

 S ^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"))=""

 Q

 ;

PI ;

 F  S ABMD("DFN")=$O(^AUPNPRVT(ABMD("DFN"))) Q:'ABMD("DFN")  D PI2

 Q

PI2 ;

 Q:'$D(^AUPNPAT(ABMD("DFN"),41,ABMD("SU")))

 I $D(^DPT(ABMD("DFN"),.35)),$P(^(.35),U,1)]"",$P(^(.35),U,1)<ABMD("ACE") Q

 Q:'$D(^AUPNPRVT(ABMD("DFN"),11))

 S ABMD("PN")=$P(^DPT(ABMD("DFN"),0),U)

 S ABMD("MDFN")=0 F  S ABMD("MDFN")=$O(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"))) Q:'ABMD("MDFN")  D PI3

 Q:'$D(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN")))

 S ABMD("TOT")=ABMD("TOT")+1

 K ABMD("PN")

 Q

PI3 ;

 Q:$P(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0),U)=""

 S ABMD("NAME")=$P(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0),U) Q:ABMD("NAME")=""

 Q:'$D(^AUTNINS(ABMD("NAME"),0))

 S ABMD("NAME")=$P(^AUTNINS(ABMD("NAME"),0),U) I ABMD("NAME")["AHCCCS" Q

 Q:$P(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0),U,6)>ABMD("ACE")

 I $P(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0),U,7)]"",$P(^(0),U,7)<ABMD("ACE") Q

 S ^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"))=""

 Q

 ;

MCD ;

 F  S ABMD("DFN")=$O(^AUPNMCD("B",ABMD("DFN"))) Q:'ABMD("DFN")  D MCD2

 Q

MCD2 ;

 Q:'$D(^AUPNPAT(ABMD("DFN"),41,ABMD("SU")))

 I $D(^DPT(ABMD("DFN"),.35)),$P(^(.35),U,1)]"",$P(^(.35),U,1)<ABMD("ACE") Q

 S ABMD("PN")=$P(^DPT(ABMD("DFN"),0),U)

 S ABMD("MDFN")=0 S ABMD("MDFN")=$O(^AUPNMCD("B",ABMD("DFN"),ABMD("MDFN"))) Q:'ABMD("MDFN")  D MCD3

 Q:'$D(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN")))

 S ABMD("TOT")=ABMD("TOT")+1

 K ABMD("PN")

 Q

MCD3 ;

 Q:'$D(^AUPNMCD(ABMD("MDFN"),11))

 S ABMD("NDFN")=0 F  S ABMD("NDFN")=$O(^AUPNMCD(ABMD("MDFN"),11,ABMD("NDFN"))) Q:'ABMD("NDFN")  S ABMD("R")=^AUPNMCD(ABMD("MDFN"),11,ABMD("NDFN"),0) D MCD4

 Q

MCD4 ;

 Q:ABMD("NDFN")>ABMD("ACE")

 I $P(ABMD("R"),U,2)]"",$P(ABMD("R"),U,2)<ABMD("ACE") Q

 S ^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"),ABMD("NDFN"))=""

 Q

ABMDREL2  ; IHS/ASDST/DMJ - process billing report holders ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;TMD;

 +3       ;

START     ;

 +1        SET ABMD("BT")=$HOROLOG

 +2        SET (ABMD("DFN"),ABMD("TOT"))=0

           KILL ^TMP("ABMDBRH",ABMD("$J"))

 +3        DO @ABMD("PROC")

 +4        QUIT 

 +5       ;

MCRA      ;

 +1        FOR 

               SET ABMD("DFN")=$ORDER(^AUPNMCR(ABMD("DFN")))

               IF 'ABMD("DFN")

                   QUIT 

               DO MCRA2

 +2        QUIT 

MCRA2     ;

 +1        IF '$DATA(^AUPNMCR(ABMD("DFN"),11))

               QUIT 

 +2        IF '$DATA(^AUPNPAT(ABMD("DFN"),41,ABMD("SU"),0))

               QUIT 

 +3        IF '$DATA(^DPT(ABMD("DFN"),0))

               QUIT 

 +4        IF $DATA(^DPT(ABMD("DFN"),.35))

               IF $PIECE(^(.35),U,1)]""

                   IF $PIECE(^(.35),U,1)<ABMD("ACE")

                       QUIT 

 +5        SET ABMD("PN")=$PIECE(^DPT(ABMD("DFN"),0),U)

 +6        SET ABMD("MDFN")=0

           FOR 

               SET ABMD("MDFN")=$ORDER(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN")))

               IF 'ABMD("MDFN")

                   QUIT 

               DO MCRA3

 +7        IF '$DATA(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN")))

               QUIT 

 +8        SET ABMD("TOT")=ABMD("TOT")+1

 +9        KILL ABMD("PN")

 +10       QUIT 

 +11      ;

MCRA3     ;

 +1        IF ABMD("VAL")'[$PIECE(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"),0),U,3)

               QUIT 

 +2        IF $PIECE(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"),0),U,1)>ABMD("ACE")

               QUIT 

 +3        IF $PIECE(^AUPNMCR(ABMD("DFN"),11,ABMD("MDFN"),0),U,2)]""

               IF $PIECE(^(0),U,2)<ABMD("ACE")

                   QUIT 

 +4        SET ^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"))=""

 +5        QUIT 

 +6       ;

PI        ;

 +1        FOR 

               SET ABMD("DFN")=$ORDER(^AUPNPRVT(ABMD("DFN")))

               IF 'ABMD("DFN")

                   QUIT 

               DO PI2

 +2        QUIT 

PI2       ;

 +1        IF '$DATA(^AUPNPAT(ABMD("DFN"),41,ABMD("SU")))

               QUIT 

 +2        IF $DATA(^DPT(ABMD("DFN"),.35))

               IF $PIECE(^(.35),U,1)]""

                   IF $PIECE(^(.35),U,1)<ABMD("ACE")

                       QUIT 

 +3        IF '$DATA(^AUPNPRVT(ABMD("DFN"),11))

               QUIT 

 +4        SET ABMD("PN")=$PIECE(^DPT(ABMD("DFN"),0),U)

 +5        SET ABMD("MDFN")=0

           FOR 

               SET ABMD("MDFN")=$ORDER(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN")))

               IF 'ABMD("MDFN")

                   QUIT 

               DO PI3

 +6        IF '$DATA(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN")))

               QUIT 

 +7        SET ABMD("TOT")=ABMD("TOT")+1

 +8        KILL ABMD("PN")

 +9        QUIT 

PI3       ;

 +1        IF $PIECE(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0),U)=""

               QUIT 

 +2        SET ABMD("NAME")=$PIECE(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0),U)

           IF ABMD("NAME")=""

               QUIT 

 +3        IF '$DATA(^AUTNINS(ABMD("NAME"),0))

               QUIT 

 +4        SET ABMD("NAME")=$PIECE(^AUTNINS(ABMD("NAME"),0),U)

           IF ABMD("NAME")["AHCCCS"

               QUIT 

 +5        IF $PIECE(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0),U,6)>ABMD("ACE")

               QUIT 

 +6        IF $PIECE(^AUPNPRVT(ABMD("DFN"),11,ABMD("MDFN"),0),U,7)]""

               IF $PIECE(^(0),U,7)<ABMD("ACE")

                   QUIT 

 +7        SET ^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"))=""

 +8        QUIT 

 +9       ;

MCD       ;

 +1        FOR 

               SET ABMD("DFN")=$ORDER(^AUPNMCD("B",ABMD("DFN")))

               IF 'ABMD("DFN")

                   QUIT 

               DO MCD2

 +2        QUIT 

MCD2      ;

 +1        IF '$DATA(^AUPNPAT(ABMD("DFN"),41,ABMD("SU")))

               QUIT 

 +2        IF $DATA(^DPT(ABMD("DFN"),.35))

               IF $PIECE(^(.35),U,1)]""

                   IF $PIECE(^(.35),U,1)<ABMD("ACE")

                       QUIT 

 +3        SET ABMD("PN")=$PIECE(^DPT(ABMD("DFN"),0),U)

 +4        SET ABMD("MDFN")=0

           SET ABMD("MDFN")=$ORDER(^AUPNMCD("B",ABMD("DFN"),ABMD("MDFN")))

           IF 'ABMD("MDFN")

               QUIT 

           DO MCD3

 +5        IF '$DATA(^TMP("ABMDBRH",ABMD("$J"),ABMD("PN")))

               QUIT 

 +6        SET ABMD("TOT")=ABMD("TOT")+1

 +7        KILL ABMD("PN")

 +8        QUIT 

MCD3      ;

 +1        IF '$DATA(^AUPNMCD(ABMD("MDFN"),11))

               QUIT 

 +2        SET ABMD("NDFN")=0

           FOR 

               SET ABMD("NDFN")=$ORDER(^AUPNMCD(ABMD("MDFN"),11,ABMD("NDFN")))

               IF 'ABMD("NDFN")

                   QUIT 

               SET ABMD("R")=^AUPNMCD(ABMD("MDFN"),11,ABMD("NDFN"),0)

               DO MCD4

 +3        QUIT 

MCD4      ;

 +1        IF ABMD("NDFN")>ABMD("ACE")

               QUIT 

 +2        IF $PIECE(ABMD("R"),U,2)]""

               IF $PIECE(ABMD("R"),U,2)<ABMD("ACE")

                   QUIT 

 +3        SET ^TMP("ABMDBRH",ABMD("$J"),ABMD("PN"),ABMD("DFN"),ABMD("MDFN"),ABMD("NDFN"))=""

 +4        QUIT