- AZXBV2 ; IHS/OHPRD/TMJ - gather billable visits ; [ 02/20/98 11:58 AM ]
- ;;3.0T3;IHS PCC REPORTS;;NOV 22, 1996
- ;SEARCH VISIT FILE FOR DATE RANGE AND GENERATE CLINIC COUNTS
- ;
- S APCLJOB=$J,APCLBT=$H
- K ^XTMP("APCLBV",APCLJOB,APCLBT)
- D XTMP^APCLOSUT("APCLBV","PCC - POTENTIALLY BILLABLE VISITS")
- S (APCLS,APCLSAVE)=APCLSD-.000001
- D:$D(APCLPALL) ALL
- I '$D(APCLPALL) D @APCLPROC
- S APCLET=$H
- Q
- ALL ;process ALL coverage reports
- S (APCLPROC,APCLRNUM)=1 D 1
- S (APCLPROC,APCLRNUM)=2 D 2
- S (APCLPROC,APCLRNUM)=3 D 3
- S (APCLPROC,APCLRNUM)=4 D 4
- S (APCLPROC,APCLRNUM)=5 D 5
- S (APCLPROC,APCLRNUM)=6 D 6
- Q
- 1 F X="03","04","30","31" S Y=$O(^AUTTBEN("C",X,"")) S APCLCOAR(Y)="" S APCLCOPN(Y)=$P(^AUTTBEN(Y,0),U)
- D V
- ;
- Q
- V ;
- S APCLS=APCLSAVE
- F I=0:0 S APCLS=$O(^AUPNVSIT("B",APCLS)) Q:APCLS=""!($P(APCLS,".")>APCLED) D V1
- Q
- V1 ;
- S APCLVDFN="" F J=0:0 S APCLVDFN=$O(^AUPNVSIT("B",APCLS,APCLVDFN)) Q:APCLVDFN="" S APCLVN0=^AUPNVSIT(APCLVDFN,0) D @(APCLPROC_"2")
- Q
- 12 S DFN=$P(APCLVN0,U,5) Q:DFN=""
- Q:$P(APCLVN0,U,11)
- Q:'$D(^AUPNPAT(DFN,41,APCLSU,0))
- Q:'$D(^AUPNPAT(DFN,11))
- S APCLCOP=$P(^AUPNPAT(DFN,11),U,11) Q:APCLCOP=""
- Q:'$D(APCLCOAR(APCLCOP))
- VC ;
- Q:APCLSC'[$P(APCLVN0,U,7)
- Q:'$P(APCLVN0,U,9)
- I APCLCLN,$P(APCLVN0,U,8)'=APCLCLN Q
- Q:'$D(^AUPNVPOV("AD",APCLVDFN))
- Q:'$D(^AUPNVPRV("AD",APCLVDFN))
- Q:$P(APCLVN0,U,6)'=APCLSU
- S APCLPN=$P(^DPT(DFN,0),U)
- S ^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN,DFN,APCLVDFN)=""
- Q
- 2 ;
- S APCLVAL=$S(APCLPROC=2:"A",1:"B")
- S APCLPROC=2
- D V
- Q
- 22 ;
- Q:$P(APCLVN0,U,11)
- S DFN=$P(APCLVN0,U,5) Q:DFN=""
- Q:'$D(^DPT(DFN,0))
- Q:'$D(^AUPNMCR(DFN,11))
- Q:'$D(^AUPNPAT(DFN,41,APCLSU,0))
- I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(APCLS,".") Q
- K APCLGOT S APCLMDFN=0 F S APCLMDFN=$O(^AUPNMCR(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLGOT)) D 23
- Q:'$D(APCLGOT)
- S APCLPN=$P(^DPT(DFN,0),U)
- D VC
- Q
- ;
- 23 ;
- Q:APCLVAL'[$P(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
- Q:$P(^AUPNMCR(DFN,11,APCLMDFN,0),U)>$P(APCLS,".")
- I $P(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]"",$P(^(0),U,2)<$P(APCLS,".") Q
- S APCLGOT=""
- Q
- ;
- 3 ;
- D 2
- Q
- ;
- 5 ;
- D V
- Q
- 52 ;
- Q:$P(APCLVN0,U,11)
- S DFN=$P(^AUPNVSIT(APCLVDFN,0),U,5) Q:DFN=""
- Q:'$D(^AUPNPRVT(DFN,11))
- Q:'$D(^AUPNPAT(DFN,41,APCLSU))
- I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(APCLS,".") Q
- S APCLPN=$P(^DPT(DFN,0),U)
- K APCLGOT S APCLMDFN=0 F S APCLMDFN=$O(^AUPNPRVT(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN D 53
- Q:'$D(APCLGOT)
- D VC
- Q
- 53 ;
- 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)=""
- Q:$P(^AUPNPRVT(DFN,11,APCLMDFN,0),U,6)>$P(APCLS,".")
- I $P(^AUPNPRVT(DFN,11,APCLMDFN,0),U,7)]"",$P(^(0),U,7)<$P(APCLS,".") Q
- S APCLGOT=""
- Q
- ;
- 4 ;
- D V
- Q
- 42 ;
- Q:$P(APCLVN0,U,11)
- S DFN=$P(^AUPNVSIT(APCLVDFN,0),U,5) Q:DFN=""
- Q:'$D(^AUPNPAT(DFN,41,APCLSU))
- I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(APCLS,".") Q
- S APCLPN=$P(^DPT(DFN,0),U)
- K APCLGOT S APCLMDFN=0 S APCLMDFN=$O(^AUPNMCD("B",DFN,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLGOT)) D 43
- Q:'$D(APCLGOT)
- D VC
- Q
- 43 ;
- Q:'$D(^AUPNMCD(APCLMDFN,11))
- K APCLGOT S APCLNDFN=0 F S APCLNDFN=$O(^AUPNMCD(APCLMDFN,11,APCLNDFN)) Q:APCLNDFN'=+APCLNDFN!($D(APCLGOT)) S APCLREC=^AUPNMCD(APCLMDFN,11,APCLNDFN,0) D 44
- Q
- 44 ;
- Q:APCLNDFN>$P(APCLS,".")
- I $P(APCLREC,U,2)]"",$P(APCLREC,U,2)<$P(APCLS,".") Q
- S APCLGOT=""
- Q
- ;
- 6 ;NON INDIANS
- D V
- Q
- 62 ;
- Q:$P(APCLVN0,U,11)
- S DFN=$P(^AUPNVSIT(APCLVDFN,0),U,5) Q:DFN=""
- Q:'$D(^AUPNPAT(DFN,41,APCLSU))
- I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(APCLS,".") Q
- Q:'$D(^AUPNPAT(DFN,11))
- Q:$P(^AUPNPAT(DFN,11),U,11)=01
- Q:$P(^AUPNPAT(DFN,11),U,8)=""
- S APCLTRI=$P(^AUPNPAT(DFN,11),U,8)
- Q:'$D(^AUTTTRI(APCLTRI))
- S APCLTRIC=$P(^AUTTTRI(APCLTRI,0),U,2)
- Q:(+APCLTRIC&(APCLTRIC<969))
- D VC
- Q
- AZXBV2 ; IHS/OHPRD/TMJ - gather billable visits ; [ 02/20/98 11:58 AM ]
- +1 ;;3.0T3;IHS PCC REPORTS;;NOV 22, 1996
- +2 ;SEARCH VISIT FILE FOR DATE RANGE AND GENERATE CLINIC COUNTS
- +3 ;
- +4 SET APCLJOB=$JOB
- SET APCLBT=$HOROLOG
- +5 KILL ^XTMP("APCLBV",APCLJOB,APCLBT)
- +6 DO XTMP^APCLOSUT("APCLBV","PCC - POTENTIALLY BILLABLE VISITS")
- +7 SET (APCLS,APCLSAVE)=APCLSD-.000001
- +8 IF $DATA(APCLPALL)
- DO ALL
- +9 IF '$DATA(APCLPALL)
- DO @APCLPROC
- +10 SET APCLET=$HOROLOG
- +11 QUIT
- ALL ;process ALL coverage reports
- +1 SET (APCLPROC,APCLRNUM)=1
- DO 1
- +2 SET (APCLPROC,APCLRNUM)=2
- DO 2
- +3 SET (APCLPROC,APCLRNUM)=3
- DO 3
- +4 SET (APCLPROC,APCLRNUM)=4
- DO 4
- +5 SET (APCLPROC,APCLRNUM)=5
- DO 5
- +6 SET (APCLPROC,APCLRNUM)=6
- DO 6
- +7 QUIT
- 1 FOR X="03","04","30","31"
- SET Y=$ORDER(^AUTTBEN("C",X,""))
- SET APCLCOAR(Y)=""
- SET APCLCOPN(Y)=$PIECE(^AUTTBEN(Y,0),U)
- +1 DO V
- +2 ;
- +3 QUIT
- V ;
- +1 SET APCLS=APCLSAVE
- +2 FOR I=0:0
- SET APCLS=$ORDER(^AUPNVSIT("B",APCLS))
- IF APCLS=""!($PIECE(APCLS,".")>APCLED)
- QUIT
- DO V1
- +3 QUIT
- V1 ;
- +1 SET APCLVDFN=""
- FOR J=0:0
- SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLS,APCLVDFN))
- IF APCLVDFN=""
- QUIT
- SET APCLVN0=^AUPNVSIT(APCLVDFN,0)
- DO @(APCLPROC_"2")
- +2 QUIT
- 12 SET DFN=$PIECE(APCLVN0,U,5)
- IF DFN=""
- QUIT
- +1 IF $PIECE(APCLVN0,U,11)
- QUIT
- +2 IF '$DATA(^AUPNPAT(DFN,41,APCLSU,0))
- QUIT
- +3 IF '$DATA(^AUPNPAT(DFN,11))
- QUIT
- +4 SET APCLCOP=$PIECE(^AUPNPAT(DFN,11),U,11)
- IF APCLCOP=""
- QUIT
- +5 IF '$DATA(APCLCOAR(APCLCOP))
- QUIT
- VC ;
- +1 IF APCLSC'[$PIECE(APCLVN0,U,7)
- QUIT
- +2 IF '$PIECE(APCLVN0,U,9)
- QUIT
- +3 IF APCLCLN
- IF $PIECE(APCLVN0,U,8)'=APCLCLN
- QUIT
- +4 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
- QUIT
- +5 IF '$DATA(^AUPNVPRV("AD",APCLVDFN))
- QUIT
- +6 IF $PIECE(APCLVN0,U,6)'=APCLSU
- QUIT
- +7 SET APCLPN=$PIECE(^DPT(DFN,0),U)
- +8 SET ^XTMP("APCLBV",APCLJOB,APCLBT,APCLRNUM,APCLPN,DFN,APCLVDFN)=""
- +9 QUIT
- 2 ;
- +1 SET APCLVAL=$SELECT(APCLPROC=2:"A",1:"B")
- +2 SET APCLPROC=2
- +3 DO V
- +4 QUIT
- 22 ;
- +1 IF $PIECE(APCLVN0,U,11)
- QUIT
- +2 SET DFN=$PIECE(APCLVN0,U,5)
- IF DFN=""
- QUIT
- +3 IF '$DATA(^DPT(DFN,0))
- QUIT
- +4 IF '$DATA(^AUPNMCR(DFN,11))
- QUIT
- +5 IF '$DATA(^AUPNPAT(DFN,41,APCLSU,0))
- QUIT
- +6 IF $DATA(^DPT(DFN,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<$PIECE(APCLS,".")
- QUIT
- +7 KILL APCLGOT
- SET APCLMDFN=0
- FOR
- SET APCLMDFN=$ORDER(^AUPNMCR(DFN,11,APCLMDFN))
- IF APCLMDFN'=+APCLMDFN!($DATA(APCLGOT))
- QUIT
- DO 23
- +8 IF '$DATA(APCLGOT)
- QUIT
- +9 SET APCLPN=$PIECE(^DPT(DFN,0),U)
- +10 DO VC
- +11 QUIT
- +12 ;
- 23 ;
- +1 IF APCLVAL'[$PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
- QUIT
- +2 IF $PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U)>$PIECE(APCLS,".")
- QUIT
- +3 IF $PIECE(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]""
- IF $PIECE(^(0),U,2)<$PIECE(APCLS,".")
- QUIT
- +4 SET APCLGOT=""
- +5 QUIT
- +6 ;
- 3 ;
- +1 DO 2
- +2 QUIT
- +3 ;
- 5 ;
- +1 DO V
- +2 QUIT
- 52 ;
- +1 IF $PIECE(APCLVN0,U,11)
- QUIT
- +2 SET DFN=$PIECE(^AUPNVSIT(APCLVDFN,0),U,5)
- IF DFN=""
- QUIT
- +3 IF '$DATA(^AUPNPRVT(DFN,11))
- QUIT
- +4 IF '$DATA(^AUPNPAT(DFN,41,APCLSU))
- QUIT
- +5 IF $DATA(^DPT(DFN,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<$PIECE(APCLS,".")
- QUIT
- +6 SET APCLPN=$PIECE(^DPT(DFN,0),U)
- +7 KILL APCLGOT
- SET APCLMDFN=0
- FOR
- SET APCLMDFN=$ORDER(^AUPNPRVT(DFN,11,APCLMDFN))
- IF APCLMDFN'=+APCLMDFN
- QUIT
- DO 53
- +8 IF '$DATA(APCLGOT)
- QUIT
- +9 DO VC
- +10 QUIT
- 53 ;
- +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)=""
- QUIT
- +5 IF $PIECE(^AUPNPRVT(DFN,11,APCLMDFN,0),U,6)>$PIECE(APCLS,".")
- QUIT
- +6 IF $PIECE(^AUPNPRVT(DFN,11,APCLMDFN,0),U,7)]""
- IF $PIECE(^(0),U,7)<$PIECE(APCLS,".")
- QUIT
- +7 SET APCLGOT=""
- +8 QUIT
- +9 ;
- 4 ;
- +1 DO V
- +2 QUIT
- 42 ;
- +1 IF $PIECE(APCLVN0,U,11)
- QUIT
- +2 SET DFN=$PIECE(^AUPNVSIT(APCLVDFN,0),U,5)
- IF DFN=""
- QUIT
- +3 IF '$DATA(^AUPNPAT(DFN,41,APCLSU))
- QUIT
- +4 IF $DATA(^DPT(DFN,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<$PIECE(APCLS,".")
- QUIT
- +5 SET APCLPN=$PIECE(^DPT(DFN,0),U)
- +6 KILL APCLGOT
- SET APCLMDFN=0
- SET APCLMDFN=$ORDER(^AUPNMCD("B",DFN,APCLMDFN))
- IF APCLMDFN'=+APCLMDFN!($DATA(APCLGOT))
- QUIT
- DO 43
- +7 IF '$DATA(APCLGOT)
- QUIT
- +8 DO VC
- +9 QUIT
- 43 ;
- +1 IF '$DATA(^AUPNMCD(APCLMDFN,11))
- QUIT
- +2 KILL APCLGOT
- SET APCLNDFN=0
- FOR
- SET APCLNDFN=$ORDER(^AUPNMCD(APCLMDFN,11,APCLNDFN))
- IF APCLNDFN'=+APCLNDFN!($DATA(APCLGOT))
- QUIT
- SET APCLREC=^AUPNMCD(APCLMDFN,11,APCLNDFN,0)
- DO 44
- +3 QUIT
- 44 ;
- +1 IF APCLNDFN>$PIECE(APCLS,".")
- QUIT
- +2 IF $PIECE(APCLREC,U,2)]""
- IF $PIECE(APCLREC,U,2)<$PIECE(APCLS,".")
- QUIT
- +3 SET APCLGOT=""
- +4 QUIT
- +5 ;
- 6 ;NON INDIANS
- +1 DO V
- +2 QUIT
- 62 ;
- +1 IF $PIECE(APCLVN0,U,11)
- QUIT
- +2 SET DFN=$PIECE(^AUPNVSIT(APCLVDFN,0),U,5)
- IF DFN=""
- QUIT
- +3 IF '$DATA(^AUPNPAT(DFN,41,APCLSU))
- QUIT
- +4 IF $DATA(^DPT(DFN,.35))
- IF $PIECE(^(.35),U)]""
- IF $PIECE(^(.35),U)<$PIECE(APCLS,".")
- QUIT
- +5 IF '$DATA(^AUPNPAT(DFN,11))
- QUIT
- +6 IF $PIECE(^AUPNPAT(DFN,11),U,11)=01
- QUIT
- +7 IF $PIECE(^AUPNPAT(DFN,11),U,8)=""
- QUIT
- +8 SET APCLTRI=$PIECE(^AUPNPAT(DFN,11),U,8)
- +9 IF '$DATA(^AUTTTRI(APCLTRI))
- QUIT
- +10 SET APCLTRIC=$PIECE(^AUTTTRI(APCLTRI,0),U,2)
- +11 IF (+APCLTRIC&(APCLTRIC<969))
- QUIT
- +12 DO VC
- +13 QUIT
