- IBAMTC1 ;ALB/CPM - MEANS TEST NIGHTLY COMPILATION REPORT ; 14-NOV-91
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- I '$D(IOF)!('$D(IOM))!('$D(IOSL)) Q
- ;
- ; Initialize control variables.
- S %H=+$H-1 D YMD^%DTC S Y=X D DD^%DT S IBYEST=Y
- D NOW^%DTC S Y=% D DD^%DT S IBNOW=Y
- S IBPAG=0,IBLINE="",$P(IBLINE,"-",IOM)=""
- ; - print all reports.
- D ERROR,INPT
- ; - kill variables and quit.
- K ^TMP($J,"IBAMTC"),IBCHK,IBI,IBID,IBRPT,IBNOW,IBYEST,IBPAG,IBLINE Q
- ;
- ;
- ERROR ; Print the Error Report.
- S IBRPT="Error Report" D HDR
- I '$D(^TMP($J,"IBAMTC","E")) W !!,"No errors encountered during this compilation." Q
- ;
- S IBI="" F S IBI=$O(^TMP($J,"IBAMTC","E",IBI)) Q:'IBI S IBID=^(IBI) D
- . I $Y>(IOSL-5) D HDR
- . S IBDA=$O(^IBE(350.8,"AC",$S($P(IBID,"^")]"":$P(IBID,"^"),1:0),0))
- . W !!,"Error: ",$S($D(^IBE(350.8,+IBDA,0)):$P(^(0),"^",2),$P(IBID,"^")]"":$P(IBID,"^"),1:"Unknown Error")
- . W !,"Patient: ",$S($D(^DPT(+$P(IBID,"^",2),0)):$P(^(0),"^"),1:"No patient involved")
- . I $P(IBID,"^",3) W !,$P($T(TEXT+$P(IBID,"^",3)^IBAMTEL),";;",2,99)
- Q
- ;
- INPT ; Print the Inpatient Report.
- S IBRPT="Inpatient Billing Report" D HDR
- I '$D(^TMP($J,"IBAMTC","I")) W !!,"No Inpatient charges billed or updated during this compilation." Q
- ;
- S (DFN,IBI)="" F S DFN=$O(^TMP($J,"IBAMTC","I",DFN)) Q:'DFN D
- . S IBCHK=1 F S IBI=$O(^TMP($J,"IBAMTC","I",DFN,IBI)) Q:'IBI D
- .. I $Y>(IOSL-2) D HDR
- .. S IBID=$G(^IB(+IBI,0)) W !
- .. I IBCHK W $E($P($G(^DPT(+$P(IBID,"^",2),0)),"^"),1,24),?27,$E($P($G(^DPT(+$P(IBID,"^",2),0)),"^",9),6,9) S IBCHK=0
- .. W ?35,$S($D(^IBE(350.1,+$P(IBID,"^",3),0)):$P($P(^(0),"^")," ",2,99),1:"Unknown")
- .. W ?66,$$DAT1^IBOUTL($P(IBID,"^",14)),?80,$$DAT1^IBOUTL($P(IBID,"^",15))
- .. W ?92,$J($P(IBID,"^",6),3)
- .. W ?100,$S($P(IBID,"^",5)=10:$J("($"_$P(IBID,"^",7)_")",10),1:$J("$"_$P(IBID,"^",7),8))
- .. W ?114,$P("INCOMPLETE^PENDING AR^BILLED^UPDATED^^^^ON HOLD^ERROR ENCOUNTERED^CANCELLED","^",$P(IBID,"^",5))
- Q
- ;
- HDR S IBPAG=IBPAG+1
- W @IOF,"Means Test/Category C Charge Compilation through ",IBYEST,?(IOM-31),IBNOW," Page: ",IBPAG
- W !,IBRPT
- I $E(IBRPT)="E" W !,IBLINE Q
- W !,"PATIENT",?28,"SSN",?35,"CHARGE DESCRIPTION",?66,"BILL FROM BILL TO UNITS TOT CHG STATUS",!,IBLINE,!
- Q
- ;
- ;
- BULL ; Send the Nightly Compilation Job Completion bulletin.
- S XMSUB="MEANS TEST NIGHTLY COMPILATION JOB COMPLETION"
- S %H=+$H-1 D YMD^%DTC S Y=X D DD^%DT S IBYEST=Y
- K IBT S IBDUZ=DUZ
- S IBT(1)="The Means Test Nightly Compilation Job has compiled charges for patients"
- S IBT(2)="through "_IBYEST_"."
- S IBT(3)=" "
- D NOW^%DTC S IBDATE=%,IBT(4)="The job was completed on "_$P($$DAT2^IBOUTL(IBDATE),"@")_" at "_$P($$DAT2^IBOUTL(IBDATE),"@",2)_"."
- S IBT(5)=" "
- S IBT(6)="There "_$S(IBCNT=1:"was ",1:"were ")_$S(IBCNT:IBCNT,1:"no")_" error"_$S(IBCNT=1:"",1:"s")_" encountered."
- I IBCNT S IBT(7)="(Separate bulletin"_$E("s",IBCNT>1)_$S(IBCNT=1:" has",1:" have")_" been sent.)"
- D MAIL^IBAERR1 ; find recipients and send bulletin
- K IBDATE,IBDUZ,IBT,IBYEST,XMDUZ,XMSUB,XMTEXT,XMY
- Q
- IBAMTC1 ;ALB/CPM - MEANS TEST NIGHTLY COMPILATION REPORT ; 14-NOV-91
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 IF '$DATA(IOF)!('$DATA(IOM))!('$DATA(IOSL))
- QUIT
- +5 ;
- +6 ; Initialize control variables.
- +7 SET %H=+$HOROLOG-1
- DO YMD^%DTC
- SET Y=X
- DO DD^%DT
- SET IBYEST=Y
- +8 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET IBNOW=Y
- +9 SET IBPAG=0
- SET IBLINE=""
- SET $PIECE(IBLINE,"-",IOM)=""
- +10 ; - print all reports.
- +11 DO ERROR
- DO INPT
- +12 ; - kill variables and quit.
- +13 KILL ^TMP($JOB,"IBAMTC"),IBCHK,IBI,IBID,IBRPT,IBNOW,IBYEST,IBPAG,IBLINE
- QUIT
- +14 ;
- +15 ;
- ERROR ; Print the Error Report.
- +1 SET IBRPT="Error Report"
- DO HDR
- +2 IF '$DATA(^TMP($JOB,"IBAMTC","E"))
- WRITE !!,"No errors encountered during this compilation."
- QUIT
- +3 ;
- +4 SET IBI=""
- FOR
- SET IBI=$ORDER(^TMP($JOB,"IBAMTC","E",IBI))
- IF 'IBI
- QUIT
- SET IBID=^(IBI)
- Begin DoDot:1
- +5 IF $Y>(IOSL-5)
- DO HDR
- +6 SET IBDA=$ORDER(^IBE(350.8,"AC",$SELECT($PIECE(IBID,"^")]"":$PIECE(IBID,"^"),1:0),0))
- +7 WRITE !!,"Error: ",$SELECT($DATA(^IBE(350.8,+IBDA,0)):$PIECE(^(0),"^",2),$PIECE(IBID,"^")]"":$PIECE(IBID,"^"),1:"Unknown Error")
- +8 WRITE !,"Patient: ",$SELECT($DATA(^DPT(+$PIECE(IBID,"^",2),0)):$PIECE(^(0),"^"),1:"No patient involved")
- +9 IF $PIECE(IBID,"^",3)
- WRITE !,$PIECE($TEXT(TEXT+$PIECE(IBID,"^",3)^IBAMTEL),";;",2,99)
- End DoDot:1
- +10 QUIT
- +11 ;
- INPT ; Print the Inpatient Report.
- +1 SET IBRPT="Inpatient Billing Report"
- DO HDR
- +2 IF '$DATA(^TMP($JOB,"IBAMTC","I"))
- WRITE !!,"No Inpatient charges billed or updated during this compilation."
- QUIT
- +3 ;
- +4 SET (DFN,IBI)=""
- FOR
- SET DFN=$ORDER(^TMP($JOB,"IBAMTC","I",DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +5 SET IBCHK=1
- FOR
- SET IBI=$ORDER(^TMP($JOB,"IBAMTC","I",DFN,IBI))
- IF 'IBI
- QUIT
- Begin DoDot:2
- +6 IF $Y>(IOSL-2)
- DO HDR
- +7 SET IBID=$GET(^IB(+IBI,0))
- WRITE !
- +8 IF IBCHK
- WRITE $EXTRACT($PIECE($GET(^DPT(+$PIECE(IBID,"^",2),0)),"^"),1,24),?27,$EXTRACT($PIECE($GET(^DPT(+$PIECE(IBID,"^",2),0)),"^",9),6,9)
- SET IBCHK=0
- +9 WRITE ?35,$SELECT($DATA(^IBE(350.1,+$PIECE(IBID,"^",3),0)):$PIECE($PIECE(^(0),"^")," ",2,99),1:"Unknown")
- +10 WRITE ?66,$$DAT1^IBOUTL($PIECE(IBID,"^",14)),?80,$$DAT1^IBOUTL($PIECE(IBID,"^",15))
- +11 WRITE ?92,$JUSTIFY($PIECE(IBID,"^",6),3)
- +12 WRITE ?100,$SELECT($PIECE(IBID,"^",5)=10:$JUSTIFY("($"_$PIECE(IBID,"^",7)_")",10),1:$JUSTIFY("$"_$PIECE(IBID,"^",7),8))
- +13 WRITE ?114,$PIECE("INCOMPLETE^PENDING AR^BILLED^UPDATED^^^^ON HOLD^ERROR ENCOUNTERED^CANCELLED","^",$PIECE(IBID,"^",5))
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- HDR SET IBPAG=IBPAG+1
- +1 WRITE @IOF,"Means Test/Category C Charge Compilation through ",IBYEST,?(IOM-31),IBNOW," Page: ",IBPAG
- +2 WRITE !,IBRPT
- +3 IF $EXTRACT(IBRPT)="E"
- WRITE !,IBLINE
- QUIT
- +4 WRITE !,"PATIENT",?28,"SSN",?35,"CHARGE DESCRIPTION",?66,"BILL FROM BILL TO UNITS TOT CHG STATUS",!,IBLINE,!
- +5 QUIT
- +6 ;
- +7 ;
- BULL ; Send the Nightly Compilation Job Completion bulletin.
- +1 SET XMSUB="MEANS TEST NIGHTLY COMPILATION JOB COMPLETION"
- +2 SET %H=+$HOROLOG-1
- DO YMD^%DTC
- SET Y=X
- DO DD^%DT
- SET IBYEST=Y
- +3 KILL IBT
- SET IBDUZ=DUZ
- +4 SET IBT(1)="The Means Test Nightly Compilation Job has compiled charges for patients"
- +5 SET IBT(2)="through "_IBYEST_"."
- +6 SET IBT(3)=" "
- +7 DO NOW^%DTC
- SET IBDATE=%
- SET IBT(4)="The job was completed on "_$PIECE($$DAT2^IBOUTL(IBDATE),"@")_" at "_$PIECE($$DAT2^IBOUTL(IBDATE),"@",2)_"."
- +8 SET IBT(5)=" "
- +9 SET IBT(6)="There "_$SELECT(IBCNT=1:"was ",1:"were ")_$SELECT(IBCNT:IBCNT,1:"no")_" error"_$SELECT(IBCNT=1:"",1:"s")_" encountered."
- +10 IF IBCNT
- SET IBT(7)="(Separate bulletin"_$EXTRACT("s",IBCNT>1)_$SELECT(IBCNT=1:" has",1:" have")_" been sent.)"
- +11 ; find recipients and send bulletin
- DO MAIL^IBAERR1
- +12 KILL IBDATE,IBDUZ,IBT,IBYEST,XMDUZ,XMSUB,XMTEXT,XMY
- +13 QUIT
