source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBFPAR.m@ 975

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1FBFPAR ;WOIFO/SAB-FPPS AUDIT REPORT ;7/18/2003
2 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
3 ;
4 ; ask if BY INVOICE or BY DATE RANGE
5 S DIR(0)="S^I:Invoice;D:Date Range"
6 S DIR("A")="Report one invoice or report by Date Range"
7 S DIR("B")="Date Range"
8 S DIR("?",1)="Enter I to print the audit data for one invoice."
9 S DIR("?",2)="Enter D to print all audit data for a date range."
10 S DIR("?")="Enter a code from the list."
11 D ^DIR K DIR G:$D(DIRUT) EXIT
12 S FBRANGE=$S(Y="D":1,1:0)
13 ;
14 I FBRANGE D G:$D(DIRUT) EXIT
15 . ; ask dates
16 . S DIR(0)="D^::EX",DIR("A")="From Date"
17 . ; default from date is first day of current month
18 . S DIR("B")=$$FMTE^XLFDT($E(DT,1,5)_"01")
19 . D ^DIR K DIR Q:$D(DIRUT)
20 . S FBDT1=Y
21 . S DIR(0)="DA^"_FBDT1_"::EX",DIR("A")="To Date: "
22 . ; default to date is last day of specified month
23 . S X=FBDT1 D DAYS^FBAAUTL1
24 . S DIR("B")=$$FMTE^XLFDT($E(FBDT1,1,5)_X)
25 . D ^DIR K DIR Q:$D(DIRUT)
26 . S FBDT2=Y
27 ;
28 ; If not date range then ask invoice
29 I 'FBRANGE D G:$D(DIRUT) EXIT
30 . S DIR(0)="N",DIR("A")="Invoice Number: "
31 . D ^DIR K DIR Q:$D(DIRUT)
32 . S FBAAIN=Y
33 ;
34 ; ask device
35 S %ZIS="QM" D ^%ZIS G:POP EXIT
36 I $D(IO("Q")) D G EXIT
37 . S ZTRTN="QEN^FBFPAR",ZTDESC="FPPS Audit Report"
38 . F FBX="FBAAIN","FBDT*","FBRANGE" S ZTSAVE(FBX)=""
39 . D ^%ZTLOAD,HOME^%ZIS K ZTSK
40 ;
41QEN ; queued entry
42 U IO
43 ;
44GATHER ; collect and sort data
45 S FBQUIT=0
46 ;
47PRINT ; report data
48 S FBPG=0 D NOW^%DTC S Y=% D DD^%DT S FBDTR=Y
49 K FBDL S FBDL="",$P(FBDL,"-",IOM)=""
50 ;
51 ; build page header text for selection criteria
52 S:FBRANGE FBHDT(1)=" For "_$$FMTE^XLFDT(FBDT1)_" through "_$$FMTE^XLFDT(FBDT2)
53 ;
54 D HD
55 ;
56 ; Initialize Counter
57 S FBC=0
58 ;
59 ; if by date range
60 I FBRANGE D
61 . S FBDT=FBDT1-.0000001
62 . F S FBDT=$O(^FB(163.7,"C",FBDT)) Q:'FBDT!(FBDT>(FBDT2_".999999")) D Q:FBQUIT
63 . . S FBDA=0 F S FBDA=$O(^FB(163.7,"C",FBDT,FBDA)) Q:'FBDA D Q:FBQUIT
64 . . . D PRINT1
65 ;
66 ; if by invoice
67 I 'FBRANGE D
68 . S FBDA=0 F S FBDA=$O(^FB(163.7,"B",FBAAIN,FBDA)) Q:'FBDA D Q:FBQUIT
69 . . D PRINT1
70 ;
71 I FBC=0 W !,"no Audit entries found."
72 ;
73 I FBQUIT W !!,"REPORT STOPPED AT USER REQUEST"
74 ;
75 I 'FBQUIT,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
76 D ^%ZISC
77 ;
78EXIT ;
79 I $D(ZTQUEUED) S ZTREQ="@"
80 K FBAAIN,FBC,FBDT,FBDT1,FBDT2,FBDTR,FBHDT,FBIENS,FBRANGE,FBPG,FBQUIT,FBX
81 K %,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,J,POP,X,Y
82 Q
83HD ; page header
84 N FBI
85 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
86 I $E(IOST,1,2)="C-",FBPG S DIR(0)="E" D ^DIR K DIR I 'Y S FBQUIT=1 Q
87 I $E(IOST,1,2)="C-"!FBPG W @IOF
88 S FBPG=FBPG+1
89 W !,"FPPS Data Audit Report "
90 I FBRANGE W "by Date Range"
91 E W "for Invoice: ",FBAAIN
92 W ?49,FBDTR,?72,"page ",FBPG
93 S FBI=0 F S FBI=$O(FBHDT(FBI)) Q:'FBI W !,FBHDT(FBI)
94 W !!,"Date/Time Changed",?19,"File",?27,"IENS",?58,"User"
95 W !,FBDL
96 Q
97 ;
98PRINT1 ; Print one audit record (FBDA)
99 N FB,FBADT
100 S FBC=FBC+1
101 I $Y+9>IOSL D HD Q:FBQUIT
102 W !
103 ;
104 S FBIENS=FBDA_","
105 D GETS^DIQ(163.7,FBIENS,"*","","FB")
106 S FBADT=$$FMTE^XLFDT($$GET1^DIQ(163.7,FBIENS,1,"I"),"2F")
107 W !,FBADT,?19,FB(163.7,FBIENS,2),?27,FB(163.7,FBIENS,3)
108 W ?58,$E(FB(163.7,FBIENS,7),1,20)
109 W !?4,"Field: "
110 W $$GET1^DID(FB(163.7,FBIENS,2),FB(163.7,FBIENS,4),"","LABEL")
111 W ?27,"Old Field Value: ",FB(163.7,FBIENS,5)
112 W !
113 I FBRANGE W ?4,"Invoice: ",FB(163.7,FBIENS,.01)
114 W ?27,"New Field Value: ",FB(163.7,FBIENS,6)
115 ;
116 ; if prescription subfile then write more info to identify
117 I FB(163.7,FBIENS,2)="162.11" D
118 . W !,?4,"Prescription: "
119 . W $$GET1^DIQ(162.11,FB(163.7,FBIENS,3),.01)
120 ;
121 ; if service provided subfile then write more info to identify
122 I FB(163.7,FBIENS,2)="162.03" D
123 . N FBDA
124 . D DA^DILF(FB(163.7,FBIENS,3),.FBDA)
125 . W !,?4,"Patient: "
126 . W $$GET1^DIQ(162,FBDA(3)_",",.01)
127 . W ?40,"Vendor: "
128 . W $E($$GET1^DIQ(162.01,FBDA(2)_","_FBDA(3)_",",.01),1,30)
129 . W !,?4,"Date of Service: "
130 . W $$GET1^DIQ(162.02,FBDA(1)_","_FBDA(2)_","_FBDA(3)_",",.01)
131 . W ?36,"Service Provided: "
132 . W $$GET1^DIQ(162.03,FB(163.7,FBIENS,3),.01)
133 Q
134 ;
135 ;FBFPAR
Note: See TracBrowser for help on using the repository browser.