source: FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJDF8R.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1IBJDF8R ;ALB/RRG - AR WORKLOAD ASSIGNMENTS (PRINT) ;05-FEB-01
2 ;;2.0;INTEGRATED BILLING;**123,159,192**;21-MAR-94
3 ;
4EN ; - Option entry point
5 ;
6CLK ; - Select one, more, or all clerks to print
7 W !!,"Run list for (S)pecific clerks or (A)ll clerks: ALL// "
8 R X:DTIME G:'$T!(X["^") ENQ S:X="" X="A" S X=$E(X)
9 I "SAsa"'[X S IBOFF=61 D HELP^IBJDF8H G CLK
10 W " ",$S("Ss"[X:"SPECIFIC",1:"ALL") G:"Aa"[X DEV K IBSI
11CLK1 S DIC="^IBE(351.73,",DIC(0)="AEQMZ"
12 S DIC("A")=" Select "_$S($G(IBSI):"another ",1:"")_"Clerk: "
13 D ^DIC K DIC I Y'>0 G ENQ:'$G(IBSI),DEV
14 I $D(IBSI(+Y)) D G CLK1
15 . W !!?3,"Already selected. Choose another clerk.",!,*7
16 S IBSI(+Y)="" S:'$G(IBSI) IBSI=1 G CLK1
17 ;
18DEV ; - Select a device
19 W !!,"This report requires an 80 column printer."
20 S %ZIS="QM" D ^%ZIS G:POP ENQ
21 I $D(IO("Q")) D G ENQ
22 .S ZTRTN="PRINT^IBJDF8R",ZTDESC="IB - AR WORKLOAD ASSIGNMENTS LIST"
23 .S ZTSAVE("IB*")="" D ^%ZTLOAD
24 .I $G(ZTSK) W !!,"This job has been queued. The task no. is ",ZTSK,"."
25 .E W !!,"Unable to queue this job."
26 .K ZTSK,IO("Q") D HOME^%ZIS
27 ;
28 U IO
29 ;
30PRINT ; - Print the AR Workload Assignments Report
31 ;
32 S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
33 S IBPAG=0
34 ;
35 I '$D(^IBE(351.73,0)) D G ENQ
36 . D @("HDR")
37 . W !!,"There is no AR Workload Assignment information for the parameters selected."
38 ;
39 S IBPAG=0 D HDR G:IBQ ENQ
40 ;
41 I $G(IBSI) G PRINT1
42 ;
43 ; - print all clerks
44 ;
45 S (IBCLNUM,IBCLNAM,IBASNUM,IBPRO,IBASNDAT,IBBCAT,IBMIN,IBSUPER,IBEXCRC)=""
46 ; retrieve clerk detail and print
47 F S IBCLNUM=$O(^IBE(351.73,IBCLNUM)) Q:IBCLNUM="" D Q:IBQ
48 . S IBCLDAT=$G(^IBE(351.73,IBCLNUM,0)) Q:IBCLDAT=""
49 . S IBCLNAM=$P(^VA(200,$P(IBCLNUM,"^",1),0),"^",1),IBPRO=$P(IBCLDAT,"^",2)
50 . W !!!,IBCLNAM,?40,"Productivity report only? "
51 . W ?67,$S(IBPRO=0:"NO",1:"YES")
52 . I IBPRO=1 Q
53 . ; retrieve assignment data and print
54 . F S IBASNUM=$O(^IBE(351.73,IBCLNUM,1,IBASNUM)) Q:IBASNUM="" D Q:IBQ
55 . . S IBASNDAT=$G(^IBE(351.73,IBCLNUM,1,IBASNUM,0)) Q:IBASNDAT=""
56 . . S IBBCAT=$P(IBASNDAT,"^",2),IBMIN=$P(IBASNDAT,"^",3)
57 . . S IBSUPER=$P(IBASNDAT,"^",4),IBEXCRC=$P(IBASNDAT,"^",5)
58 . . W !,"Assignment #: ",?15,IBASNUM,?20,"Bill Category: "
59 . . W ?35,$E($P(^PRCA(430.2,IBBCAT,0),"^",1),1,18)
60 . . W ?55,"Min Acct Bal: ",?69,$J($FN(IBMIN,",",2),10)
61 . . W !,?20,"Supervisor: ",?35,$E($P($G(^VA(200,+IBSUPER,0)),"^",1),1,18)
62 . . W ?55,"Exclude Reg Counsel: ",?75,$S(IBEXCRC=1:"YES",1:"NO")
63 . . ; - Page Break
64 . . I $Y>(IOSL-8) D PAUSE Q:IBQ D HDR Q:IBQ
65 . . ; print first party parameters if present
66 . . I $D(^IBE(351.73,IBCLNUM,1,IBASNUM,1)) D FIRST
67 . . ; print third party parameters if present
68 . . I $D(^IBE(351.73,IBCLNUM,1,IBASNUM,2)) D THIRD
69 . . ;
70 . . ; - Page Break
71 . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDR Q:IBQ
72 . . ;
73 ;
74 G ENQ:IBQ W !!,"------ End of Assignment List ------" D PAUSE
75 G ENQ
76 ;
77PRINT1 ; - print selected clerks only
78 ;
79 S (IBCLNUM,IBCLNAM,IBASNUM,IBPRO,IBASNDAT,IBBCAT,IBMIN,IBSUPER,IBEXCRC)=""
80 ; retrieve clerk detail and print
81 F S IBCLNUM=$O(IBSI(IBCLNUM)) Q:IBCLNUM="" D Q:IBQ
82 . S IBCLDAT=$G(^IBE(351.73,IBCLNUM,0)) Q:IBCLDAT=""
83 . S IBCLNAM=$P(^VA(200,$P(IBCLNUM,"^",1),0),"^",1),IBPRO=$P(IBCLDAT,"^",2)
84 . W !!!,IBCLNAM,?40,"Productivity report only? "
85 . W ?67,$S(IBPRO=0:"NO",1:"YES")
86 . I IBPRO=1 Q
87 . ; retrieve assignment data and print
88 . F S IBASNUM=$O(^IBE(351.73,IBCLNUM,1,IBASNUM)) Q:IBASNUM="" D
89 . . S IBASNDAT=$G(^IBE(351.73,IBCLNUM,1,IBASNUM,0)) Q:IBASNDAT=""
90 . . S IBBCAT=$P(IBASNDAT,"^",2),IBMIN=$P(IBASNDAT,"^",3)
91 . . S IBSUPER=$P(IBASNDAT,"^",4),IBEXCRC=$P(IBASNDAT,"^",5)
92 . . W !,"Assignment #: ",?15,IBASNUM,?20,"Bill Category: "
93 . . W ?35,$E($P(^PRCA(430.2,IBBCAT,0),"^",1),1,18)
94 . . W ?55,"Min Acct Bal: ",?69,$J($FN(IBMIN,",",2),10)
95 . . W !?20,"Supervisor: ",?35,$E($P($G(^VA(200,+IBSUPER,0)),"^",1),1,18)
96 . . W ?55,"Exclude Reg Counsel: ",?75,$S(IBEXCRC=1:"YES",1:"NO")
97 . . ; - page break
98 . . I $Y>(IOSL-8) D PAUSE Q:IBQ D HDR Q:IBQ
99 . . ; print first party parameters if present
100 . . I $D(^IBE(351.73,IBCLNUM,1,IBASNUM,1)) D FIRST
101 . . ; print third party parameters if present
102 . . I $D(^IBE(351.73,IBCLNUM,1,IBASNUM,2)) D THIRD
103 . . ; - page break
104 . . I $Y>(IOSL-6) D PAUSE Q:IBQ D HDR Q:IBQ
105 ;
106 W !!,"------ End of Assignment List ------" D PAUSE
107 ;
108 ;
109ENQ D ^%ZISC
110 K IBPAG,IBQ,%,X,Y,IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT
111 K IBCLNAM,IBCLNUM,IBASNUM,IBPRO,IBASNDAT,IBBCAT,IBMIN,IBSUPER
112 K IBEXCRC,IBFPDAT,IBTPDAT,IBTOR,IBSI,IBCLDAT,IBOFF,IBRUN
113 Q
114 ;
115HDR ; - Prints the Report Header
116 ;
117 I IBPAG>0 W @IOF,*13
118 S IBPAG=$G(IBPAG)+1
119 W !,"AR Workload Assignments List",?35,"Run Date: ",IBRUN
120 W ?70,"Page: ",$J(IBPAG,3)
121 W !,$$DASH(IOM,0) S IBQ=$$STOP^IBOUTL("AR Workload Assignments List")
122 Q
123 ;
124FIRST ; - Prints First Party Parameters
125 ;
126 S IBFPDAT=""
127 S IBFPDAT=^IBE(351.73,IBCLNUM,1,IBASNUM,1)
128 W !,"FIRST PARTY PARAMETERS:"
129 W !,"Days Since Last Payment",?38,":",?40,$P(IBFPDAT,"^",1)
130 W !,"First Patient Name",?38,":",?40,$P(IBFPDAT,"^",2)
131 W !,"Last Patient Name",?38,":",?40,$P(IBFPDAT,"^",3)
132 W !,"First Social Security Number",?38,":",?40,$P(IBFPDAT,"^",4)
133 W !,"Last Social Security Number",?38,":",?40,$P(IBFPDAT,"^",5)
134 Q
135 ;
136THIRD ; - Prints Third Party Parameters
137 ;
138 S (IBTPDAT,IBTOR)=""
139 S IBTPDAT=^IBE(351.73,IBCLNUM,1,IBASNUM,2),IBTOR=$P(IBTPDAT,"^",8)
140 W !,"THIRD PARTY PARAMETERS:"
141 W !,"Days Since Last Transaction",?38,":",?40,$P(IBTPDAT,"^",1)
142 W !,"First Insurance Carrier",?38,":",?40,$P(IBTPDAT,"^",2)
143 W !,"Last Insurance Carrier",?38,":",?40,$P(IBTPDAT,"^",3)
144 W !,"First Patient Name",?38,":",?40,$P(IBTPDAT,"^",4)
145 W !,"Last Patient Name",?38,":",?40,$P(IBTPDAT,"^",5)
146 W !,"First Social Security Number",?38,":",?40,$P(IBTPDAT,"^",6)
147 W !,"Last Social Security Number",?38,":",?40,$P(IBTPDAT,"^",7)
148 W !,"Type of Receivable",?38,":"
149 W ?40,$S(IBTOR=1:"Inpatient",IBTOR=2:"Outpatient",IBTOR=3:"Pharmacy Refill",IBTOR=4:"All Receivables",1:"")
150 Q
151 ;
152DASH(X,Y) ; - Return a dashed line.
153 ; Input: X=Number of Columns (80 or 132), Y=Char to be printed
154 ;
155 Q $TR($J("",X)," ",$S(Y:"-",1:"="))
156 ;
157PAUSE ; - Page break.
158 ;
159 I $E(IOST,1,2)'="C-" Q
160 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
161 F IBX=$Y:1:(IOSL-3) W !
162 S DIR(0)="E" D ^DIR S:$D(DIRUT)!($D(DUOUT)) IBQ=1
163 Q
164 ;
165DT(X) ; - Return date.
166 ; Input: X=Date in Fileman format
167 ; Output: Z=Date in MMDDYY format
168 ;
169 Q $E(X,4,7)_$E(X,2,3)
Note: See TracBrowser for help on using the repository browser.