- DGBTOA6 ;ALB/SCK - DGBT BENE TRAVEL PAYABLE CLAIMS REPORT ; 6/29/93 7/16/93
- ;;5.3;Registration;**13,51,1015**;Aug 13, 1993;Build 21
- ACCTS ;
- U IO
- N Y
- K ^TMP("BT",$J)
- F ACTCDE=4,5 D
- . S Y=$$GETACT(ACTCDE)
- D KVAR^VADPT
- D REPORT
- K DGBTBEG,DGBTBG,DGBTEND,CDATE,CURACT,ACTCDE,DIV,ERR,^TMP("BT",$J)
- ACCTSQ Q
- ;
- GETACT(ACTNUM) ;
- N Y S Y=1
- S CDATE=DGBTBG F S CDATE=$O(^DGBT(392,"ACTP",ACTNUM,CDATE)) Q:'CDATE!(CDATE>DGBTEND) D
- . N BTCLAIM
- . Q:'$D(^DGBT(392,CDATE,0))
- . S BTCLAIM=^DGBT(392,CDATE,0)
- . S BTCLAIM("M")=$G(^DGBT(392,CDATE,"M")) ; reference node "M" of bene travel claim file (#392)
- . S BTCLAIM("R")=$G(^DGBT(392,CDATE,"R")) ; reference node "R" of bene travel claim file ( #392)
- . S DIV=$P($G(BTCLAIM),U,11)
- . S DFN=$P($G(BTCLAIM),U,2)
- . D PID^VADPT6 Q:VAERR
- . S ^TMP("BT",$J,ACTNUM,DIV,$P($G(^DPT(DFN,0)),U),VA("PID"),CDATE)=$P(BTCLAIM("M"),U,3)_"^"_$P(BTCLAIM,U,9)_"^"_$P(BTCLAIM,U,10)_"^"_$P(BTCLAIM("R"),U)
- Q (Y)
- ;
- REPORT ;
- N BTFIN,PDIV,NDIV
- I '$D(^TMP("BT",$J)) D NOREP Q
- S ERR=$$SETVAR()
- S CURACT="",CURACT=$O(^TMP("BT",$J,CURACT)),PRVACT=CURACT
- Q:$$HEADR()
- S CURACT="" F S CURACT=$O(^TMP("BT",$J,CURACT)) Q:CURACT="" D Q:BTFIN
- . I CURACT'=PRVACT D SUBS S BTFIN=$$HEADR,PRVACT=CURACT I PDIV]"" S ERR=$$DIVSN(NDIV)
- . S NDIV="" F S NDIV=$O(^TMP("BT",$J,CURACT,NDIV)) Q:NDIV']"" S:PDIV'=NDIV PDIV=$$DIVSN(NDIV) D Q:BTFIN
- .. S CURNAME="" F S CURNAME=$O(^TMP("BT",$J,CURACT,NDIV,CURNAME)) Q:CURNAME="" D Q:BTFIN
- ... S CURID="" F S CURID=$O(^TMP("BT",$J,CURACT,NDIV,CURNAME,CURID)) Q:CURID="" D Q:BTFIN
- .... S CDATE="" F S CDATE=$O(^TMP("BT",$J,CURACT,NDIV,CURNAME,CURID,CDATE)) Q:CDATE="" S BTFIN=$$PRTOUT() Q:BTFIN
- D TOTL
- Q
- ;
- PRTOUT() ;
- N Y
- S BTCLAIM=^TMP("BT",$J,CURACT,NDIV,CURNAME,CURID,CDATE)
- I $Y+5>IOSL S Y=$$HEADR() G:Y PRTOUTQ
- W !,$E(CURNAME,1,21),?23,CURID,?37,$$EXDATE(CDATE),?61,$FN($P(BTCLAIM,U,1),"",2),?70,$FN($P(BTCLAIM,U,2),"",2),?78,$FN($P(BTCLAIM,U,3),"",2),?86,$E($P(BTCLAIM,U,4),1,50)
- S COUNT=COUNT+1,MILES=MILES+$P(BTCLAIM,U,1),DEDCT=DEDCT+$P(BTCLAIM,U,2),PAY=PAY+$P(BTCLAIM,U,3)
- PRTOUTQ Q (Y)
- ;
- EXDATE(CDOUT) ;
- S Y=CDOUT D DD^%DT
- Q (Y)
- ;
- DIVSN(NDIV) ;
- I $G(NDIV)]"" D
- . W !!,"Division: ",$P($G(^DG(40.8,NDIV,0)),"^")
- . W !,"========="
- Q (NDIV)
- ;
- NOREP ;
- S CURACT=4,PAGE=0
- I $$HEADR() G NOREPQ
- W !!,"No data found for accounts 'ALL OTHER' or 'C&P'"
- NOREPQ Q
- ;
- HEADR() ;
- N QFLAG S QFLAG=0
- I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S QFLAG='Y G:QFLAG HEADRQ W @IOF
- S PAGE=PAGE+1
- I $E(IOST,1,2)'="C-" W @IOF
- W !,"Payable Claims Report"
- W ?(IOM-40),"Report Date: ",$P($$NOW^VALM1,"@"),?(IOM-10),"Page: ",PAGE
- W !,"Inclusion Dates: ",$P($$FMTE^XLFDT(DGBTBEG,1),"@")," to ",$P($$FMTE^XLFDT(DGBTEND,1),"@")
- W !,"For ACCOUNT TYPE: ",$S(CURACT=4:"ALL OTHER",CURACT=5:"C&P EXAMINATIONS")
- W !!?61,"Mileage",?70,"Amount",?78,"Amount"
- W !,"Patient Name",?23,"Patient ID",?37,"Claim DATE/TME",?61,"Amount",?70,"Deduct",?78,"Payable",?86,"Remarks"
- W !,"----------------",?23,"------------",?37,"------------------",?61,"------",?70,"------",?78,"-------",?86,"-----------------"
- HEADRQ Q (QFLAG)
- ;
- TOTL ;
- D SUBS
- W !!?61,"------",?70,"------",?78,"-------"
- W !,"TOTALS",?61,$FN(TMILES,"",2),?70,$FN(TDEDCT,"",2),?78,$FN(TPAY,"",2)
- W !,"TOTAL CLAIMS: ",TCOUNT
- Q
- ;
- SUBS ;
- N Y
- W !!?61,"------",?70,"------",?78,"-------"
- W !,"Subtotals",?61,$FN(MILES,"",2),?70,$FN(DEDCT,"",2),?78,$FN(PAY,"",2)
- W !,"Subtotal Count of Claims: ",COUNT
- S TCOUNT=TCOUNT+COUNT,TMILES=TMILES+MILES,TDEDCT=TDEDCT+DEDCT,TPAY=TPAY+PAY
- S (MILES,DEDCT,PAY,COUNT)=0
- Q
- ;
- SETVAR() ;
- N Y S Y=0
- S (PAGE,COUNT,MILES,DEDCT,PAY,TCOUNT,TPAY,TDEDCT,TMILES,BTFIN)=0
- S PDIV=""
- ;
- Q (Y)
- DGBTOA6 ;ALB/SCK - DGBT BENE TRAVEL PAYABLE CLAIMS REPORT ; 6/29/93 7/16/93
- +1 ;;5.3;Registration;**13,51,1015**;Aug 13, 1993;Build 21
- ACCTS ;
- +1 USE IO
- +2 NEW Y
- +3 KILL ^TMP("BT",$JOB)
- +4 FOR ACTCDE=4,5
- Begin DoDot:1
- +5 SET Y=$$GETACT(ACTCDE)
- End DoDot:1
- +6 DO KVAR^VADPT
- +7 DO REPORT
- +8 KILL DGBTBEG,DGBTBG,DGBTEND,CDATE,CURACT,ACTCDE,DIV,ERR,^TMP("BT",$JOB)
- ACCTSQ QUIT
- +1 ;
- GETACT(ACTNUM) ;
- +1 NEW Y
- SET Y=1
- +2 SET CDATE=DGBTBG
- FOR
- SET CDATE=$ORDER(^DGBT(392,"ACTP",ACTNUM,CDATE))
- IF 'CDATE!(CDATE>DGBTEND)
- QUIT
- Begin DoDot:1
- +3 NEW BTCLAIM
- +4 IF '$DATA(^DGBT(392,CDATE,0))
- QUIT
- +5 SET BTCLAIM=^DGBT(392,CDATE,0)
- +6 ; reference node "M" of bene travel claim file (#392)
- SET BTCLAIM("M")=$GET(^DGBT(392,CDATE,"M"))
- +7 ; reference node "R" of bene travel claim file ( #392)
- SET BTCLAIM("R")=$GET(^DGBT(392,CDATE,"R"))
- +8 SET DIV=$PIECE($GET(BTCLAIM),U,11)
- +9 SET DFN=$PIECE($GET(BTCLAIM),U,2)
- +10 DO PID^VADPT6
- IF VAERR
- QUIT
- +11 SET ^TMP("BT",$JOB,ACTNUM,DIV,$PIECE($GET(^DPT(DFN,0)),U),VA("PID"),CDATE)=$PIECE(BTCLAIM("M"),U,3)_"^"_$PIECE(BTCLAIM,U,9)_"^"_$PIECE(BTCLAIM,U,10)_"^"_$PIECE(BTCLAIM("R"),U)
- End DoDot:1
- +12 QUIT (Y)
- +13 ;
- REPORT ;
- +1 NEW BTFIN,PDIV,NDIV
- +2 IF '$DATA(^TMP("BT",$JOB))
- DO NOREP
- QUIT
- +3 SET ERR=$$SETVAR()
- +4 SET CURACT=""
- SET CURACT=$ORDER(^TMP("BT",$JOB,CURACT))
- SET PRVACT=CURACT
- +5 IF $$HEADR()
- QUIT
- +6 SET CURACT=""
- FOR
- SET CURACT=$ORDER(^TMP("BT",$JOB,CURACT))
- IF CURACT=""
- QUIT
- Begin DoDot:1
- +7 IF CURACT'=PRVACT
- DO SUBS
- SET BTFIN=$$HEADR
- SET PRVACT=CURACT
- IF PDIV]""
- SET ERR=$$DIVSN(NDIV)
- +8 SET NDIV=""
- FOR
- SET NDIV=$ORDER(^TMP("BT",$JOB,CURACT,NDIV))
- IF NDIV']""
- QUIT
- IF PDIV'=NDIV
- SET PDIV=$$DIVSN(NDIV)
- Begin DoDot:2
- +9 SET CURNAME=""
- FOR
- SET CURNAME=$ORDER(^TMP("BT",$JOB,CURACT,NDIV,CURNAME))
- IF CURNAME=""
- QUIT
- Begin DoDot:3
- +10 SET CURID=""
- FOR
- SET CURID=$ORDER(^TMP("BT",$JOB,CURACT,NDIV,CURNAME,CURID))
- IF CURID=""
- QUIT
- Begin DoDot:4
- +11 SET CDATE=""
- FOR
- SET CDATE=$ORDER(^TMP("BT",$JOB,CURACT,NDIV,CURNAME,CURID,CDATE))
- IF CDATE=""
- QUIT
- SET BTFIN=$$PRTOUT()
- IF BTFIN
- QUIT
- End DoDot:4
- IF BTFIN
- QUIT
- End DoDot:3
- IF BTFIN
- QUIT
- End DoDot:2
- IF BTFIN
- QUIT
- End DoDot:1
- IF BTFIN
- QUIT
- +12 DO TOTL
- +13 QUIT
- +14 ;
- PRTOUT() ;
- +1 NEW Y
- +2 SET BTCLAIM=^TMP("BT",$JOB,CURACT,NDIV,CURNAME,CURID,CDATE)
- +3 IF $Y+5>IOSL
- SET Y=$$HEADR()
- IF Y
- GOTO PRTOUTQ
- +4 WRITE !,$EXTRACT(CURNAME,1,21),?23,CURID,?37,$$EXDATE(CDATE),?61,$FNUMBER($PIECE(BTCLAIM,U,1),"",2),?70,$FNUMBER($PIECE(BTCLAIM,U,2),"",2),?78,$FNUMBER($PIECE(BTCLAIM,U,3),"",2),?86,$EXTRACT($PIECE(BTCLAIM,U,4),1,50)
- +5 SET COUNT=COUNT+1
- SET MILES=MILES+$PIECE(BTCLAIM,U,1)
- SET DEDCT=DEDCT+$PIECE(BTCLAIM,U,2)
- SET PAY=PAY+$PIECE(BTCLAIM,U,3)
- PRTOUTQ QUIT (Y)
- +1 ;
- EXDATE(CDOUT) ;
- +1 SET Y=CDOUT
- DO DD^%DT
- +2 QUIT (Y)
- +3 ;
- DIVSN(NDIV) ;
- +1 IF $GET(NDIV)]""
- Begin DoDot:1
- +2 WRITE !!,"Division: ",$PIECE($GET(^DG(40.8,NDIV,0)),"^")
- +3 WRITE !,"========="
- End DoDot:1
- +4 QUIT (NDIV)
- +5 ;
- NOREP ;
- +1 SET CURACT=4
- SET PAGE=0
- +2 IF $$HEADR()
- GOTO NOREPQ
- +3 WRITE !!,"No data found for accounts 'ALL OTHER' or 'C&P'"
- NOREPQ QUIT
- +1 ;
- HEADR() ;
- +1 NEW QFLAG
- SET QFLAG=0
- +2 IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- SET QFLAG='Y
- IF QFLAG
- GOTO HEADRQ
- WRITE @IOF
- +3 SET PAGE=PAGE+1
- +4 IF $EXTRACT(IOST,1,2)'="C-"
- WRITE @IOF
- +5 WRITE !,"Payable Claims Report"
- +6 WRITE ?(IOM-40),"Report Date: ",$PIECE($$NOW^VALM1,"@"),?(IOM-10),"Page: ",PAGE
- +7 WRITE !,"Inclusion Dates: ",$PIECE($$FMTE^XLFDT(DGBTBEG,1),"@")," to ",$PIECE($$FMTE^XLFDT(DGBTEND,1),"@")
- +8 WRITE !,"For ACCOUNT TYPE: ",$SELECT(CURACT=4:"ALL OTHER",CURACT=5:"C&P EXAMINATIONS")
- +9 WRITE !!?61,"Mileage",?70,"Amount",?78,"Amount"
- +10 WRITE !,"Patient Name",?23,"Patient ID",?37,"Claim DATE/TME",?61,"Amount",?70,"Deduct",?78,"Payable",?86,"Remarks"
- +11 WRITE !,"----------------",?23,"------------",?37,"------------------",?61,"------",?70,"------",?78,"-------",?86,"-----------------"
- HEADRQ QUIT (QFLAG)
- +1 ;
- TOTL ;
- +1 DO SUBS
- +2 WRITE !!?61,"------",?70,"------",?78,"-------"
- +3 WRITE !,"TOTALS",?61,$FNUMBER(TMILES,"",2),?70,$FNUMBER(TDEDCT,"",2),?78,$FNUMBER(TPAY,"",2)
- +4 WRITE !,"TOTAL CLAIMS: ",TCOUNT
- +5 QUIT
- +6 ;
- SUBS ;
- +1 NEW Y
- +2 WRITE !!?61,"------",?70,"------",?78,"-------"
- +3 WRITE !,"Subtotals",?61,$FNUMBER(MILES,"",2),?70,$FNUMBER(DEDCT,"",2),?78,$FNUMBER(PAY,"",2)
- +4 WRITE !,"Subtotal Count of Claims: ",COUNT
- +5 SET TCOUNT=TCOUNT+COUNT
- SET TMILES=TMILES+MILES
- SET TDEDCT=TDEDCT+DEDCT
- SET TPAY=TPAY+PAY
- +6 SET (MILES,DEDCT,PAY,COUNT)=0
- +7 QUIT
- +8 ;
- SETVAR() ;
- +1 NEW Y
- SET Y=0
- +2 SET (PAGE,COUNT,MILES,DEDCT,PAY,TCOUNT,TPAY,TDEDCT,TMILES,BTFIN)=0
- +3 SET PDIV=""
- +4 ;
- +5 QUIT (Y)
