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

IBCVC.m

Go to the documentation of this file.
IBCVC ;ALB/WCJ - VALUE CODE FUNCTIONALITY ;25-JUN-07
 ;;2.0;INTEGRATED BILLING;**371,400,432,718,732**;21-MAR-94;Build 13
 ;;Per VA Directive 6402, this routine should not be modified.
 G AWAY
AWAY Q
 ;
ALLOWVC(IBIFN,Y)   ; see if the value code is obsolete.
 ; returns 0 = Not Allowed/Obsolete
 ; returns 1 = Allowed
 ;
 N OBSDT,SCF
 S OBSDT=$$GET1^DIQ(399.1,Y,.26,"I")
 D CLEAN^DILF
 Q:'+OBSDT 1  ; If there is no obsolete date, were cool
 ;
 S SCF=$$GET1^DIQ(399,IBIFN,151,"I")  ; get the statement covers from date to compare with
 D CLEAN^DILF
 I 'SCF Q 0  ; if there is none, not sure where to go with this.  It's required so I say fail.
 ;
 I SCF>OBSDT Q 0
 ;
 Q 1
 ;
HELP ;
 Q:'$G(DA)
 Q:'$G(DA(1))
 Q:'$D(^DGCR(399,DA(1),"CV",DA,0))
 N VCPTR
 S VCPTR=$P($G(^DGCR(399,DA(1),"CV",DA,0)),U)
 Q:VCPTR=""
 Q:'$D(^DGCR(399.1,VCPTR,1))
 N LOOP
 S LOOP=0 F  S LOOP=$O(^DGCR(399.1,VCPTR,1,LOOP)) Q:'+LOOP  D
 . W !,$G(^(LOOP,0))
 Q
 ;
FORMCHK(X,DA) ; Check to make sure that the VALUE is in the correct format base on the VALUE CODE.
 ; This tag is the input transform for the VALUE field (Sub-File 399.047, field .02).
 ; 
 ; X = data being verified
 ; DA = subfile entry
 ; DA(1) = IEN to 399
 ; 
 ; returns
 ; 0 = invalid format
 ; 1 = valid format
 ; 
 Q:'$G(DA) 0
 Q:'$G(DA(1)) 0
 Q:'$D(^DGCR(399,DA(1),"CV",DA,0)) 0
 ;
 N VCPTR
 S VCPTR=$P($G(^DGCR(399,DA(1),"CV",DA,0)),U)
 Q:VCPTR="" 0
 ;
 Q $$CHK(VCPTR,X)
 ;
