APCLBRH2 ; IHS/CMI/LAB - process billing report holders ;
;;2.0;IHS PCC SUITE;**8**;MAY 14, 2009;Build 2
;
START ;
S APCLBT=$H,APCLJOB=$J
S (DFN,APCLTOT)=0 K ^XTMP("APCLBRH",APCLJOB,APCLBT)
D XTMP^APCLOSUT("APCLBRH","PCC - PATS WITH 3RD PARTY")
D @APCLPROC
S APCLET=$H
Q
;
MCRA ;
F S DFN=$O(^AUPNMCR(DFN)) Q:DFN'=+DFN I '$$DEMO^APCLUTL(DFN,$G(APCLDEMO)) D MCRA2
Q
MCRA2 ;
Q:'$D(^AUPNMCR(DFN,11))
Q:'$D(^AUPNPAT(DFN,41,APCLSU,0))
Q:'$D(^DPT(DFN,0))
Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<APCLACE Q
S APCLPN=$P(^DPT(DFN,0),U)
S APCLMDFN=0 F S APCLMDFN=$O(^AUPNMCR(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN D MCRA3
Q:'$D(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN))
S APCLTOT=APCLTOT+1
K APCLPN
Q
;
MCRA3 ;
Q:APCLVAL'[$P(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
Q:$P(^AUPNMCR(DFN,11,APCLMDFN,0),U)>APCLACE
I $P(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]"",$P(^(0),U,2)<APCLACE Q
S ^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN)=""
Q
;
PI ;
F S DFN=$O(^AUPNPRVT(DFN)) Q:DFN'=+DFN I '$$DEMO^APCLUTL(DFN,$G(APCLDEMO)) D PI2
Q
PI2 ;
Q:'$D(^AUPNPAT(DFN,41,APCLSU))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<APCLACE Q
Q:'$D(^AUPNPRVT(DFN,11))
S APCLPN=$P(^DPT(DFN,0),U)
S APCLMDFN=0 F S APCLMDFN=$O(^AUPNPRVT(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN D PI3
Q:'$D(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN))
S APCLTOT=APCLTOT+1
K APCLPN
Q
PI3 ;
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)>APCLACE
I $P(^AUPNPRVT(DFN,11,APCLMDFN,0),U,7)]"",$P(^(0),U,7)<APCLACE Q
S ^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN)=""
Q
;
MCD ;
F S DFN=$O(^AUPNMCD("B",DFN)) Q:DFN'=+DFN I '$$DEMO^APCLUTL(DFN,$G(APCLDEMO)) D MCD2
Q
MCD2 ;
Q:'$D(^AUPNPAT(DFN,41,APCLSU))
I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<APCLACE Q
S APCLPN=$P(^DPT(DFN,0),U)
S APCLMDFN=0 S APCLMDFN=$O(^AUPNMCD("B",DFN,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN D MCD3
Q:'$D(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN))
S APCLTOT=APCLTOT+1
K APCLPN
Q
MCD3 ;
Q:'$D(^AUPNMCD(APCLMDFN,11))
S APCLNDFN=0 F S APCLNDFN=$O(^AUPNMCD(APCLMDFN,11,APCLNDFN)) Q:APCLNDFN'=+APCLNDFN S APCLR=^AUPNMCD(APCLMDFN,11,APCLNDFN,0) D MCD4
Q
MCD4 ;
Q:APCLNDFN>APCLACE
I $P(APCLR,U,2)]"",$P(APCLR,U,2)<APCLACE Q
S ^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN,APCLNDFN)=""
Q
APCLBRH2 ; IHS/CMI/LAB - process billing report holders ;
+1 ;;2.0;IHS PCC SUITE;**8**;MAY 14, 2009;Build 2
+2 ;
START ;
+1 SET APCLBT=$HOROLOG
SET APCLJOB=$JOB
+2 SET (DFN,APCLTOT)=0
KILL ^XTMP("APCLBRH",APCLJOB,APCLBT)
+3 DO XTMP^APCLOSUT("APCLBRH","PCC - PATS WITH 3RD PARTY")
+4 DO @APCLPROC
+5 SET APCLET=$HOROLOG
+6 QUIT
+7 ;
MCRA ;
+1 FOR
SET DFN=$ORDER(^AUPNMCR(DFN))
IF DFN'=+DFN
QUIT
IF '$$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
DO MCRA2
+2 QUIT
MCRA2 ;
+1 IF '$DATA(^AUPNMCR(DFN,11))
QUIT
+2 IF '$DATA(^AUPNPAT(DFN,41,APCLSU,0))
QUIT
+3 IF '$DATA(^DPT(DFN,0))
QUIT
+4 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+5 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<APCLACE
QUIT
+6 SET APCLPN=$PIECE(^DPT(DFN,0),U)
+7 SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^AUPNMCR(DFN,11,APCLMDFN))
IF APCLMDFN'=+APCLMDFN
QUIT
DO MCRA3
+8 IF '$DATA(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN))
QUIT
+9 SET APCLTOT=APCLTOT+1
+10 KILL APCLPN
+11 QUIT
+12 ;
MCRA3 ;
+1 IF APCLVAL'[$PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
QUIT
+2 IF $PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U)>APCLACE
QUIT
+3 IF $PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]""
IF $PIECE(^(0),U,2)<APCLACE
QUIT
+4 SET ^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN)=""
+5 QUIT
+6 ;
PI ;
+1 FOR
SET DFN=$ORDER(^AUPNPRVT(DFN))
IF DFN'=+DFN
QUIT
IF '$$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
DO PI2
+2 QUIT
PI2 ;
+1 IF '$DATA(^AUPNPAT(DFN,41,APCLSU))
QUIT
+2 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<APCLACE
QUIT
+3 IF '$DATA(^AUPNPRVT(DFN,11))
QUIT
+4 SET APCLPN=$PIECE(^DPT(DFN,0),U)
+5 SET APCLMDFN=0
FOR
SET APCLMDFN=$ORDER(^AUPNPRVT(DFN,11,APCLMDFN))
IF APCLMDFN'=+APCLMDFN
QUIT
DO PI3
+6 IF '$DATA(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN))
QUIT
+7 SET APCLTOT=APCLTOT+1
+8 KILL APCLPN
+9 QUIT
PI3 ;
+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)>APCLACE
QUIT
+5 IF $PIECE(^AUPNPRVT(DFN,11,APCLMDFN,0),U,7)]""
IF $PIECE(^(0),U,7)<APCLACE
QUIT
+6 SET ^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN)=""
+7 QUIT
+8 ;
MCD ;
+1 FOR
SET DFN=$ORDER(^AUPNMCD("B",DFN))
IF DFN'=+DFN
QUIT
IF '$$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
DO MCD2
+2 QUIT
MCD2 ;
+1 IF '$DATA(^AUPNPAT(DFN,41,APCLSU))
QUIT
+2 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<APCLACE
QUIT
+3 SET APCLPN=$PIECE(^DPT(DFN,0),U)
+4 SET APCLMDFN=0
SET APCLMDFN=$ORDER(^AUPNMCD("B",DFN,APCLMDFN))
IF APCLMDFN'=+APCLMDFN
QUIT
DO MCD3
+5 IF '$DATA(^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN))
QUIT
+6 SET APCLTOT=APCLTOT+1
+7 KILL APCLPN
+8 QUIT
MCD3 ;
+1 IF '$DATA(^AUPNMCD(APCLMDFN,11))
QUIT
+2 SET APCLNDFN=0
FOR
SET APCLNDFN=$ORDER(^AUPNMCD(APCLMDFN,11,APCLNDFN))
IF APCLNDFN'=+APCLNDFN
QUIT
SET APCLR=^AUPNMCD(APCLMDFN,11,APCLNDFN,0)
DO MCD4
+3 QUIT
MCD4 ;
+1 IF APCLNDFN>APCLACE
QUIT
+2 IF $PIECE(APCLR,U,2)]""
IF $PIECE(APCLR,U,2)<APCLACE
QUIT
+3 SET ^XTMP("APCLBRH",APCLJOB,APCLBT,APCLPN,DFN,APCLMDFN,APCLNDFN)=""
+4 QUIT
