source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEFG0.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.9 KB
Line 
1IBCEFG0 ;ALB/TMP - FORMS GENERATOR EXTRACT (CONT) ;17-JAN-96
2 ;;2.0;INTEGRATED BILLING;**52,51**;21-MAR-94
3 ;
4ELE(IBXDA,IBXPARM,IBXFORM) ; Find element to extract for form fld
5 N IBX
6 I $G(IBXPARM(1))="BILL-SEARCH" D I $G(IBX)>0 G ELEQ ;Custom - bill extract
7 .S IBX=$$EDIBILL^IBCEFG1(+$G(IBXFORM),IBXDA,$G(IBXPARM(2)),$G(IBXPARM(3)))
8 S IBX=+$O(^IBA(364.7,"B",IBXDA,""))
9 I 'IBX,$G(IBXFORM),$O(^IBA(364.6,"APAR",IBXFORM,IBXDA,"")) S IBX=+$O(^("")),IBX=+$O(^IBA(364.7,"B",IBX,0)) I IBX G ELEQ
10ELEQ Q IBX
11 ;
12DATA(IBXELE,IBX00,IBXFILE,IBXIEN,IBXARRAY,IBXERR) ; Find data assoc with form fld def
13 N IBXPG,IBXCOL,IBXLN,IBXDA,IBXFF
14 I $P(IBX00,U,3)="C" S IBXDATA=$P(IBX00,U,8) G DATAQ
15 I $P(IBX00,U,3)="E",$G(^IBA(364.5,IBXELE,1))'="" X ^(1) G DATAQ
16 I $P(IBX00,U,3)="F" D
17 .I $P(IBX00,U,6)[":" I $$GET1^DIQ(IBXFILE,IBXIEN_",",$P($P(IBX00,U,6),":"))="" S IBXDATA="" Q
18 .S IBXDATA=$$GET1^DIQ(IBXFILE,IBXIEN_",",$P(IBX00,U,6),$S("I"[$P(IBX00,U,7):"I",1:""),IBXARRAY)
19 .I $D(^TMP("DIERR",$J,1)) S IBXERR="FILEMAN FIELD: "_$P(IBX00,U)_" "_^(1,"TEXT",1)
20DATAQ Q $G(IBXDATA)
21 ;
22DUP(DA,X,CK) ; Duplicate check on form field definitions
23 ;Returns 1 if a duplicate of this form page/line/column is found
24 N PG,LN,COL,ND,FORM,DUP,Z
25 S DUP=0
26 G:$G(DA)="" DUPQ
27 S ND=$G(^IBA(364.6,DA,0))
28 S FORM=$S($G(CK)=1:X,1:$P(ND,U)),PG=$S($G(CK)=2:X,1:$P(ND,U,4)),LN=$S($G(CK)=3:X,1:$P(ND,U,5)),COL=$S($G(CK)=4:X,1:$P(ND,U,8))
29 ;
30 I FORM'="",PG'="",LN'="",COL'="" D
31 .S Z=$O(^IBA(364.6,"ASEQ",FORM,PG,LN,COL,""))
32 .Q:$S(Z="":1,1:Z=DA&($O(^IBA(364.6,"ASEQ",FORM,PG,LN,COL,""),-1)=DA))
33 .S DUP=1
34 ;
35DUPQ Q DUP
36 ;
37BILLPARM(IBXIEN,IBXPARM) ; Sets up parameters for extracting bill data
38 ;IBXIEN = internal entry # of the entry to be extracted
39 ;IBXPARM = array that the parameters are set into. Pass by reference
40 ; (2)=insurance co int entry #, (3)=bill type (I/O)
41 N IB0,IBCBH
42 S IB0=$G(^DGCR(399,IBXIEN,0)),IBCBH=$P(IB0,U,21) S:"PST"'[IBCBH!(IBCBH="") IBCBH="P"
43 S IBXPARM(1)="BILL-SEARCH",IBXPARM(2)=$P($G(^DGCR(399,IBXIEN,"I"_($F("PST",IBCBH)-1))),U),IBXPARM(3)=$S($P(IB0,U,5)<3:"I",1:"O")
44 Q
45 ;
46PARTEXT(FORMAT,PG,LN,IBXIEN,IBXFORM,IBXPARM,IBXERR) ; Extract part of a printed form
47 ;FORMAT = flag used to say whether you want (1) formatted (by line)
48 ; or (0) unformatted (by pg/line/col) returned
49 ;PG = page to start/end in 2 '^' pieces (start page^end page)
50 ;LN = line to start/end in 2 '^' pieces (start line^end line)
51 ; the start value of the preceeding 2 parameters are required
52 ; if no end value, start value is assumed to be end value, too
53 ;IBXIEN = the entry # of the record to be extracted
54 ;IBXFORM = ien of the local or parent form in file 353 to be extracted
55 ;IBXPARM = passed by reference. Extract parameters.
56 ;IBXERR = passed by reference. If an error condition is found, this is
57 ; the text of the error.
58 ;
59 ;Returns ^TMP("IBXDISP",$J,PG,LN)=print line(s) if FORMAT=1
60 ;Returns ^TMP("IBXDISP",$J,1,PG,LN,COL)=data at PG/LN/COL if +FORMAT=0
61 ;
62 ;we may later add an automatic data element dependency logic where
63 ; we can flag a data element as needing another d.e. extracted first
64 ; and we execute the other logic automatically if not already done.
65 ;
66 N IBXDA,IBXPG,IBXLN,IBXCOL,IBXF,IBX2,IBXREC,IBXFILE,Z
67 K ^TMP("IBXDATA",$J),^TMP("DIERR",$J),^TMP("IBXEDIT",$J),^TMP("IBXDISP",$J)
68 S IBX2=$G(^IBE(353,+$G(IBXFORM),2))
69 I $P(IBX2,U,2)'="P" S IBXERR="NOT A PRINTABLE FORM!!" Q
70 I '$D(^DGCR(399,IBXIEN,0)) S IBXERR="BILL DOES NOT EXIST" Q
71 S:$P(PG,U,2)="" $P(PG,U,2)=$P(PG,U) S:$P(LN,U,2)="" $P(LN,U,2)=$P(LN,U)
72 S IBXF=$S($P(IBX2,U,5):$P(IBX2,U,5),1:IBXFORM)
73 S IBXPG=$O(^IBA(364.6,"ASEQ",IBXF,$P(PG,U)),-1)
74 F S IBXPG=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG)) Q:IBXPG=""!(IBXPG]$P(PG,U,2)) D
75 .S IBXLN=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG,$P(LN,U)),-1) F S IBXLN=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG,IBXLN)) Q:IBXLN=""!(IBXLN]$P(LN,U,2)) D G:$G(IBXERR)'="" PTQ
76 ..S IBXCOL="" F S IBXCOL=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG,IBXLN,IBXCOL)) Q:IBXCOL="" D Q:$G(IBXERR)'=""
77 ...S IBXDA=$O(^IBA(364.6,"ASEQ",IBXF,IBXPG,IBXLN,IBXCOL,""))
78 ...Q:'IBXDA
79 ...D DATA^IBCEFG(IBXPG,IBXLN,IBXCOL,IBXIEN,IBXFORM,IBXDA,.IBXPARM,.IBXERR)
80 S IBXPG="" F S IBXPG=$O(^TMP("IBXDATA",$J,1,IBXPG)) Q:IBXPG=""!(IBXPG>$P(PG,U,2)) F IBXLN=+LN:1:$P(LN,U,2) S:$G(FORMAT) ^TMP("IBXDISP",$J,IBXPG,IBXLN)="" D
81 .Q:'$D(^TMP("IBXDATA",$J,1,IBXPG,IBXLN))
82 .S IBXCOL="" F S IBXCOL=$O(^TMP("IBXDATA",$J,1,IBXPG,IBXLN,IBXCOL)) Q:IBXCOL="" S Z=$G(^(IBXCOL)) I Z'="" D
83 ..I $G(FORMAT) S $E(^TMP("IBXDISP",$J,IBXPG,IBXLN),IBXCOL,IBXCOL+$L(Z)-1)=Z Q
84 ..I '$G(FORMAT) S ^TMP("IBXDISP",$J,IBXPG,IBXLN,IBXCOL)=Z
85 ;
86PTQ K ^TMP("IBXDATA",$J),^TMP("DIERR",$J)
87 Q
88 ;
89BILLN(FORMAT,PG,LN,IBXIEN,IBXFORM) ; Call to extract the contents of lines on a bill
90 ; See PARTEXT for parameters
91 ; RETURNS null if extract OK, OR error text if not
92 N IBXPARM,IBXERR,IBXDATA,IBXSIZE
93 K ^TMP("IBXSAVE",$J)
94 D BILLPARM(IBXIEN,.IBXPARM)
95 D PARTEXT(FORMAT,PG,LN,IBXIEN,IBXFORM,.IBXPARM,.IBXERR)
96 K ^TMP("IBXSAVE",$J)
97 Q $G(IBXERR)
98 ;
99EXTONE(IBXIEN,IBXELE,IBX,IBXERR) ;
100 ; Extract unformatted data element(s) for record in file whose entry
101 ; is IBXIEN
102 ; IBXELE(1-n) = array passed by reference and containing the data
103 ; element ien's from file 364.5 to return
104 ; IBX = name of array to be returned containing the data requested.
105 ; For individual-valued elements, IBX(1-n) will
106 ; contain the data element values.
107 ; For group elements, IBX(1-n,1-z) will contain the
108 ; values of the data element's 1-z occurrences.
109 ;
110 ; IBXERR = if an error, the error message will be returned here
111 ;
112 N IBX00,IBXQ,IBXDATA,IBXFILE,IBXXD,Z0,Z1
113 K @IBX
114 S IBXQ="" F S IBXQ=$O(IBXELE(IBXQ)) Q:'IBXQ D
115 .S IBX00=$G(^IBA(364.5,+IBXELE(IBXQ),0)),IBXFILE=+$P(IBX00,U,5),IBXARRAY=$P($G(^IBA(364.5,+IBXELE(IBXQ),2)),U) S:IBXARRAY="" IBXARRAY="IBXDATA"
116 .Q:'IBXFILE
117 .K IBXXD
118 .S IBXXD=$$DATA(IBXELE(IBXQ),IBX00,IBXFILE,IBXIEN,IBXARRAY,.IBXERR)
119 .I $D(@IBXARRAY)=1 S (@IBX,@IBX@(IBXQ))=@IBXARRAY Q
120 .S Z0="",Z1=0 F S Z0=$O(@IBXARRAY@(Z0)) Q:'Z0 S Z1=Z1+1 M @IBX@(IBXQ,Z1)=@IBXARRAY@(Z0)
121 Q
122 ;
Note: See TracBrowser for help on using the repository browser.