IBAMTC1 ;ALB/CPM - MEANS TEST NIGHTLY COMPILATION REPORT ; 14-NOV-91
;;2.0;INTEGRATED BILLING;**153**;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 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTC1 3149 printed Apr 09, 2024@21:22:07 Page 2
IBAMTC1 ;ALB/CPM - MEANS TEST NIGHTLY COMPILATION REPORT ; 14-NOV-91
+1 ;;2.0;INTEGRATED BILLING;**153**;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 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
