- 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
