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

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1IBCNRRP1 ;BHAM ISC/CMW - Group Plan Worksheet Report ;03-MAR-2004
2 ;;2.0;INTEGRATED BILLING;**251,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; e-Pharmacy Group Plan Worksheet Report
6 ;
7 ; Input parameter: N/A
8 ; Other relevant variables:
9 ; IBCNRRTN = "IBCNRRP1" (current routine name for queuing the
10 ; COMPILE process)
11 ; IBCNRSPC("BEGDT") = start date for date range
12 ; IBCNRSPC("ENDDT") = end date for date range
13 ; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims;
14 ; 3 - Total Charges; 4 - BIN/PCN Exceptions
15 ; IBCNRSPC("MATCH")= 1 - Matched only; 0 - All
16 ;
17 ; Enter only from EN tag ONLY
18 Q
19 ;
20 ; Entry point
21EN ;
22 ; Initialize variables
23 N STOP,IBCNRRTN,IBCNRSPC,RESORT
24 D:'$D(IOF) HOME^%ZIS
25 ;
26 S STOP=0,IBPXT=$G(IBPXT)
27 S IBCNRRTN="IBCNRRP1"
28 W @IOF
29 W !,"ePHARM GROUP PLAN WORKSHEET REPORT",!
30 W !,"NCPDP process requires that the users match Group Plans to Pharmacy Plans."
31 W !,"This report will assist users in matching Group Insurance Plans to Pharmacy"
32 W !," Plans by searching through Billing/Claims file for authorized claims that "
33 W !," have Group Plans with active Pharmacy Plan coverage."
34 ;
35 ; Prompts
36 ; lock global
37 L +^XTMP(IBCNRRTN):5 I '$T W !!,"Sorry, Worksheet Report in use." H 2 G EXIT
38 ;Check for prior compile
39P10 D RESORT(.RESORT) I STOP G EXIT
40 I $G(RESORT) G P40
41 K ^XTMP(IBCNRRTN)
42 ; Date Range parameters
43P30 D DTRANGE I STOP G:$$STOP EXIT G P10
44 ; Sort parameters
45P40 D SORT I STOP G:$$STOP EXIT G P30
46 ; Select the output device
47P100 D DEVICE(IBCNRRTN,.IBCNRSPC) I STOP!IBPXT G:$$STOP EXIT G P40
48 ;
49EXIT ; Quit this routine
50 ; unlock global
51 L -^XTMP(IBCNRRTN)
52 K IBPXT
53 Q
54 ;
55RESORT(RESORT) ; check for prior compile
56 NEW DIR,BDT,EDT,RDT,HDR,IBDT,X,Y,DIRUT
57 I '$D(^XTMP(IBCNRRTN)) Q
58 S IBDT=$G(^XTMP(IBCNRRTN,0,0))
59 S BDT=$P(IBDT,U,1),EDT=$P(IBDT,U,2),RDT=$P(IBDT,U,3),RESORT=0
60 S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
61 W !!,"A Report file run on: ",RDT,!,?5," exist for date range: ",HDR,!
62 S DIR(0)="Y"
63 S DIR("A")="Do you want to use the existing report file"
64 S DIR("B")="YES"
65 S DIR("?",1)=" Enter YES to use the existing report file."
66 S DIR("?")=" Enter NO to DELETE existing file and recompile,"
67 D ^DIR K DIR
68 I $D(DIRUT) S STOP=1 G RESRTX
69 S RESORT=Y
70 S IBCNRSPC("RESORT")=Y
71 S IBCNRSPC("BEGDT")=BDT
72 S IBCNRSPC("ENDDT")=EDT
73 ;
74RESRTX ;RESORT EXIT
75 Q
76 ;
77COMPILE(IBCNRRTN,IBCNRSPC) ;
78 ; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
79 ; Input params:
80 ; IBCNRRTN = Routine name for ^TMP(...
81 ; IBCNRSPC = Array passed by ref of the report params
82 ;
83 ; Init scratch globals
84 I '$G(IBCNRSPC("RESORT")) D
85 . ; Compile
86 . I IBCNRRTN="IBCNRRP1" D EN^IBCNRRP2(IBCNRRTN,.IBCNRSPC)
87 ; Print
88 I '$G(ZTSTOP) D
89 . I IBCNRRTN="IBCNRRP1" D EN^IBCNRRP3(IBCNRRTN,.IBCNRSPC)
90 ; Close device
91 D ^%ZISC
92 ;
93 ; Purge task record
94 I $D(ZTQUEUED) S ZTREQ="@"
95 ;
96COMPILX ; COMPILE exit pt
97 Q
98 ;
99STOP() ; Determine if user wants to exit out of the whole option
100 ; Init vars
101 N DIR,X,Y,DIRUT
102 ;
103 W !
104 S DIR(0)="Y"
105 S DIR("A")="Do you want to exit out of this option entirely"
106 S DIR("B")="YES"
107 S DIR("?",1)=" Enter YES to immediately exit out of this option."
108 S DIR("?")=" Enter NO to return to the previous question."
109 D ^DIR K DIR
110 I $D(DIRUT) S (STOP,Y)=1 G STOPX
111 I 'Y S STOP=0
112 ;
113STOPX ; STOP exit pt
114 Q Y
115 ;
116DTRANGE ; Determine start and end dates for date range param
117 ; Init vars
118 N X,Y,DIRUT
119 ;
120 W !
121 ;
122 S DIR(0)="D^::EX"
123 S DIR("A")="Start DATE"
124 S DIR("?",1)=" Please enter a valid date for which an Bill/Claim"
125 S DIR("?")=" would have been authorized."
126 D ^DIR K DIR
127 I $D(DIRUT) S STOP=1 G DTRANGX
128 S IBCNRSPC("BEGDT")=Y
129 ; End date
130DTRANG1 S DIR(0)="D^::EX"
131 S DIR("A")=" End DATE"
132 S DIR("?",1)=" Please enter a valid date for which an Bill/Claim"
133 S DIR("?",2)=" would have been authorized. This date must not precede"
134 S DIR("?")=" the Start Date."
135 D ^DIR K DIR
136 I $D(DIRUT) S STOP=1 G DTRANGX
137 I Y<IBCNRSPC("BEGDT") D G DTRANG1
138 . W !," End Date must not precede the Start Date."
139 . W !," Please reenter."
140 S IBCNRSPC("ENDDT")=Y
141 ;
142DTRANGX ; DTRANGE exit pt
143 Q
144 ;
145SORT ; Prompt to allow users to sort the report
146 ; by Insurance/Group, Max claims, Max charges
147 NEW DIR,X,Y,DIRUT
148 ;
149 S DIR(0)="S^1:Insurance/Group;2:Total Claims;3:Total Charges;4:Exceptions Only"
150 S DIR("A")=" Select the primary sort field"
151 S DIR("B")=1
152 S DIR("?",1)=" 1 - Sort all Claims by Insurance/Group. (Default)"
153 S DIR("?",2)=" 2 - Sort by Groups with the most Claims"
154 S DIR("?",3)=" 3 - Sort by Groups with the most Charges"
155 S DIR("?",4)=" 4 - Show BIN/PCN Exceptions only"
156 D ^DIR K DIR
157 I $D(DIRUT) S STOP=1 G SORTX
158 S IBCNRSPC("SORT")=Y
159 ;
160 ;Prompt for All/Matched only
161 S DIR(0)="SA^A:All;M:Matched Only"
162 S DIR("A")=" List (A)LL Insurance/Groups or (M)atched Only: "
163 S DIR("B")="Matched Only"
164 W ! D ^DIR K DIR
165 I $D(DIRUT) S STOP=1 G SORTX
166 S IBCNRSPC("MATCH")=(Y="M")
167 ;
168SORTX ; SORT exit point
169 Q
170 ;
171 ;
172DEVICE(IBCNRRTN,IBCNRSPC) ; Device Handler and possible TaskManager calls
173 ;
174 ; Input params:
175 ; IBCNRRTN = Routine name for ^TMP($J,...
176 ; IBCNRSPC = Array passed by ref of the report params
177 ;
178 ; Init vars
179 N ZTRTN,ZTDESC,ZTSAVE,POP
180 ;
181 ;I IBCNRRTN="IBCNRRP1" W !!!,"*** This report is 132 characters wide ***",!
182 S ZTRTN="COMPILE^IBCNRRP1("""_IBCNRRTN_""",.IBCNRSPC)"
183 S ZTDESC="ePHARM GROUP PLAN WORKSHEET REPORT"
184 S ZTSAVE("IBCNRSPC(")=""
185 S ZTSAVE("IBCNRRTN")=""
186 D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
187 I POP S STOP=1
188 ;
189DEVICEX ; DEVICE exit pt
190 Q
191 ;
Note: See TracBrowser for help on using the repository browser.