- IBCBB13 ;ALB/BI - PROCEDURE AND LINE LEVEL PROVIDER EDITS ;5-OCT-2011
- ;;2.0;INTEGRATED BILLING;**447,608**;21-MAR-94;Build 90
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- IBLNTOT(IBIFN) ; Calculate Line total charges. IB*2.0*447 BI
- N X,SUM S SUM=0
- S X=0 F S X=$O(^DGCR(399,IBIFN,"RC",X)) Q:+X=0 D
- . S SUM=SUM+$P($G(^DGCR(399,IBIFN,"RC",X,0)),"^",4)
- Q SUM
- ;
- IBSYEI(IBIFN) ; Test for valid EIN/SY ID Values. IB*2.0*447 BI
- N X12CODE,RESULT,IBPIEN,IBWIEN,IBLIEN
- S RESULT=0
- ; Check Claim Level Providers
- S IBWIEN=IBIFN_","
- S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399,IBWIEN,128,"I")_",",.03)
- I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399,IBWIEN,122),"-","")'?9N S RESULT=1 Q RESULT
- S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399,IBWIEN,129,"I")_",",.03)
- I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399,IBWIEN,123),"-","")'?9N S RESULT=1 Q RESULT
- S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399,IBWIEN,130,"I")_",",.03)
- I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399,IBWIEN,124),"-","")'?9N S RESULT=1 Q RESULT
- ; Check Claim Level Providers
- S IBPIEN=0 F S IBPIEN=$O(^DGCR(399,IBIFN,"PRV",IBPIEN)) Q:+IBPIEN=0 Q:RESULT=1 D
- .S IBWIEN=IBPIEN_","_IBIFN_","
- .; Test for each provider listed.
- .S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0222,IBWIEN,.12,"I")_",",.03)
- .I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399.0222,IBWIEN,.05),"-","")'?9N S RESULT=1 Q
- .S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0222,IBWIEN,.13,"I")_",",.03)
- .I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399.0222,IBWIEN,.06),"-","")'?9N S RESULT=1 Q
- .S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0222,IBWIEN,.14,"I")_",",.03)
- .I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399.0222,IBWIEN,.07),"-","")'?9N S RESULT=1 Q
- ; Check Line Level Providers
- ; For each charge code / line.
- S IBLIEN=0 F S IBLIEN=$O(^DGCR(399,IBIFN,"CP",IBLIEN)) Q:+IBLIEN=0 Q:RESULT=1 D
- .; For each provider associated with the line.
- .S IBPIEN=0 F S IBPIEN=$O(^DGCR(399,IBIFN,"CP",IBLIEN,"LNPRV",IBPIEN)) Q:+IBPIEN=0 Q:RESULT=1 D
- ..S IBWIEN=IBPIEN_","_IBLIEN_","_IBIFN_","
- ..; Test for each provider listed.
- ..S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0404,IBWIEN,.12,"I")_",",.03)
- ..I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399.0404,IBWIEN,.05),"-","")'?9N S RESULT=1 Q
- ..S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0404,IBWIEN,.13,"I")_",",.03)
- ..I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399.0404,IBWIEN,.06),"-","")'?9N S RESULT=1 Q
- ..S X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0404,IBWIEN,.14,"I")_",",.03)
- ..I ((X12CODE="SY")!(X12CODE="EI")),$TR($$GET1^DIQ(399.0404,IBWIEN,.07),"-","")'?9N S RESULT=1 Q
- Q RESULT
- ;
- IBMICN(IBIFN) ; Test for a missing ICN. IB*2.0*447 BI
- N IBTFOB ; TIMEFRAME OF BILL
- N IBCBPS ; CURRENT BILL PAYER SEQUENCE, P-PRI, S-SEC, T-TER, A-PATIENT
- S IBTFOB=$$GET1^DIQ(399,IBIFN_",",.06,"I")
- I '((IBTFOB=7)!(IBTFOB=8)) Q 0
- S IBCBPS=$$GET1^DIQ(399,IBIFN_",",.21,"I")
- I IBCBPS="P",$$GET1^DIQ(399,IBIFN_",",101)'="",$$GET1^DIQ(399,IBIFN_",",453)="" Q 1
- I IBCBPS="S",$$GET1^DIQ(399,IBIFN_",",102)'="",$$GET1^DIQ(399,IBIFN_",",454)="" Q 1
- I IBCBPS="T",$$GET1^DIQ(399,IBIFN_",",103)'="",$$GET1^DIQ(399,IBIFN_",",455)="" Q 1
- Q 0
- ;
- IBRCCHK(IBIFN) ; Test for a ZERO charge amounts. IB*2.0*447 BI
- N IBN0
- N IBRCCNT S IBRCCNT=0
- N IBRCCHG S IBRCCHG=0
- F S IBRCCNT=$O(^DGCR(399,IBIFN,"RC",IBRCCNT)) Q:+IBRCCNT=0 Q:IBRCCHG=1 D
- .S IBN0=$G(^DGCR(399,IBIFN,"RC",IBRCCNT,0))
- .I $P(IBN0,U,1)'="",+$P(IBN0,U,4)=0 S IBRCCHG=1
- Q IBRCCHG
- ;
- IBPRV3(IBIFN) ; Test for missing "Patient reason for visit". IB*2.0*447 BI
- I $$GET1^DIQ(399,IBIFN_",",249)="",$$GET1^DIQ(399,IBIFN_",",250)="",$$GET1^DIQ(399,IBIFN_",",251)="" Q 1
- Q 0
- ;
- IBMPID(IBIFN) ; Test for multiple payers. IB*2.0*447 BI
- N IBPAY1 S IBPAY1=$$GET1^DIQ(399,IBIFN_",",101,"I")
- N IBPAY2 S IBPAY2=$$GET1^DIQ(399,IBIFN_",",102,"I")
- N IBPAY3 S IBPAY3=$$GET1^DIQ(399,IBIFN_",",103,"I")
- N IBCNT S IBCNT=0
- S:IBPAY1 IBCNT=IBCNT+1 S:IBPAY2 IBCNT=IBCNT+1 S:IBPAY3 IBCNT=IBCNT+1 I IBCNT<2 Q 0
- N IBINSTIT S IBINSTIT=$$INSPRF^IBCEF(IBIFN)
- I IBPAY1,$S(IBINSTIT:$$GET1^DIQ(36,IBPAY1_",",3.04),1:$$GET1^DIQ(36,IBPAY1_",",3.02))="" Q 1
- I IBPAY2,$S(IBINSTIT:$$GET1^DIQ(36,IBPAY2_",",3.04),1:$$GET1^DIQ(36,IBPAY2_",",3.02))="" Q 1
- I IBPAY3,$S(IBINSTIT:$$GET1^DIQ(36,IBPAY3_",",3.04),1:$$GET1^DIQ(36,IBPAY3_",",3.02))="" Q 1
- Q 0
- ;
- CMNCHK(IBIFN) ;JRA;IB*2.0*608 Check for missing required Certificate of Medical Necessity (CMN) data
- ; Input : IBIFN = IEN of the Bill/Claim (D399)
- ; Output: IBER = NULL if no errors
- ; = String of IB Error Message codes delimited by ';'
- ; => Note that the return value is appended to the 'IBER' variable in routine ^IBCBB1
- Q:IBIFN="" ""
- N CERTYP,CMNNODE,CMNREQ,DA,DIE,ERR,FRMNAM,FRMIEN,FORM,FRMTYP,IBER,IBPROCP,PROCNUM
- S IBER=""
- ;Set up array of each existing Form Type (i.e. Form IENs) and associated ^DGCR data node.
- S FRMNAM="" F S FRMNAM=$O(^IBE(399.6,"B",FRMNAM)) Q:FRMNAM="" S FRMIEN=+$O(^IBE(399.6,"B",FRMNAM,"")) I FRMIEN D
- . S FORM(FRMIEN)=$P($G(^IBE(399.6,FRMIEN,0)),U,4)
- ;Loop thru all procedures on the claim searching for missing CMN data
- S IBPROCP=0 F S IBPROCP=$O(^DGCR(399,IBIFN,"CP",IBPROCP)) Q:'IBPROCP D Q:IBER]""
- . ;If "CMN Required?" is NULL then QUIT w/out further checking
- . S CMNREQ=$$CVALCHK(IBPROCP,23,,"I") Q:CMNREQ=""
- . I 'CMNREQ,$D(FORM)>1 D Q ;"CMN Required?" flagged as "NO" so check if data node(s) exist anyway for at least 1 form
- . . S ERR=0,FRMIEN="" F S FRMIEN=$O(FORM(FRMIEN)) Q:FRMIEN="" I FORM(FRMIEN)]"" D Q:ERR
- . . . S CMNNODE="^DGCR(399,"_IBIFN_",""CP"","_IBPROCP_","""_FORM(FRMIEN)_""")" I $D(@CMNNODE) S ERR=1,IBER=IBER_"IB901;"
- . S FRMTYP=$$CVALCHK(IBPROCP,24,"IB902","I") Q:'FRMTYP ;Check for "CMN FORM TYPE" (Internal value)
- . I $G(FORM(FRMTYP))]"" D Q:ERR
- . . ;Check if any data exists at the node specific to the Form Type
- . . S ERR=0,CMNNODE="^DGCR(399,"_IBIFN_",""CP"","_IBPROCP_","""_FORM(FRMTYP)_""")"
- . . I '$D(@CMNNODE) S ERR=1,IBER=IBER_"IB903;" Q
- . . Q:FORM(FRMTYP)'[10126
- . . N ND10126
- . . S ND10126=@CMNNODE
- . . I $P(ND10126,U,17)]"" S $P(ND10126,U,17)="" I $TR(ND10126,U)="" S ERR=1,IBER=IBER_"IB903;"
- . ;Check if any data exists for at least 1 node other than that associated with the Form Type
- . S ERR=0,FRMIEN="" F S FRMIEN=$O(FORM(FRMIEN)) Q:FRMIEN="" I FRMIEN'=FRMTYP,FORM(FRMIEN)]"" D Q:ERR
- . . S CMNNODE="^DGCR(399,"_IBIFN_",""CP"","_IBPROCP_","""_FORM(FRMIEN)_""")" I $D(@CMNNODE) S ERR=1,IBER=IBER_"IB904;"
- . ;Check for Required fields at the data node common to all forms (node 'CMN')
- . S CERTYP=$$CVALCHK(IBPROCP,24.01,"IB905","I") Q:CERTYP="" ;Check for "CMN CERTIFICATION TYPE"
- . D CVALCHK(IBPROCP,24.05,"IB907","I") ;Check for "CMN DATE THERAPY STARTED"
- . D CVALCHK(IBPROCP,24.06,"IB908","I") ;Check for "CMN LAST CERTIFICATION DATE"
- . ;IF Certificate Type is "RENEWAL" (R) or "REVISED" (S) then "CMN RECERTIFICATION/REVISN DT" is Required.
- . I CERTYP="R"!(CERTYP="S") D CVALCHK(IBPROCP,24.07,"IB909","I")
- . ;
- . ;Check for required fields specific to the CMN-484 form
- . I FORM(FRMTYP)[484 D ;Check for required fields/dates
- . . I $$CVALCHK(IBPROCP,24.1,,"I")]""!($$CVALCHK(IBPROCP,24.102,,"I")]"") D CVALCHK(IBPROCP,24.103,"IB912","I")
- . . I $$CVALCHK(IBPROCP,24.111,,"I")]""!($$CVALCHK(IBPROCP,24.113,,"I")]"") D CVALCHK(IBPROCP,24.114,"IB914","I")
- . ;
- . ;Check for required fields specific to the CMN-10126 form
- . I FORM(FRMTYP)[10126 D
- . . D CVALCHK(IBPROCP,24.217,"IB906","I")
- . . N PROCMSG
- . . S PROCMSG="CMN ""Procedure ",PROCMSG(1)=""" has no associated Calories."
- . . I $$CVALCHK(IBPROCP,24.204,,"I")]"",'$$CVALCHK(IBPROCP,24.203,,"I") D WARN^IBCBB11(PROCMSG_"A"_PROCMSG(1))
- . . I $$CVALCHK(IBPROCP,24.219,,"I")]"",'$$CVALCHK(IBPROCP,24.218,,"I") D WARN^IBCBB11(PROCMSG_"B"_PROCMSG(1))
- ;
- I IBER]"" S IBER="IB915;"_IBER
- Q IBER
- ;
- CVALCHK(IBPROCP,FLD,ERROR,FLG) ;JRA;IB*2.0*608 Check value of CMN field & append Error Code (if any) to list of errors
- Q:($G(FLD)=""!('$G(IBPROCP)))
- N VAL
- S VAL=$$CMNDATA^IBCEF31(IBIFN,IBPROCP,FLD,$G(FLG))
- I $G(ERROR)]"",VAL="" S IBER=IBER_ERROR_";"
- Q VAL
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB13 8284 printed Mar 13, 2025@21:13:38 Page 2
- IBCBB13 ;ALB/BI - PROCEDURE AND LINE LEVEL PROVIDER EDITS ;5-OCT-2011
- +1 ;;2.0;INTEGRATED BILLING;**447,608**;21-MAR-94;Build 90
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- IBLNTOT(IBIFN) ; Calculate Line total charges. IB*2.0*447 BI
- +1 NEW X,SUM
- SET SUM=0
- +2 SET X=0
- FOR
- SET X=$ORDER(^DGCR(399,IBIFN,"RC",X))
- if +X=0
- QUIT
- Begin DoDot:1
- +3 SET SUM=SUM+$PIECE($GET(^DGCR(399,IBIFN,"RC",X,0)),"^",4)
- End DoDot:1
- +4 QUIT SUM
- +5 ;
- IBSYEI(IBIFN) ; Test for valid EIN/SY ID Values. IB*2.0*447 BI
- +1 NEW X12CODE,RESULT,IBPIEN,IBWIEN,IBLIEN
- +2 SET RESULT=0
- +3 ; Check Claim Level Providers
- +4 SET IBWIEN=IBIFN_","
- +5 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399,IBWIEN,128,"I")_",",.03)
- +6 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399,IBWIEN,122),"-","")'?9N
- SET RESULT=1
- QUIT RESULT
- +7 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399,IBWIEN,129,"I")_",",.03)
- +8 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399,IBWIEN,123),"-","")'?9N
- SET RESULT=1
- QUIT RESULT
- +9 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399,IBWIEN,130,"I")_",",.03)
- +10 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399,IBWIEN,124),"-","")'?9N
- SET RESULT=1
- QUIT RESULT
- +11 ; Check Claim Level Providers
- +12 SET IBPIEN=0
- FOR
- SET IBPIEN=$ORDER(^DGCR(399,IBIFN,"PRV",IBPIEN))
- if +IBPIEN=0
- QUIT
- if RESULT=1
- QUIT
- Begin DoDot:1
- +13 SET IBWIEN=IBPIEN_","_IBIFN_","
- +14 ; Test for each provider listed.
- +15 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0222,IBWIEN,.12,"I")_",",.03)
- +16 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399.0222,IBWIEN,.05),"-","")'?9N
- SET RESULT=1
- QUIT
- +17 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0222,IBWIEN,.13,"I")_",",.03)
- +18 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399.0222,IBWIEN,.06),"-","")'?9N
- SET RESULT=1
- QUIT
- +19 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0222,IBWIEN,.14,"I")_",",.03)
- +20 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399.0222,IBWIEN,.07),"-","")'?9N
- SET RESULT=1
- QUIT
- End DoDot:1
- +21 ; Check Line Level Providers
- +22 ; For each charge code / line.
- +23 SET IBLIEN=0
- FOR
- SET IBLIEN=$ORDER(^DGCR(399,IBIFN,"CP",IBLIEN))
- if +IBLIEN=0
- QUIT
- if RESULT=1
- QUIT
- Begin DoDot:1
- +24 ; For each provider associated with the line.
- +25 SET IBPIEN=0
- FOR
- SET IBPIEN=$ORDER(^DGCR(399,IBIFN,"CP",IBLIEN,"LNPRV",IBPIEN))
- if +IBPIEN=0
- QUIT
- if RESULT=1
- QUIT
- Begin DoDot:2
- +26 SET IBWIEN=IBPIEN_","_IBLIEN_","_IBIFN_","
- +27 ; Test for each provider listed.
- +28 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0404,IBWIEN,.12,"I")_",",.03)
- +29 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399.0404,IBWIEN,.05),"-","")'?9N
- SET RESULT=1
- QUIT
- +30 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0404,IBWIEN,.13,"I")_",",.03)
- +31 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399.0404,IBWIEN,.06),"-","")'?9N
- SET RESULT=1
- QUIT
- +32 SET X12CODE=$$GET1^DIQ(355.97,$$GET1^DIQ(399.0404,IBWIEN,.14,"I")_",",.03)
- +33 IF ((X12CODE="SY")!(X12CODE="EI"))
- IF $TRANSLATE($$GET1^DIQ(399.0404,IBWIEN,.07),"-","")'?9N
- SET RESULT=1
- QUIT
- End DoDot:2
- End DoDot:1
- +34 QUIT RESULT
- +35 ;
- IBMICN(IBIFN) ; Test for a missing ICN. IB*2.0*447 BI
- +1 ; TIMEFRAME OF BILL
- NEW IBTFOB
- +2 ; CURRENT BILL PAYER SEQUENCE, P-PRI, S-SEC, T-TER, A-PATIENT
- NEW IBCBPS
- +3 SET IBTFOB=$$GET1^DIQ(399,IBIFN_",",.06,"I")
- +4 IF '((IBTFOB=7)!(IBTFOB=8))
- QUIT 0
- +5 SET IBCBPS=$$GET1^DIQ(399,IBIFN_",",.21,"I")
- +6 IF IBCBPS="P"
- IF $$GET1^DIQ(399,IBIFN_",",101)'=""
- IF $$GET1^DIQ(399,IBIFN_",",453)=""
- QUIT 1
- +7 IF IBCBPS="S"
- IF $$GET1^DIQ(399,IBIFN_",",102)'=""
- IF $$GET1^DIQ(399,IBIFN_",",454)=""
- QUIT 1
- +8 IF IBCBPS="T"
- IF $$GET1^DIQ(399,IBIFN_",",103)'=""
- IF $$GET1^DIQ(399,IBIFN_",",455)=""
- QUIT 1
- +9 QUIT 0
- +10 ;
- IBRCCHK(IBIFN) ; Test for a ZERO charge amounts. IB*2.0*447 BI
- +1 NEW IBN0
- +2 NEW IBRCCNT
- SET IBRCCNT=0
- +3 NEW IBRCCHG
- SET IBRCCHG=0
- +4 FOR
- SET IBRCCNT=$ORDER(^DGCR(399,IBIFN,"RC",IBRCCNT))
- if +IBRCCNT=0
- QUIT
- if IBRCCHG=1
- QUIT
- Begin DoDot:1
- +5 SET IBN0=$GET(^DGCR(399,IBIFN,"RC",IBRCCNT,0))
- +6 IF $PIECE(IBN0,U,1)'=""
- IF +$PIECE(IBN0,U,4)=0
- SET IBRCCHG=1
- End DoDot:1
- +7 QUIT IBRCCHG
- +8 ;
- IBPRV3(IBIFN) ; Test for missing "Patient reason for visit". IB*2.0*447 BI
- +1 IF $$GET1^DIQ(399,IBIFN_",",249)=""
- IF $$GET1^DIQ(399,IBIFN_",",250)=""
- IF $$GET1^DIQ(399,IBIFN_",",251)=""
- QUIT 1
- +2 QUIT 0
- +3 ;
- IBMPID(IBIFN) ; Test for multiple payers. IB*2.0*447 BI
- +1 NEW IBPAY1
- SET IBPAY1=$$GET1^DIQ(399,IBIFN_",",101,"I")
- +2 NEW IBPAY2
- SET IBPAY2=$$GET1^DIQ(399,IBIFN_",",102,"I")
- +3 NEW IBPAY3
- SET IBPAY3=$$GET1^DIQ(399,IBIFN_",",103,"I")
- +4 NEW IBCNT
- SET IBCNT=0
- +5 if IBPAY1
- SET IBCNT=IBCNT+1
- if IBPAY2
- SET IBCNT=IBCNT+1
- if IBPAY3
- SET IBCNT=IBCNT+1
- IF IBCNT<2
- QUIT 0
- +6 NEW IBINSTIT
- SET IBINSTIT=$$INSPRF^IBCEF(IBIFN)
- +7 IF IBPAY1
- IF $SELECT(IBINSTIT:$$GET1^DIQ(36,IBPAY1_",",3.04),1:$$GET1^DIQ(36,IBPAY1_",",3.02))=""
- QUIT 1
- +8 IF IBPAY2
- IF $SELECT(IBINSTIT:$$GET1^DIQ(36,IBPAY2_",",3.04),1:$$GET1^DIQ(36,IBPAY2_",",3.02))=""
- QUIT 1
- +9 IF IBPAY3
- IF $SELECT(IBINSTIT:$$GET1^DIQ(36,IBPAY3_",",3.04),1:$$GET1^DIQ(36,IBPAY3_",",3.02))=""
- QUIT 1
- +10 QUIT 0
- +11 ;
- CMNCHK(IBIFN) ;JRA;IB*2.0*608 Check for missing required Certificate of Medical Necessity (CMN) data
- +1 ; Input : IBIFN = IEN of the Bill/Claim (D399)
- +2 ; Output: IBER = NULL if no errors
- +3 ; = String of IB Error Message codes delimited by ';'
- +4 ; => Note that the return value is appended to the 'IBER' variable in routine ^IBCBB1
- +5 if IBIFN=""
- QUIT ""
- +6 NEW CERTYP,CMNNODE,CMNREQ,DA,DIE,ERR,FRMNAM,FRMIEN,FORM,FRMTYP,IBER,IBPROCP,PROCNUM
- +7 SET IBER=""
- +8 ;Set up array of each existing Form Type (i.e. Form IENs) and associated ^DGCR data node.
- +9 SET FRMNAM=""
- FOR
- SET FRMNAM=$ORDER(^IBE(399.6,"B",FRMNAM))
- if FRMNAM=""
- QUIT
- SET FRMIEN=+$ORDER(^IBE(399.6,"B",FRMNAM,""))
- IF FRMIEN
- Begin DoDot:1
- +10 SET FORM(FRMIEN)=$PIECE($GET(^IBE(399.6,FRMIEN,0)),U,4)
- End DoDot:1
- +11 ;Loop thru all procedures on the claim searching for missing CMN data
- +12 SET IBPROCP=0
- FOR
- SET IBPROCP=$ORDER(^DGCR(399,IBIFN,"CP",IBPROCP))
- if 'IBPROCP
- QUIT
- Begin DoDot:1
- +13 ;If "CMN Required?" is NULL then QUIT w/out further checking
- +14 SET CMNREQ=$$CVALCHK(IBPROCP,23,,"I")
- if CMNREQ=""
- QUIT
- +15 ;"CMN Required?" flagged as "NO" so check if data node(s) exist anyway for at least 1 form
- IF 'CMNREQ
- IF $DATA(FORM)>1
- Begin DoDot:2
- +16 SET ERR=0
- SET FRMIEN=""
- FOR
- SET FRMIEN=$ORDER(FORM(FRMIEN))
- if FRMIEN=""
- QUIT
- IF FORM(FRMIEN)]""
- Begin DoDot:3
- +17 SET CMNNODE="^DGCR(399,"_IBIFN_",""CP"","_IBPROCP_","""_FORM(FRMIEN)_""")"
- IF $DATA(@CMNNODE)
- SET ERR=1
- SET IBER=IBER_"IB901;"
- End DoDot:3
- if ERR
- QUIT
- End DoDot:2
- QUIT
- +18 ;Check for "CMN FORM TYPE" (Internal value)
- SET FRMTYP=$$CVALCHK(IBPROCP,24,"IB902","I")
- if 'FRMTYP
- QUIT
- +19 IF $GET(FORM(FRMTYP))]""
- Begin DoDot:2
- +20 ;Check if any data exists at the node specific to the Form Type
- +21 SET ERR=0
- SET CMNNODE="^DGCR(399,"_IBIFN_",""CP"","_IBPROCP_","""_FORM(FRMTYP)_""")"
- +22 IF '$DATA(@CMNNODE)
- SET ERR=1
- SET IBER=IBER_"IB903;"
- QUIT
- +23 if FORM(FRMTYP)'[10126
- QUIT
- +24 NEW ND10126
- +25 SET ND10126=@CMNNODE
- +26 IF $PIECE(ND10126,U,17)]""
- SET $PIECE(ND10126,U,17)=""
- IF $TRANSLATE(ND10126,U)=""
- SET ERR=1
- SET IBER=IBER_"IB903;"
- End DoDot:2
- if ERR
- QUIT
- +27 ;Check if any data exists for at least 1 node other than that associated with the Form Type
- +28 SET ERR=0
- SET FRMIEN=""
- FOR
- SET FRMIEN=$ORDER(FORM(FRMIEN))
- if FRMIEN=""
- QUIT
- IF FRMIEN'=FRMTYP
- IF FORM(FRMIEN)]""
- Begin DoDot:2
+29 SET CMNNODE="^DGCR(399,"_IBIFN_",""CP"","_IBPROCP_","""_FORM(FRMIEN)_""")"
IF $DATA(@CMNNODE)
SET ERR=1
SET IBER=IBER_"IB904;"
End DoDot:2
if ERR
QUIT
+30 ;Check for Required fields at the data node common to all forms (node 'CMN')
+31 ;Check for "CMN CERTIFICATION TYPE"
SET CERTYP=$$CVALCHK(IBPROCP,24.01,"IB905","I")
if CERTYP=""
QUIT
+32 ;Check for "CMN DATE THERAPY STARTED"
DO CVALCHK(IBPROCP,24.05,"IB907","I")
+33 ;Check for "CMN LAST CERTIFICATION DATE"
DO CVALCHK(IBPROCP,24.06,"IB908","I")
+34 ;IF Certificate Type is "RENEWAL" (R) or "REVISED" (S) then "CMN RECERTIFICATION/REVISN DT" is Required.
+35 IF CERTYP="R"!(CERTYP="S")
DO CVALCHK(IBPROCP,24.07,"IB909","I")
+36 ;
+37 ;Check for required fields specific to the CMN-484 form
+38 ;Check for required fields/dates
IF FORM(FRMTYP)[484
Begin DoDot:2
+39 IF $$CVALCHK(IBPROCP,24.1,,"I")]""!($$CVALCHK(IBPROCP,24.102,,"I")]"")
DO CVALCHK(IBPROCP,24.103,"IB912","I")
+40 IF $$CVALCHK(IBPROCP,24.111,,"I")]""!($$CVALCHK(IBPROCP,24.113,,"I")]"")
DO CVALCHK(IBPROCP,24.114,"IB914","I")
End DoDot:2
+41 ;
+42 ;Check for required fields specific to the CMN-10126 form
+43 IF FORM(FRMTYP)[10126
Begin DoDot:2
+44 DO CVALCHK(IBPROCP,24.217,"IB906","I")
+45 NEW PROCMSG
+46 SET PROCMSG="CMN ""Procedure "
SET PROCMSG(1)=""" has no associated Calories."
+47 IF $$CVALCHK(IBPROCP,24.204,,"I")]""
IF '$$CVALCHK(IBPROCP,24.203,,"I")
DO WARN^IBCBB11(PROCMSG_"A"_PROCMSG(1))
+48 IF $$CVALCHK(IBPROCP,24.219,,"I")]""
IF '$$CVALCHK(IBPROCP,24.218,,"I")
DO WARN^IBCBB11(PROCMSG_"B"_PROCMSG(1))
End DoDot:2
End DoDot:1
if IBER]""
QUIT
+49 ;
+50 IF IBER]""
SET IBER="IB915;"_IBER
+51 QUIT IBER
+52 ;
CVALCHK(IBPROCP,FLD,ERROR,FLG) ;JRA;IB*2.0*608 Check value of CMN field & append Error Code (if any) to list of errors
+1 if ($GET(FLD)=""!('$GET(IBPROCP)))
QUIT
+2 NEW VAL
+3 SET VAL=$$CMNDATA^IBCEF31(IBIFN,IBPROCP,FLD,$GET(FLG))
+4 IF $GET(ERROR)]""
IF VAL=""
SET IBER=IBER_ERROR_";"
+5 QUIT VAL
+6 ;
