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

IBCSCE.m

Go to the documentation of this file.
  1. IBCSCE ;ALB/MRL,MJB - MCCR SCREEN EDITS ;07 JUN 88 14:35
  1. ;;2.0;INTEGRATED BILLING;**52,80,91,106,51,137,236,245,287,349,371,400,432,447,547,592**;21-MAR-94;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRSCE
  1. ; always do procedures last because they are edited upon return to screen routine
  1. I IBDR20["54," S IBDR20=$P(IBDR20,"54,",1)_$P(IBDR20,"54,",2)_"54,"
  1. I IBDR20["44," S IBDR20=$P(IBDR20,"44,",1)_$P(IBDR20,"44,",2)_"44,"
  1. LOOP N IBDRLP,IBDRL S IBDRLP=IBDR20 F IBDRL=1:1 S IBDR20=$P(IBDRLP,",",IBDRL) Q:IBDR20="" D EDIT
  1. Q
  1. EDIT N IBQUERY
  1. I (IBDR20["31") D MCCR^IBCNSP2 G ENQ
  1. I (IBDR20["43")!(IBDR20["52") D ^IBCSC4D G ENQ
  1. I (IBDR20["74")!(IBDR20["53") K DR N I D ^IBCOPV S (DA,Y)=IBIFN G TMPL
  1. I (IBDR20["54"),$P($G(^IBE(350.9,1,1)),"^",17) K DR N I D EN1^IBCCPT(.IBQUERY) D CLOSE^IBSDU(.IBQUERY) G TMPL ;
  1. I (IBDR20["55") D ^IBCSC5A G ENQ
  1. I (IBDR20["45")!(IBDR20["56") D ^IBCSC5B G ENQ
  1. I (IBDR20["66")!(IBDR20["76") D EDIT^IBCRBE(IBIFN) D ASKCMB^IBCU65(IBIFN) G ENQ
  1. I IBDR20["102",$$FT^IBCEF(IBIFN)=3 D EN^IBCSC10B G ENQ ; UB-04 patient reason for visit (screen 10, section 2)
  1. I IBDR20["105",$$FT^IBCEF(IBIFN)=2 D ^IBCSC10A G ENQ ; cms-1500 chiropractic data (screen 10, section 5)
  1. ;
  1. ;WCJ;IB*2.0*547
  1. ;I IBDR20["107",$$FT^IBCEF(IBIFN)=3 D EN1^IBCEP6 G ENQ ; UB-04 provider ID maintenance (screen 10, section 7)
  1. I IBDR20["108",$$FT^IBCEF(IBIFN)=3 D EN1^IBCEP6 G ENQ ; UB-04 provider ID maintenance (screen 10, section 8)
  1. ;
  1. ;WCJ;IB*2.0*547
  1. ;I IBDR20["109",$$FT^IBCEF(IBIFN)=2 D EN1^IBCEP6 G ENQ ; cms-1500 provider ID maintenance (screen 10, section 9)
  1. ;JWS;IB*2.0*592 US1108 - Dental form 7
  1. I IBDR20["110",$$FT^IBCEF(IBIFN)=2!($$FT^IBCEF(IBIFN)=7) D EN1^IBCEP6 G ENQ ; cms-1500 provider ID maintenance (screen 10, section 10); not a misprint it is screen *10 +section which is 110
  1. ;
  1. F Q=1:1:9 I IBDR20[("11"_Q) D EDIT^IBCSC11 G ENQ ; IB*2.0*447 BI
  1. TMPL N IBFLIAE S IBFLIAE=1 ;to invoke EN^DGREGAED from [IB SCREEN1]
  1. S DR="[IB SCREEN"_IBSR_IBSR1_"]",(DA,Y)=IBIFN,DIE="^DGCR(399,"
  1. D ^DIE K DIE,DR,DLAYGO
  1. I (IBDR20["61")!(IBDR20["71") I +$G(DGRVRCAL) D PROC^IBCU7A(IBIFN,1)
  1. ;
  1. ENQ ;
  1. K DIE,DR,IBDR1,IBDR20,DGDRD,DGDRS,DGDRS1,DA
  1. Q
  1. ;
  1. ;called by screen 3 (input template)
  1. UPDT F IBDD=0:0 S IBDD=$O(^DPT(DFN,.312,IBDD)) Q:IBDD'>0 S IBI1=^DPT(DFN,.312,IBDD,0) I $D(^DIC(36,+IBI1,0)),$P(^(0),"^",2)'="N" S IBDD(+IBI1)=IBI1
  1. F IBAIC=0:0 S IBAIC=$O(^DGCR(399,IBIFN,"AIC",IBAIC)) Q:IBAIC'>0 I $D(IBDD(IBAIC)) F IBI1="I1","I2","I3" I $D(^DGCR(399,IBIFN,IBI1)),+^(IBI1)=IBAIC,^(IBI1)'=IBDD(IBAIC) S ^DGCR(399,IBIFN,IBI1)=IBDD(IBAIC)
  1. K IBAIC,IBDD,IBI1 Q
  1. ;
  1. ;Edit patient's address using DGREGAED API
  1. EDADDR(IBDFN) ;
  1. I $G(IBFLIAE)'=1!(IBDFN=0) Q 0
  1. N IBFL S IBFL(1)=1
  1. N X,Y,DIE,DA,DR,DIDEL,DIW,DIEDA,DG,DICR
  1. D EN^DGREGAED(IBDFN,.IBFL)
  1. Q 1
  1. ;IBCSCE