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
