Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCIWK

IBCIWK.m

Go to the documentation of this file.
  1. IBCIWK ;DSI/JSR - WORKSHEET UTILITY ;6-MAR-2001
  1. ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;; ** Program Description **
  1. ; This is the main routine that calls a ListManager template.
  1. ; Prior to calling the LM template, data for a specific IBIFN is
  1. ; extracted and formatted for LM to display.
  1. ; This routine is the main routine called when the user is in
  1. ; the bill edit screen. Irrespective of security access IBCIMG is
  1. ; always called either directly or in-directly.
  1. ; Parameters
  1. ; Call = (0 or 1) This is a flag that determines which ListManager
  1. ; Template to call.
  1. ; 0 indicates that the browse only template should be invoked
  1. ; 1 indicates that either a Manager or Clerk template will be invoked
  1. ; based on security key access.
  1. ;
  1. EN(CALL) ;enter set up data
  1. ;
  1. ;
  1. N DFN,DISYS,IBA2,IBAC,IBAC1,IBAD,IBADD1,IBBNO,IBDT
  1. N IBCSCPP,IBLINE,IBMO,IBPOPOUT,IBPREV,IBSCNN,IBSR,IBSR1,IBV
  1. N IBV1,IBVI,IBVO,IBVV,IBX,IBXERR,TYPE
  1. N IBCIASI,IBCIASN,IBCIBII,IBCIBIL,IBCIBIR,IBCICAR,IBCICLNO,IBCICM1
  1. N IBCICM2,IBCICMP,IBCICNM,IBCICOD,IBCIDAT,IBCIDOB,IBCIDPT,IBCIERL,IBCIERT,IBCIEVEN,IBCIEVV,IBCIINS
  1. N IBCILD1,IBCILD2,IBCILEV,IBCINAM,IBCIPAD,IBCIPTI,IBCISER,IBCISEX,IBCISRR,IBCIYYY
  1. N IBCIZZZ,IBCSCPP,LMBDATE,LMCHARG,LMCPT,LMEDATE,LMLINE,LMMOD,LMPOS,LMTOS,LMUNIT
  1. N QUITDP,I,X,Y,Z,YARR,DATA,VAERR,XMDUM,XMZ,IB,IBCCCC,IBCIPRV,IBCI345,IBCISSN
  1. ;
  1. S QUITDP=1
  1. F D LOOP Q:QUITDP=0
  1. G XIT
  1. Q
  1. LOOP ;
  1. K ^TMP("IBCILM",$J)
  1. S IBCI345=0 ;JSR 6/22/01 Flag to determine when to kill 3,4,5 node
  1. I CALL=0 D
  1. . I '$P($G(^IBA(351.9,IBIFN,3)),U,1) S IBCI345=1 D UPDT^IBCIADD1
  1. . I $G(IBCISNT)=3 M ^TMP("IBCILM",$J)=^TMP("IBCITST",$J)
  1. . E M ^TMP("IBCILM",$J)=^IBA(351.9,IBIFN,1)
  1. . D GDATA
  1. . D EN^VALM("IBCI CLAIMSMANAGER WK BROWSE")
  1. I CALL=1 D
  1. . I '$P($G(^IBA(351.9,IBIFN,3)),U,1) S IBCI345=1 D UPDT^IBCIADD1
  1. . I '$D(IBCISNT)!($G(IBCISNT)'=3) M ^TMP("IBCILM",$J)=^IBA(351.9,IBIFN,1)
  1. . D GDATA
  1. . I '$D(^XUSEC("IBCI CLAIMSMANAGER OVERRIDE",DUZ)) D EN^VALM("IBCI CLAIMSMANAGER CLERK WK")
  1. . I $D(^XUSEC("IBCI CLAIMSMANAGER OVERRIDE",DUZ)) D EN^VALM("IBCI CLAIMSMANAGER MGR WK")
  1. I IBCI345 D DELTI^IBCIUT4 ; JSR 6/22/01
  1. Q
  1. GDATA ; sets
  1. NEW X,X1,X2,X3,X4,Y
  1. K IBCIPAD S $P(IBCIPAD," ",79)=""
  1. S IBCIDAT=$G(^DGCR(399,IBIFN,0))
  1. S IBCICLNO=$P(IBCIDAT,U,1)_IBCIPAD
  1. S IBCIPTI=$P(IBCIDAT,U,2)
  1. I IBCIPTI S IBCIDPT=$G(^DPT(IBCIPTI,0))
  1. S IBCIDOB=$P(IBCIDPT,U,3)
  1. S IBCISSN=$P(IBCIDPT,U,9) ;JSR 6/25/2001
  1. S Y=IBCIDOB X ^DD("DD")
  1. S IBCIBIR=Y_IBCIPAD
  1. S IBCISEX=$P(IBCIDPT,U,2)_IBCIPAD
  1. S IBCINAM=$P(IBCIDPT,U,1)
  1. S X=$E(IBCINAM,1,19)_" ("_$E(IBCISSN,6,9)_")",X1=27
  1. S IBCINAM=$$FILL^IBCIUT2 ; ESG 7/13/01
  1. S IBCIEVEN=$P(IBCIDAT,U,3)
  1. S Y=IBCIEVEN X ^DD("DD")
  1. S IBCIEVV=$E(Y,1,11)
  1. S IBCIEVV=$TR(IBCIEVV,"@","")
  1. S IBCIPRV=$P($$RPHY^IBCIUT1(IBIFN),U,1)_IBCIPAD
  1. S IBCICOD=$$CODER^IBCIUT5(IBIFN)
  1. S IBCICNM=$P(IBCICOD,U,3)
  1. S IBCICNM=IBCICNM_IBCIPAD
  1. S IBCISER=$P(IBCICOD,U,1)
  1. S IBCISRR=$S(IBCISER="O":"OP",IBCISER="I":"IP",1:"UK")
  1. S IBCIBII=$$BILLER^IBCIUT5(IBIFN)
  1. S IBCIBIL=$P(IBCIBII,U,2)
  1. S IBCIBIL=IBCIBIL_IBCIPAD
  1. S IBCIASI=$P($G(^IBA(351.9,IBIFN,0)),U,12)
  1. I IBCIASI S IBCIASN=$P($G(^VA(200,IBCIASI,0)),U,1)
  1. E S IBCIASN=IBCIPAD
  1. S IBCIINS=$$FINDINS^IBCEF1(IBIFN)
  1. S IBCICAR=""
  1. S:IBCIINS IBCICAR=$P($G(^DIC(36,IBCIINS,0)),U,1)
  1. S IBCICAR=IBCICAR_IBCIPAD
  1. Q
  1. XIT ;
  1. Q