source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCIWK.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: 3.3 KB
Line 
1IBCIWK ;DSI/JSR - WORKSHEET UTILITY ;6-MAR-2001
2 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;; ** Program Description **
5 ; This is the main routine that calls a ListManager template.
6 ; Prior to calling the LM template, data for a specific IBIFN is
7 ; extracted and formatted for LM to display.
8 ; This routine is the main routine called when the user is in
9 ; the bill edit screen. Irrespective of security access IBCIMG is
10 ; always called either directly or in-directly.
11 ; Parameters
12 ; Call = (0 or 1) This is a flag that determines which ListManager
13 ; Template to call.
14 ; 0 indicates that the browse only template should be invoked
15 ; 1 indicates that either a Manager or Clerk template will be invoked
16 ; based on security key access.
17 ;
18EN(CALL) ;enter set up data
19 ;
20 ;
21 N DFN,DISYS,IBA2,IBAC,IBAC1,IBAD,IBADD1,IBBNO,IBDT
22 N IBCSCPP,IBLINE,IBMO,IBPOPOUT,IBPREV,IBSCNN,IBSR,IBSR1,IBV
23 N IBV1,IBVI,IBVO,IBVV,IBX,IBXERR,TYPE
24 N IBCIASI,IBCIASN,IBCIBII,IBCIBIL,IBCIBIR,IBCICAR,IBCICLNO,IBCICM1
25 N IBCICM2,IBCICMP,IBCICNM,IBCICOD,IBCIDAT,IBCIDOB,IBCIDPT,IBCIERL,IBCIERT,IBCIEVEN,IBCIEVV,IBCIINS
26 N IBCILD1,IBCILD2,IBCILEV,IBCINAM,IBCIPAD,IBCIPTI,IBCISER,IBCISEX,IBCISRR,IBCIYYY
27 N IBCIZZZ,IBCSCPP,LMBDATE,LMCHARG,LMCPT,LMEDATE,LMLINE,LMMOD,LMPOS,LMTOS,LMUNIT
28 N QUITDP,I,X,Y,Z,YARR,DATA,VAERR,XMDUM,XMZ,IB,IBCCCC,IBCIPRV,IBCI345,IBCISSN
29 ;
30 S QUITDP=1
31 F D LOOP Q:QUITDP=0
32 G XIT
33 Q
34LOOP ;
35 K ^TMP("IBCILM",$J)
36 S IBCI345=0 ;JSR 6/22/01 Flag to determine when to kill 3,4,5 node
37 I CALL=0 D
38 . I '$P($G(^IBA(351.9,IBIFN,3)),U,1) S IBCI345=1 D UPDT^IBCIADD1
39 . I $G(IBCISNT)=3 M ^TMP("IBCILM",$J)=^TMP("IBCITST",$J)
40 . E M ^TMP("IBCILM",$J)=^IBA(351.9,IBIFN,1)
41 . D GDATA
42 . D EN^VALM("IBCI CLAIMSMANAGER WK BROWSE")
43 I CALL=1 D
44 . I '$P($G(^IBA(351.9,IBIFN,3)),U,1) S IBCI345=1 D UPDT^IBCIADD1
45 . I '$D(IBCISNT)!($G(IBCISNT)'=3) M ^TMP("IBCILM",$J)=^IBA(351.9,IBIFN,1)
46 . D GDATA
47 . I '$D(^XUSEC("IBCI CLAIMSMANAGER OVERRIDE",DUZ)) D EN^VALM("IBCI CLAIMSMANAGER CLERK WK")
48 . I $D(^XUSEC("IBCI CLAIMSMANAGER OVERRIDE",DUZ)) D EN^VALM("IBCI CLAIMSMANAGER MGR WK")
49 I IBCI345 D DELTI^IBCIUT4 ; JSR 6/22/01
50 Q
51GDATA ; sets
52 NEW X,X1,X2,X3,X4,Y
53 K IBCIPAD S $P(IBCIPAD," ",79)=""
54 S IBCIDAT=$G(^DGCR(399,IBIFN,0))
55 S IBCICLNO=$P(IBCIDAT,U,1)_IBCIPAD
56 S IBCIPTI=$P(IBCIDAT,U,2)
57 I IBCIPTI S IBCIDPT=$G(^DPT(IBCIPTI,0))
58 S IBCIDOB=$P(IBCIDPT,U,3)
59 S IBCISSN=$P(IBCIDPT,U,9) ;JSR 6/25/2001
60 S Y=IBCIDOB X ^DD("DD")
61 S IBCIBIR=Y_IBCIPAD
62 S IBCISEX=$P(IBCIDPT,U,2)_IBCIPAD
63 S IBCINAM=$P(IBCIDPT,U,1)
64 S X=$E(IBCINAM,1,19)_" ("_$E(IBCISSN,6,9)_")",X1=27
65 S IBCINAM=$$FILL^IBCIUT2 ; ESG 7/13/01
66 S IBCIEVEN=$P(IBCIDAT,U,3)
67 S Y=IBCIEVEN X ^DD("DD")
68 S IBCIEVV=$E(Y,1,11)
69 S IBCIEVV=$TR(IBCIEVV,"@","")
70 S IBCIPRV=$P($$RPHY^IBCIUT1(IBIFN),U,1)_IBCIPAD
71 S IBCICOD=$$CODER^IBCIUT5(IBIFN)
72 S IBCICNM=$P(IBCICOD,U,3)
73 S IBCICNM=IBCICNM_IBCIPAD
74 S IBCISER=$P(IBCICOD,U,1)
75 S IBCISRR=$S(IBCISER="O":"OP",IBCISER="I":"IP",1:"UK")
76 S IBCIBII=$$BILLER^IBCIUT5(IBIFN)
77 S IBCIBIL=$P(IBCIBII,U,2)
78 S IBCIBIL=IBCIBIL_IBCIPAD
79 S IBCIASI=$P($G(^IBA(351.9,IBIFN,0)),U,12)
80 I IBCIASI S IBCIASN=$P($G(^VA(200,IBCIASI,0)),U,1)
81 E S IBCIASN=IBCIPAD
82 S IBCIINS=$$FINDINS^IBCEF1(IBIFN)
83 S IBCICAR=""
84 S:IBCIINS IBCICAR=$P($G(^DIC(36,IBCIINS,0)),U,1)
85 S IBCICAR=IBCICAR_IBCIPAD
86 Q
87XIT ;
88 Q
Note: See TracBrowser for help on using the repository browser.