CHK(VCPTR,X) ; This tag is called from the input transform above and also from the IB edit check routines (IBCBB*) 
 ; This function is passed in:
 ; VCPTR - pointer into file #399.1
 ; X - the VALUE being checked
 ; Returns:
 ; 0 or false - Invalid format or can't figure it out.
 ; 1 or true  - valid format (or in the case of 24, defined at the state level)
 ;
 N CODE,OK
 S CODE=$$GET1^DIQ(399.1,VCPTR_",",.02,"I")
 D CLEAN^DILF
 Q:CODE="" 0
 ;
 N AMTFLG
 ;
 ; Check to see if it goes out as a monetary amount.
 S AMTFLG=$$GET1^DIQ(399.1,VCPTR_",",.19,"I")
 D CLEAN^DILF
 I AMTFLG Q X?1(1.7N,.7N1"."1.2N)
 ;
 ; Medicaid Rate Code (This is defined at the state level)
 ;TPF;IB*2.0*718;EBILL-1570;11/22/2021
 I CODE=24 Q X?1.9AN&'(X?2"0"."0")
 ;Q:CODE=24 1
 ;
 ; Accident Hour
 I CODE=45 Q ".00.01.02.03.04.05.06.07.08.09.10.11.12.13.14.15.16.17.18.19.20.21.22.23.99."[("."_X_".")
 ;
 ; Whole Numbers
 ;TPF;IB*2.0*718;EBILL-1570;11/22/2021 ADD NEW VC WHOLE NUMBERS (NUMERIC STRING)
 I ".G8.62.63.32.37.38.39.46.50.51.52.53.56.57.58.59.67.68.69.80.81.82.83.84."[("."_CODE_".") Q X?1.7N&'(X?2"0"."0")
 I ".D4."[("."_CODE_".") Q X?1.9N&'(X?2"0"."0")
 ;I ".37.38.39.46.50.51.52.53.56.57.58.59.67.68.80.81.82."[("."_CODE_".") Q X?1.7N
 ;
 ; Zip
 I CODE="A0" Q X?5N&'(X?5"0")
 ;
 ;I ".48.49."[("."_CODE_".") S OK=1 D  Q OK
 ;I ".54.48.49.A8.A9.D5."[("."_CODE_".") S OK=1 D  Q OK  ;TPF;IB*2.0*718;EBILL-1570;11/22/2021 ADD NEW VC DECIMAL NUMBERS (DECIMALS)
 ;. I $P(X,".")'?.2N S OK=0 Q
 ;. I $P(X,".",2,999)'?.1N S OK=0 Q
 ;. I $E(X,$L(X))="." S OK=0 Q
 ;ISSUE P718 DEAL WITH DECIMALS
 S OK=0
 I ".48.49."[("."_CODE_".") D  Q OK  ;HEMOGLOBIN AND HEMATOCRIT NN.NN
 .S OK=(X?1.2N.1".".2N)&(X'?3.N)&($E(X,$L(X))'=".")
 ;
 I ".A8.A9."[("."_CODE_".") D  Q OK  ;HEIGHT AND WEIGHT   NNN.NN   weight in Kg, Height in cm
 .S OK=(X?1.3N.1".".2N)&(X'?4.N)&($E(X,$L(X))'=".")
 ;
 I ".D5."[("."_CODE_".") D  Q OK  ;LAST KT  NN.NN
 .S OK=(X?1.2N1".".2N)&($E(X,$L(X))'=".")
 ;
 I ".54."[("."_CODE_".") D  Q OK  ;NEWBORN WEIGHT NNNN.NN
 .S OK=(X?1.4N.1".".2N)&(X'?5.N)&($E(X,$L(X))'=".")
 ;END DECIMALS
 ;
 ; Alpha Numeric, no punctuation
 I ".60.61."[("."_CODE_".") Q X?1.7AN&'(X?2"0"."0")
 Q 1
 ;
 ;TPF;IB*2.0*718;EBILL-1570;11/22/2021
PATCH718CHK(IEN) ;EP - CALLED FROM KIDS BUILD DATA SCREEN FOR FILE #399.1
 I (U_58_U_79_U_80_U_642_U_643_U_639_U_678_U_689_U)[(U_IEN_U) Q 1
 I $$NUMRANGE(IEN,60,62) Q 1
 I $$NUMRANGE(IEN,45,47) Q 1
 I $$NUMRANGE(IEN,74,76) Q 1
 I $$NUMRANGE(IEN,82,84) Q 1
 I $$NUMRANGE(IEN,86,91) Q 1
 I $$NUMRANGE(IEN,94,99) Q 1
 I $$NUMRANGE(IEN,102,104) Q 1
 I $$NUMRANGE(IEN,265,268) Q 1
 I $$NUMRANGE(IEN,587,590) Q 1
 I $$NUMRANGE(IEN,634,638) Q 1
 Q 0
 ;
 ;TPF;IB*2.0*718;EBILL-1570;11/22/2021
NUMRANGE(X,LOW,HIGH) ;EP - NUMBER RANGE CHECK
 ;RETURNS 1 IF X LIES WITHIN NUMBER RANGE
 I (X=LOW!(X>LOW)),(X<HIGH!(X=HIGH)) Q 1
 Q 0
 ;
 ;
 ;#.02 CODE #399.1 MCCR UTILITY ^ #.02 VALUE #399.047 VALUE CODE #399 BILL/CLAIMS ^ #.19 VALUE CODE AMOUNT #399.1 MCCR UTILITY ^ VALUE CODE IEN #399.1
 ;IBXSAVE("VALUE",1)="48^15^0^92"
 ;IBXSAVE("VALUE",2)="49^45.2^0^93"
 ;IBXSAVE("VALUE",3)="A9^32.9^^592"
 ;IBXSAVE("VALUE",4)="A8^60^^591"
 ;IBXSAVE("VALUE",5)="A3^22691.94^1"
 ;
 ;USE THIS IN PLACE OF CALL TO $$DOLLAR IN FILE #FORMAT CODE 
VALCODEFMT(IBSAVE,IBDATA) ;EP - TAKE VALUE CODE ARRAY AND FORMAT EACH ACCORDINGTO DATA TYPE 
 N DOLLARAMT,VALCODEIEN,VALCODENAME,VALUE,DATATYPE ;WCJ;IB718;SQA
 N TESTING
 S TESTING=0  ;SET TO ONE IF TESTING TO SHOW DISPLAY HELPERS
 Q:'$O(IBSAVE("VALUE",""))
 W:$G(TESTING) !?25,"VC1-VC24 AMT FIELD"
 W:$G(TESTING) !?25,"|123456789|",?40,"VALUE CODE",?55,"VALUE CODE NAME"
 W:$G(TESTING) !?25,"-----------"
 N IEN
 S IEN=0
 F  S IEN=$O(IBSAVE("VALUE",IEN)) Q:'IEN  D
 .S VALUECODE=$P(IBSAVE("VALUE",IEN),U)
 .S VALUE=$P(IBSAVE("VALUE",IEN),U,2)        ;SUBFILE #399.047 FIELD #.02 OF FILE #399  
 .S DOLLARAMT=$P(IBSAVE("VALUE",IEN),U,3)   ;FILE #399.1 MCCR UTILITY FIELD #.19 VALUE CODE AMOUNT
 .S VALCODEIEN=$P(IBSAVE("VALUE",IEN),U,4)
 .I 'VALCODEIEN S VALCODEIEN=$O(^DGCR(399.1,"C",VALUECODE,0))
 .S VALCODENAME=""
 .S:VALCODEIEN VALCODENAME=$P($G(^DGCR(399.1,VALCODEIEN,0)),U)
 .;
 .I DOLLARAMT S IBDATA(IEN)=$$FMTDOLLAR(VALUE) Q
 .;
 .;IF ITS NOT EXPLICITLY DECLARED A DOLLAR AMOUNT BY THE SETTING OF FIELD #.19 THE WE NEED TO DETERMINE
 .;THE DATA TYPE AND LOOK AT THE ALLOWED VALUE FORMATS BASED ON THE HISTORICAL CODE IN CHK^.
 .;
 .S DATATYPE=$$DATATYPE(VALUECODE,VALUE,0)
 .I DATATYPE="FMTNUMERIC" S IBDATA(IEN)=$$FMTNUMERIC(VALUE) Q
 .I DATATYPE="FMTALPHANUM" S IBDATA(IEN)=$$FMTALPHANUM(VALUE) Q
 .I DATATYPE="FMTDECIMAL" S IBDATA(IEN)=$$FMTDECIMAL(VALUE) Q
 .E  S IBDATA(IEN)=$$FMTSPECIAL(VALUE,VALUECODE) Q
 W:$G(TESTING) !?25,"-----------"
 W:$G(TESTING) !!
 Q
 ;
 ;LENGTH = SIZE OF FORMAT FIELD
 ;JUST ="L" = LEFT JUSTIFIED
 ;JUST = "R" = RIGHT JUSTIFIED
 ;DECPT = 0 = DECIMAL PT IMPLIED
 ;DECPT = 1 = DECIMAL PT ADDED
 ;FILLCHAR = CHARACTER TO USE AS A FILLER
 ;
 ;W $$FORMAT^IBCVC("23.",8,"L",1," ",2)
 ;THIS IS NOT FOR ANY PRINTED FORM
FORMAT(DATA,LENGTH,JUST,DECPT,FILLCHAR,PRECISION,DATATYPE) ;EP - FORMAT PER SPECS
 ;
 N FILL ;WCJ;IB718;SQA
 N FILLER
 S JUST=$$UP^XLFSTR($G(JUST))
 S FILL='$G(FILLCHAR)=""
 S DATA=$$ABS^XLFMTH(DATA)
 S LENGTH=$G(LENGTH)
 S DECPT=$G(DECPT)=1
 ;
 I PRECISION S DATA=$J(VALUE,LENGTH,PRECISION) S:'DECPT DATA=$TR(DATA,".")
 ;
 I FILLCHAR="" S DATA=$$TRIM^XLFSTR(DATA,"LR") Q DATA
 ;
 I JUST="R" S DATA=$$RJ^XLFSTR(DATA,LENGTH,FILLCHAR)
 E  S DATA=$$LJ^XLFSTR(DATA,LENGTH,FILLCHAR)
 Q DATA
 ;
FMTDOLLAR(VALUE) ;EP - FORMAT DOLLAR AMOUNTS
 S VALUE=$$FORMAT(VALUE,9,"R",1,"",2)
 W:$G(TESTING) !,"DATATYPE DOLLAR:",?25,"|",VALUE_"|"
 W:$G(TESTING) ?45,VALUECODE,?55,$E(VALCODENAME,1,25)
 Q VALUE
 ;
FMTNUMERIC(VALUE,DATATYPE) ;EP - FORMAT NUMERIC STRING
 S VALUE=$$FORMAT^IBCVC(VALUE,7,"R",0,"",0)
 W:$G(TESTING) !,"DATATYPE NUMERIC:",?25,"|",VALUE_"|"
 W:$G(TESTING) ?45,VALUECODE,?55,$E(VALCODENAME,1,25)
 Q VALUE
 ;
FMTALPHANUM(VALUE) ;EP - FORMAT ALPHANUMERICS
 S VALUE=$$FORMAT^IBCVC(VALUE,7,"R",0,"",0)
 W:$G(TESTING) !,"DATATYPE ALPHANUM:",?25,"|",VALUE_"|"
 W:$G(TESTING) ?45,VALUECODE,?55,$E(VALCODENAME,1,25)
 Q VALUE
 ;
FMTDECIMAL(VALUE) ;EP - FORMAT DECIMALS
 ;S VALUE=$$FORMAT^IBCVC(VALUE,$L(VALUE),"R",1,"",1,"FMTDECIMAL")
 S VALUE=$$FORMAT^IBCVC(VALUE,$L(VALUE),"R",1,"",2,"FMTDECIMAL")  ;TPF;IB*732
 W:$G(TESTING) !,"DATATYPE DECIMAL:",?25,"|",VALUE_"|"
 W:$G(TESTING) ?45,VALUECODE,?55,$E(VALCODENAME,1,25)
 Q VALUE
 ;
 ;SPECIAL CASES
FMTSPECIAL(VALUE,VALUECODE) ;EP - SPECIAL CASE FORMAT
 Q:$G(VALUECODE)="" VALUE
 I VALUECODE="45" S VALUE=$$FORMAT(VALUE,7,"R",0,"",0,"FMTNUMERIC")
 I VALUECODE="A0" S VALUE=$$FORMAT(VALUE,7,"R",1,"",0,"FMTNUMERIC")
 I VALUECODE=24 S VALUE=$$FORMAT(VALUE,8,"R",1,"",0,"FMTALPHANUM")
 W:$G(TESTING) !,"DATATYPE SPECIAL:",?25,"|"_VALUE_"|"
 W:$G(TESTING) ?45,VALUECODE,?55,$E(VALCODENAME,1,25)
 Q VALUE
 ;
 ;VALUE CODE DATATYPE DEFINITIONS
DATATYPE(CODE,VALUE,INPUTCHK) ;EP - WHAT TYPE OF DATA DOES IB IDENTIFIY THIS VALUE CODE TO BE
 I $$NUMERIC(VALUECODE,VALUE,INPUTCHK) Q "FMTNUMERIC"
 I $$DECIMALS(VALUECODE,VALUE,INPUTCHK) Q "FMTDECIMAL"
 I $$ALPHANUM(VALUECODE,VALUE,INPUTCHK) Q "FMTALPHANUM"
 I $$ZIPCODE(VALUECODE,VALUE,INPUTCHK) Q "FMTALPHANUM"
 Q "SPECIAL"
 ;
NUMERIC(CODE,VALUE,INPUTCHK) ;EP - IS VALUE CODE WHOLE NUMBER AS DEFINED HISTORICALLY IN CHK^IBCVC
 I (U_"G8"_U_"D4"_U_62_U_63_U_32_U_37_U_38_U_39_U_46_U_50_U_51_U_52_U_53_U_56_U_57_U_58_U_59_U_67_U_68_U_69_U_80_U_81_U_82_U_83_U_84_U)[(U_CODE_U)
 Q:'$G(INPUTCHK) $T
 Q VALUE?1.7N&'(X?2"0"."0")
 ;
ALPHANUM(CODE,VALUE,INPUTCHK) ;EP - IS VALUE CODE AN ALPHANUMERIC?
 I (U_60_U_61_U)[(U_CODE_U)
 Q:'$G(INPUTCHK) $T
 Q VALUE?1.7AN&'(X?2"0"."0")
 ;
DECIMALS(CODE,VALUE,INPUTCHK) ;EP - IS VALUE CODE A "DECIMAL" AS DEFINED HISTORICALLY IN CHK^IBCVC
 I (U_54_U_48_U_49_U_"A8"_U_"A9"_U_"D5"_U)[(U_CODE_U)
 Q:'$G(INPUTCHK) $T
 ;
 S OK=1 D  Q OK
 . I $P(X,".")'?.2N S OK=0 Q
 . I $P(X,".",2,999)'?.1N S OK=0 Q
 . I $E(X,$L(X))="." S OK=0 Q
 Q 0
 ;
ZIPCODE(CODE,VALUE,INPUTCHK) ;EP - RETURN IF VALID ZIP IN FILE #5.11 ZIP CODE
 I (U_"A0"_U)[(U_CODE_U)
 Q:'$G(INPUTCHK) $T
 Q X?5N
 ;I KNOW THIS IS OUT OF SCOPE BUT....
 ;PER BILL DO NOT INCLUDE
 ;DATE SHOULD BE DATE OF SERVICE NOT DATE BILL IS ENTERED?
 ;D ZIPCODE^DSICXIP(.RETURN,ZIPCODE,DT,1)  ;DOES THIS NEED A ICR#
 ;RETURN="-1^Postal Code cannot be found"            
 ;RETURN="87015^EDGEWOOD^NEW MEXICO^SANTA FE^35049^NM^35^2844"
 Q $G(RETURN)>0
 ;
REMOVE(DA) ; Remove the VALUE field since it's in the wrong format.
 ; This is called from a NEW STYLE X-REF "AC" in file 399.047 field .01
 N IENS,FDA
 Q:'$G(DA)!'$G(DA(1))
 S IENS=DA_","_DA(1)_","
 S FDA(399.047,IENS,.02)="@"
 D FILE^DIE(,"FDA")
 D CLEAN^DILF
 Q
 ;
COND(DA,OLDVC,NEWVC) ; Check if the VALUE is in a valid format for the new VALUE CODE.
 ; This is called from a NEW STYLE X-REF "AC" in file 399.047 field .01
 ; This function will return:
 ; 1 - Means that this VALUE should be deleted (It's in the wrong format)
 ; 0 - Means that this VALUE should NOT be deleted
 Q:'$G(OLDVC) 0
 Q:'$G(DA)!'$G(DA(1)) 0
 N OLDVALUE
 S OLDVALUE=$P($G(^DGCR(399,DA(1),"CV",DA,0)),U,2)
 Q:OLDVALUE="" 0
 Q '$$CHK(NEWVC,OLDVALUE)
 ;
 ;IB*2.0*432 - TAZ - VC1 added
VC1(IBXIEN,IBFL) ;Code for the VC1 record of the IB 837 Transmission
 ;INPUT:
 ;IBXIEN - IEN of bill/claim file
 ;IBFL - output array passed by reference
 ;
 ;OUTPUT:
 ;IBFL - array contains the list of value codes to be included in the transmission
 ;
 N IBI,IBX,Z,Z0,INST
 S INST=$$FT^IBCEF(IBXIEN)=3
 S (IBI,IBX)=0 F  S IBX=$O(^DGCR(399,IBXIEN,"CV",IBX)) Q:'IBX  D
 . S Z=$G(^(IBX,0)),Z0=$G(^DGCR(399.1,+Z,0))
 . I Z0="" Q
 . I ",A3,B3,C3,"[(","_$P(Z0,U,2)_","),INST Q
 . S IBI=IBI+1,IBFL(39,IBI)=$P(Z0,U,2)_U_$P(Z,U,2)_U_$P(Z0,U,12)_U_+Z
 I INST D
 . S CODE=$P("A3^B3^C3",U,$$COBN^IBCEF(IBXIEN))
 . S Z=$G(^DGCR(399,IBXIEN,"U1")),Z0=Z-$P(Z,U,2)
 . S IBI=IBI+1,IBFL(39,IBI)=CODE_U_Z0_U_1
 Q
 ;
 ;TPF;IB*2.0*718;EBILL-1570;11/03/2021
 ;D VCSCREEN^IBCVC
VCSCREEN(X) ;EP - FIELD #2 VALUE CODE AMOUNT SCREEN, FILE #399.1 MCCR UTILITY INPUT TRANSFORM
 ;THE PURPOSE OF THIS INPUT TRANSFORM IS TO ALLOW THE USER TO EASILY PICK STANDARD VALUE AMOUNT screens
 I $P(@DILK@(0),U,11)'=1 D  Q  ;CHECK FOR VALUE CODE TYPE ENTRIES
 .K X
 .D BMES^XPDUTL(" ")
 .D MES^XPDUTL("ONLY 'VALUE CODE' ENTRIES CAN BE GIVEN A 'VALUE CODE AMOUNT SCREEN'")
 ;
 I $G(DUZ(0))'="@" W !!,"PROGRAMMER ONLY EDITABLE FIELD!!!" H 1 Q
 ;
 N MCODE
 S MCODE=X
 D ^DIM  ;CHECK THE INCOMING X FOR VALID MUMPS CODE
 I $D(X) D  Q:$G(Y)
 .W !!,"This is valid MUMPS code."
 .W !!,X
 .W !
 .N DIR,X
 .S DIR(0)="Y"
 .S DIR("B")="Y"
 .S DIR("A")="Is this is the screen for "_$P($G(^DGCR(399.1,91,0)),U)
 .D ^DIR
 E  D
 .W !!,"The following code is not valid MUMPS code"
 .W !!,$G(MCODE)
 .W !!,"Try a standard VALUE CODE AMOUNT screen or enter valid MUMPS code."
 ;
 N DOLLAR S DOLLAR=$P(@DILK@(0),U,12)=1  ;IS THIS A DOLLAR AMOUNT?
 ;
 N DIR,DIE,DIC,DA,DR,DIK,DTOUT,DUOUT,DIROUT,Y
 N ERRORCODE,MCODE
 S DIR(0)="SO^"
 S DIR("B")="="  ;DEFAULT CHOICE - LIKELY THE MOST OFTEN USED EDIT CHECK FOR ALL NEW IB VALUE CODES
 D STANCHOICE(.DIR,.MCODE)  ;COLLECT STANDARD CHOICES
 ;
 I DUZ(0)="@" S DIR(0)=DIR(0)_"M:ENTER MY OWN MUMPS CODE"
 S DIR("A")="CHOOSE A STANDARD VALUE AMOUNT EDIT CHECK"
 D ^DIR
 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="") K X Q   ;      Y=">"
 ;
 I Y'="M" D  Q
 .D ASKFORERROR(.ERRORCODE,Y)  ;ASK USER FOR #350.8 'IB ERROR' ASSOCIATED WITH THIS VALUE CODE AMOUNT EDIT CHECK
 .I $G(ERRORCODE)="" K X Q
 .S X=$$ADDWRAPPER($G(MCODE(Y)),ERRORCODE)     ;      Y(0)="IF VCVALUE>0"
 ;
 D MUMPSCODE(.X)
 Q
 ;
MUMPSCODE(MUMPSCODE) ;EP - GET NON-STANDARD MUMPS CODE FOR CODE VALUE AMOUNT EDIT CHECK
 D BMES^XPDUTL(" ")
 D MES^XPDUTL("REMEMBER TO UTILIZE THE STANDARD VARIABLE 'IBVCVALUE'")
 D MES^XPDUTL("REMEMBER TO SET THE VARIABLE 'IBVCERR' TO 1 ON AN ERROR CONDITION.")
 D MES^XPDUTL("REMEMBER TO CALL $$IBER^IBCBB3 TO SET THE ERROR LIST.")
 D MES^XPDUTL("REMEMBER TO REFERNCE YOUR NEW IB ERROR CODE PROPERLY TOO.")
 D MES^XPDUTL("EXAMPLE:")
 D BMES^XPDUTL("Q:$G(IBVCVALUE)=""""  I IBVCVALUE<5,$G(IBER)'[(""9999;"") S IBQUIT=$$IBER^IBCBB3(.IBER,9999),IBVCERR=1")
 D BMES^XPDUTL(" ")
 ;
 N DIR,DIE,DIC,DA,DR,DIK,DTOUT,DUOUT,DIROUT,Y
 S DIR(0)="FOU^0:245^Q:X=""""  D:$D(X) ^DIM Q:'$D(X)  K:X'[(""IBVCVALUE"")&(X'[(""IBVCERR"")) X"
 S DIR("A")="Enter MUMPS Edit Check Code"
 S DIR("?")="Code cannot be >245 characters, must be legal MUMPS code and reference IBVCVALUE and IBVCERR"
 D ^DIR
 I X="@" K X
 Q
 ;
ASKFORERROR(ERROR,STANCHOICE) ;EP - ASK FOR ERROR
 N DIR,DIE,DIC,DA,DR,DIK,DTOUT,DUOUT,DIROUT,X,Y
REDO ;
 D BMES^XPDUTL(" ")
 D MES^XPDUTL("You must associate an IB ERROR error code to this error condition.")
 D MES^XPDUTL("For now, If you need a new error code you must create one separtely.")
 D BMES^XPDUTL(" ")
 S DIC="^IBE(350.8,"
 S DIC(0)="AEMQZ"
 D ^DIC
 Q:X=U!(X="")
 G:Y<0 REDO
 S ERROR=$P($P($P(Y,U,2),"IB",2)," ")
 Q
 ;
ADDWRAPPER(CODESTR,ERRORCODE) ;EP - ADD BASIC CODE TOCHECKFOR VALUE AND ADD STANDARD IBER CALL
 N PREFIX,SUFFIX
 S PREFIX=""   ;"Q:$G(IBVCVALUE)=""""  "  NO VALUE CHECK IS HARDCODED IN IBCBB5
 S SUFFIX=",$G(IBER)'[("""_ERRORCODE_";"") S IBQUIT=$$IBER^IBCBB3(.IBER,"_ERRORCODE_"),IBVCERR=1"
 S CODESTR=PREFIX_CODESTR_SUFFIX
 Q CODESTR
 ;
STANCHOICE(DIR,MCODE) ;EP-PULL STANDARD (OR EASY USER) CHOICES
 N CHOICE,SETCODE ;WCJ;IB718;SQA
 N OFFSET
 F OFFSET=1:1 S CHOICE=$P($T(STANCHOICES+OFFSET),";;",2) Q:CHOICE="STOP"  D
 .S MCODE=$P(CHOICE,"|",2)
 .S CHOICE=$P(CHOICE,"|")
 .S SETCODE=$P(CHOICE,":")
 .S MCODE(SETCODE)=MCODE
 .S DIR(0)=$G(DIR(0))_CHOICE_";"
 Q
 ;
 ;ADD STANDARD EASY CHOICES HERE SO YOU DON'T HAVE TO ADD THEM TO THE DIR(0) STRING MANUALLY
 ;SHORCUT:USER READABLE PSEUDO CODE | MUMPS CODE
STANCHOICES ;;
 ;;=0:ONLY ZERO ALLOWED|I $G(IBVCVALUE)'=0
 ;;>0:IF VALUE CODE AMOUNT GREATER THAN ZERO THEN ERROR|I +$G(IBVCVALUE)>0
 ;;<0:IF VALUE CODE AMOUNT LESS THAN ZERO THEN ERROR|I +$G(IBVCVALUE)<0
 ;;=:IF VALUE CODE AMOUNT EQUALS ZERO THEN ERROR|I +$G(IBVCVALUE)=0|IB916
 ;;<sp>:IF VALUE CODE AMOUNT EQUALS A SPACE THEN ERROR|I $G(IBVCVALUE)=""
 ;;'<sp>:IF VALUE CODE AMOUNT EQUALS NOT EQUAL A SPACE THEN ERROR|I $G(IBVCVALUE)'=""
 ;;STOP
 Q