source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTC1.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1IBAMTC1 ;ALB/CPM - MEANS TEST NIGHTLY COMPILATION REPORT ; 14-NOV-91
2 ;;2.0;INTEGRATED BILLING;**153**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 I '$D(IOF)!('$D(IOM))!('$D(IOSL)) Q
6 ;
7 ; Initialize control variables.
8 S %H=+$H-1 D YMD^%DTC S Y=X D DD^%DT S IBYEST=Y
9 D NOW^%DTC S Y=% D DD^%DT S IBNOW=Y
10 S IBPAG=0,IBLINE="",$P(IBLINE,"-",IOM)=""
11 ; - print all reports.
12 D ERROR,INPT
13 ; - kill variables and quit.
14 K ^TMP($J,"IBAMTC"),IBCHK,IBI,IBID,IBRPT,IBNOW,IBYEST,IBPAG,IBLINE Q
15 ;
16 ;
17ERROR ; Print the Error Report.
18 S IBRPT="Error Report" D HDR
19 I '$D(^TMP($J,"IBAMTC","E")) W !!,"No errors encountered during this compilation." Q
20 ;
21 S IBI="" F S IBI=$O(^TMP($J,"IBAMTC","E",IBI)) Q:'IBI S IBID=^(IBI) D
22 . I $Y>(IOSL-5) D HDR
23 . S IBDA=$O(^IBE(350.8,"AC",$S($P(IBID,"^")]"":$P(IBID,"^"),1:0),0))
24 . W !!,"Error: ",$S($D(^IBE(350.8,+IBDA,0)):$P(^(0),"^",2),$P(IBID,"^")]"":$P(IBID,"^"),1:"Unknown Error")
25 . W !,"Patient: ",$S($D(^DPT(+$P(IBID,"^",2),0)):$P(^(0),"^"),1:"No patient involved")
26 . I $P(IBID,"^",3) W !,$P($T(TEXT+$P(IBID,"^",3)^IBAMTEL),";;",2,99)
27 Q
28 ;
29INPT ; Print the Inpatient Report.
30 S IBRPT="Inpatient Billing Report" D HDR
31 I '$D(^TMP($J,"IBAMTC","I")) W !!,"No Inpatient charges billed or updated during this compilation." Q
32 ;
33 S (DFN,IBI)="" F S DFN=$O(^TMP($J,"IBAMTC","I",DFN)) Q:'DFN D
34 . S IBCHK=1 F S IBI=$O(^TMP($J,"IBAMTC","I",DFN,IBI)) Q:'IBI D
35 .. I $Y>(IOSL-2) D HDR
36 .. S IBID=$G(^IB(+IBI,0)) W !
37 .. 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
38 .. W ?35,$S($D(^IBE(350.1,+$P(IBID,"^",3),0)):$P($P(^(0),"^")," ",2,99),1:"Unknown")
39 .. W ?66,$$DAT1^IBOUTL($P(IBID,"^",14)),?80,$$DAT1^IBOUTL($P(IBID,"^",15))
40 .. W ?92,$J($P(IBID,"^",6),3)
41 .. W ?100,$S($P(IBID,"^",5)=10:$J("($"_$P(IBID,"^",7)_")",10),1:$J("$"_$P(IBID,"^",7),8))
42 .. W ?114,$P("INCOMPLETE^PENDING AR^BILLED^UPDATED^^^^ON HOLD^ERROR ENCOUNTERED^CANCELLED","^",$P(IBID,"^",5))
43 Q
44 ;
45HDR S IBPAG=IBPAG+1
46 W @IOF,"Means Test Charge Compilation through ",IBYEST,?(IOM-31),IBNOW," Page: ",IBPAG
47 W !,IBRPT
48 I $E(IBRPT)="E" W !,IBLINE Q
49 W !,"PATIENT",?28,"SSN",?35,"CHARGE DESCRIPTION",?66,"BILL FROM BILL TO UNITS TOT CHG STATUS",!,IBLINE,!
50 Q
51 ;
52 ;
53BULL ; Send the Nightly Compilation Job Completion bulletin.
54 S XMSUB="MEANS TEST NIGHTLY COMPILATION JOB COMPLETION"
55 S %H=+$H-1 D YMD^%DTC S Y=X D DD^%DT S IBYEST=Y
56 K IBT S IBDUZ=DUZ
57 S IBT(1)="The Means Test Nightly Compilation Job has compiled charges for patients"
58 S IBT(2)="through "_IBYEST_"."
59 S IBT(3)=" "
60 D NOW^%DTC S IBDATE=%,IBT(4)="The job was completed on "_$P($$DAT2^IBOUTL(IBDATE),"@")_" at "_$P($$DAT2^IBOUTL(IBDATE),"@",2)_"."
61 S IBT(5)=" "
62 S IBT(6)="There "_$S(IBCNT=1:"was ",1:"were ")_$S(IBCNT:IBCNT,1:"no")_" error"_$S(IBCNT=1:"",1:"s")_" encountered."
63 I IBCNT S IBT(7)="(Separate bulletin"_$E("s",IBCNT>1)_$S(IBCNT=1:" has",1:" have")_" been sent.)"
64 D MAIL^IBAERR1 ; find recipients and send bulletin
65 K IBDATE,IBDUZ,IBT,IBYEST,XMDUZ,XMSUB,XMTEXT,XMY
66 Q
Note: See TracBrowser for help on using the repository browser.