source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEFG7.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.8 KB
Line 
1IBCEFG7 ;ALB/TMP - OUTPUT FORMATTER GENERIC FORM PROCESSING ;06-MAR-96
2 ;;2.0;INTEGRATED BILLING;**52,84,96,51,137,191,320**;21-MAR-94
3 ;
4 Q
5 ;
6FORM(IBFORM,IBQUE,IBNOASK,IBQDT,ZTSK,IBABORT) ;For ien IBFORM, extract data using
7 ; output generater
8 ; IBQUE = the output queue for transmitted forms or the printer queue
9 ; for printed output
10 ; IBNOASK = flag that says user interaction for queuing is not needed
11 ; 0 or null = ask, 1 = don't ask
12 ; IBQDT = the date/time to queue the job (optional)
13 ;
14 ; Sets ZTSK only if job is queued
15 ;
16 ; IBABORT = output parameter which says user aborted forms output.
17 ; Pass by reference. The $$QUEUE function returned false.
18 ;
19 N IBF2,IBTYP,POP,ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTREQ,ZTDTH,ZTREQ
20 S IBTYP=$P($G(^IBE(353,IBFORM,2)),U,2),IBQUE=$G(IBQUE),IBABORT=0
21 G:$S(IBTYP'="S":$G(^IBE(353,IBFORM,"EXT"))=""&($G(^IBE(353,+$P($G(^IBE(353,IBFORM,2)),U,5),"EXT"))=""),1:'$G(IBIFN)) FORMQ
22 I IBTYP="P",IBQUE="" D DEV(IBFORM) G:$G(POP) FORMQ
23 I IBTYP="T" D:$G(IBNOASK) Q:$G(IBNOASK) I '$$QUEUE(IBFORM) S:$O(^TMP("IBRESUBMIT",$J,0)) ^TMP("IBRESUBMIT",$J)="ABORT" S IBABORT=1 Q
24 . S ZTRTN="FORMOUT^IBCEFG7",ZTIO="",ZTDESC="OUTPUT FORMATTER - FORM: "_$P($G(^IBE(353,IBFORM,0)),U),ZTSAVE("IB*")="",ZTDTH=$S($G(IBQDT):IBQDT,1:$$NOW^XLFDT())
25 . S:$D(^TMP("IBRESUBMIT",$J)) ZTSAVE("^TMP(""IBRESUBMIT"",$J)")="",ZTSAVE("^TMP(""IBNOT"",$J)")="",ZTSAVE("^TMP(""IBRESUBMIT"",$J,")="",ZTSAVE("^TMP(""IBNOT"",$J,")=""
26 . I $D(^TMP("IBSELX",$J)) S ZTSAVE("^TMP(""IBSELX"",$J,")="",ZTSAVE("^TMP(""IBSELX"",$J)")=""
27 . S:'$G(DUZ) DUZ=.5
28 . D ^%ZTLOAD
29 I '$G(ZTSK) D FORMOUT
30FORMQ Q
31 ;
32FORMOUT ; Queued job entrypoint - IBFORM needs to be defined
33 ; IBQUE needs to be defined if using default transmission output
34 N IB2,IBTYP,IBPAR
35 K ^TMP("IBXDATA",$J)
36 S ZTREQ="@"
37 S IB2=$G(^IBE(353,IBFORM,2)),IBPAR=+$P(IB2,U,5),IBTYP=$P(IB2,U,2)
38 ;
39 ; Execute PRE-PROCESSOR
40 I IBTYP'="S" D FPRE(IBFORM,IBPAR,.IBXERR)
41 G:$G(IBXERR)'="" FOUTQ
42 ;
43 ; Extract records - this should include call(s) to $$EXTRACT^IBCEFG()
44 I IBTYP'="S" D
45 .I $G(^IBE(353,IBFORM,"EXT"))'="" X ^("EXT") ;Form extract
46 .I $G(^IBE(353,IBFORM,"EXT"))="",$G(^IBE(353,IBPAR,"EXT"))'="" X ^("EXT") ;Parent form extract
47 I IBTYP="S" D G Q1
48 .N PARAM,Z,Z0
49 .S PARAM(1)="BILL-SEARCH",Z0=$G(^DGCR(399,IBIFN,0))
50 .S Z=$P(Z0,U,21) S:Z="" Z="P" S PARAM(2)=$P($G(^DGCR(399,IBIFN,"I"_($F("PST",Z)-1))),U),PARAM(3)=$S($P(Z0,U,5)<3:"I",1:"O")
51 .S Z=$$EXTRACT^IBCEFG(IBFORM,IBIFN,1,.PARAM)
52 ;
53 G:'$D(^TMP("IBXDATA",$J)) FOUTQ
54 ;
55 ; If an output routine exists, use it, otherwise use the generic ones
56 I $G(^IBE(353,IBFORM,"OUT"))'="" X ^("OUT") G FOUTQ
57 I $G(^IBE(353,IBFORM,"OUT"))="",$G(^IBE(353,IBPAR,"OUT"))'="" X ^("OUT") G FOUTQ
58 ;
59 I IBTYP="P" D PRINT(IBFORM) D:'$D(ZTQUEUED) ^%ZISC G FOUTQ
60 I IBTYP="T" D:$G(IBQUE)'="" TRANSMIT(IBFORM,IBQUE) G FOUTQ
61 ;
62FOUTQ D FPOST(IBFORM,IBPAR,.IBXERR) ; Execute POST-PROCESSOR, if any
63 K ^TMP("IBXDATA",$J),^TMP("IBXEDIT",$J)
64Q1 Q
65 ;
66PRINT(IBFORM) ; Print data from extract global for form IBFORM
67 ; Extract records - this should include call(s) to $$EXTRACT^IBCEFG()
68 N IB1,IB2,IB3,IBREC
69 ;LOOP THROUGH RECORD/PAGE/LINE/COL
70 S IBREC="" F S IBREC=$O(^TMP("IBXDATA",$J,IBREC)) Q:IBREC="" D ;Rec
71 . ;Page/line
72 . F IB1=1:1:+$O(^TMP("IBXDATA",$J,IBREC,""),-1) W:IB1>1 @IOF W ?0 F IB2=1:1:+$O(^TMP("IBXDATA",$J,IBREC,IB1,""),-1) W:IB2>1 ! S IB3="" D
73 .. ; Column
74 .. F S IB3=$O(^TMP("IBXDATA",$J,IBREC,IB1,IB2,IB3)) Q:IB3="" W ?(IB3-1),^(IB3)
75 . ;Only print form feed if more records to print - not on last record
76 . I $O(^TMP("IBXDATA",$J,IBREC))'="" W @IOF
77 Q
78 ;
79TRANSMIT(IBFORM,IBQUE) ; Send data from extract global to queue IBQUE
80 ;IBFORM = ien of the form to be transmitted (required)
81 N IB1,IB2,IB3,IBREC,IBOUT,IBCT,IBSUB,Z,XMDUZ,XMSUBJ,XMBODY,XMTO
82 K ^TMP("IBXTXMT",$J),^TMP("IBX",$J)
83 Q:$G(IBQUE)=""
84 ;
85 S IBDELIM=$P($G(^IBE(353,+$S($P($G(^IBE(353,IBFORM,2)),U,5):$P(^(2),U,5),1:IBFORM),2)),U,7)
86 S:IBDELIM="" IBDELIM="^"
87 ;Loop through record/page/line/column
88 S IBREC="",(IBSIZE,IBCT)=0,IBMSG=1
89 F S IBREC=$O(^TMP("IBXDATA",$J,IBREC)) Q:IBREC="" D
90 .S ^TMP("IBX",$J,IBREC)=IBCT
91 .S IB1="" F S IB1=$O(^TMP("IBXDATA",$J,IBREC,IB1)) Q:IB1="" D
92 ..S (IB2,IBOUT)=""
93 ..F S IB2=$O(^TMP("IBXDATA",$J,IBREC,IB1,IB2)) D:IB2=""&$L(IBOUT) MSG(IBREC,IBOUT,.IBMSG,.IBSIZE,.IBCT) Q:IB2="" D
94 ...S IB3="" F S IB3=$O(^TMP("IBXDATA",$J,IBREC,IB1,IB2,IB3)) Q:IB3="" S IBP=^(IB3) S:IBP?.E1L.E IBP=$$UP^XLFSTR(IBP) S $P(IBOUT,IBDELIM,IB3)=IBP
95 ;
96 ;Send mail message(s) for extract
97 S XMDUZ=DUZ,XMTO(IBQUE)="",IBSUB="OUTPUT FORMATTER: "_$P($G(^IBE(353,IBFORM,0)),U)
98 S Z="" F S Z=$O(^TMP("IBXTXMT",$J,Z)) Q:'Z S XMBODY="^TMP(""IBXTXMT"","_$J_","_Z_")",XMSUBJ=IBSUB_" ("_Z_")" D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
99 ;
100 K ^TMP("IBXTXMT",$J),^TMP("IBX",$J)
101 Q
102 ;
103MSG(IBREC,LINE,MSG,SIZE,CT) ; Set up global for transmission line
104 ; IBREC = record number being processed
105 ; LINE = actual text to be output in mail message line
106 ; MSG = the message seq # to output this record in (pass by reference)
107 ; SIZE = current size of the message (pass by reference)
108 ; CT = the last line # in message for the text (pass by reference)
109 N Z,Z0,LLEN
110 S LLEN=$L(LINE)
111 I (LLEN+SIZE)>30000 D
112 .Q:'$G(^TMP("IBX",$J,IBREC)) ;Record itself is > 30000 - let it go
113 .S (SIZE,CT)=0,Z=$G(^TMP("IBX",$J,IBREC)),^(IBREC)=0
114 .F S Z=$O(^TMP("IBXTXMT",$J,MSG,Z)) Q:'Z S CT=CT+1,Z0=^(Z),^TMP("IBXTXMT",$J,MSG+1,CT)=Z0,SIZE=SIZE+$L(Z0) K ^TMP("IBXTXMT",$J,MSG,Z)
115 .S MSG=MSG+1
116 S CT=CT+1,^TMP("IBXTXMT",$J,MSG,CT)=LINE,SIZE=SIZE+LLEN
117 Q
118 ;
119DEV(IBFORM,NOQ) ;
120 N IBFTYPE
121 S:'$G(NOQ) %ZIS="Q" S %ZIS("A")="Output Device: "
122 S %ZIS("B")=$P($G(^IBE(353,IBFORM,0)),"^",2)
123 D ^%ZIS
124 G:POP DEVQ
125 I $D(IO("Q")) D G DEVQ
126 .S ZTRTN="FORMOUT^IBCEFG7",ZTDESC="PRINT FORM: "_$P($G(^IBE(353,IBFORM,0)),U),ZTSAVE("IB*")="" K ZTIO
127 .I $D(^TMP("IBQONE",$J)) D
128 ..S IBJ="",IBFTYPE="IBCFP"_$S($P($G(^IBE(353,IBFORM,2)),U,5):$P(^(2),U,5),1:IBFORM)
129 ..S ZTSAVE("^XTMP(IBFTYPE,$J,")=""
130 .D ^%ZTLOAD K IO("Q") D HOME^%ZIS
131 .I $G(IBFTYPE)'="" K ^XTMP(IBFTYPE,$J)
132 .I $D(ZTSK) W !!,"This job has been queued. The task number is "_ZTSK_"."
133 U IO
134DEVQ Q
135 ;
136QUEUE(IBFORM) ; Ask to queue transmission
137 N Y,DIR,OKAY
138 S OKAY=1
139 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to queue this transmission" W !
140 D ^DIR K DIR
141 I $D(DTOUT)!$D(DUOUT) S OKAY=0 G QUEQ
142 I 'Y D G QUEQ
143 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to run this job without queuing it now"
144 .W ! D ^DIR K DIR
145 .I 'Y S OKAY=0
146 ; - queue job to run
147 W !!,"Please enter the date and time to execute this job...",!
148 S ZTRTN="FORMOUT^IBCEFG7",ZTIO="",ZTDESC="OUTPUT FORMATTER - FORM: "_$P($G(^IBE(353,IBFORM,0)),U),ZTSAVE("IB*")=""
149 S:$D(^TMP("IBRESUBMIT",$J)) ZTSAVE("^TMP(""IBRESUBMIT"",$J)")="",ZTSAVE("^TMP(""IBNOT"",$J)")="",ZTSAVE("^TMP(""IBRESUBMIT"",$J,")="",ZTSAVE("^TMP(""IBNOT"",$J,")=""
150 I $D(^TMP("IBSELX",$J)) S ZTSAVE("^TMP(""IBSELX"",$J,")="",ZTSAVE("^TMP(""IBSELX"",$J)")=""
151 D ^%ZTLOAD
152 I $G(ZTSK) W !!,"This job has been queued. The task number is "_ZTSK_"."
153QUEQ Q OKAY
154 ;
155FPRE(IBFORM,IBPAR,IBXERR) ; Executes pre-processor
156 I $G(^IBE(353,IBFORM,"FPRE"))'="" X ^("FPRE") ;Form pre-processor
157 I $G(^IBE(353,IBFORM,"FPRE"))="",$G(^IBE(353,IBPAR,"FPRE"))'="" X ^("FPRE") ;Parent form pre-processor
158 Q
159 ;
160FPOST(IBFORM,IBPAR,IBXERR) ; Executes post-processor
161 I $G(^IBE(353,IBFORM,"FPOST"))'="" X ^("FPOST") ;Form post-processor
162 I $G(^IBE(353,IBFORM,"FPOST"))="",$G(^IBE(353,IBPAR,"FPOST"))'="" X ^("FPOST") ;Parent form post-processor
163 Q
164 ;
165FMFLD(IBDA) ;Return the file#field for fileman field referenced as a data
166 ; element in file 364.7's IBDA entry.
167 N Z,Z0,ND0
168 S Z0=+$P($G(^IBA(364.7,IBDA,0)),U,3),ND0=$G(^IBA(364.5,+Z0,0))
169 I $P(ND0,U,3)'="F"!($P(ND0,U,6)="") S Z="" G FLDQ
170 S Z=$P(ND0,U,5),Z1=$P(ND0,U,6)
171 I Z1[":" D ;Navigation
172 . S Z2=$O(^DD(+Z,"B",$P(Z1,":"),"")) Q:'Z2
173 . S Z=+$P($P($G(^DD(399,Z2,0)),U,2),"P",2)
174 . I Z S Z1=$P(Z1,":",2)
175 I Z S Z=Z_"#"_$O(^DD(+Z,"B",Z1,""))
176FLDQ Q Z
177 ;
Note: See TracBrowser for help on using the repository browser.