- IBCRER1 ;ALB/ARH - RATES: CM RC NATIONAL ENTER/EDIT OPTION (CONT) ; 13-FEB-2007
- ;;2.0;INTEGRATED BILLING;**370**;21-MAR-94;Build 5
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;
- CHGLN(IBEFF,IBTYP,IBLINE) ; get all user data for charge
- ; Input: pass by reference to get/retain defaults: Effective Date, Inst/Prof
- ; Output: IBLINE if passed by reference
- ; IBLINE = 'cpt ifn^eff dt^mod ifn^type (I/P)^charge^incr type (PR/ML/HR/MN)^incr charge^inpt^snf^opt^free'
- ; or null if no CPT, or -1 if invalid (exit)
- N IBCPT,IBMOD,IBCHGU,IBINCR,IBCHGI,IBINP,IBSNF,IBOPT,IBFS S IBEFF=$G(IBEFF),IBTYP=$G(IBTYP),IBLINE=""
- ;
- S IBCPT=$$GETCPT(IBEFF) I IBCPT<1 S IBLINE=-1 Q ; active cpt code
- S IBEFF=$$GETEFF(IBEFF) Q:IBEFF<1 ; charge effective date
- S IBMOD=$$GETMOD() Q:IBMOD<0 ; modifier for procedure charge
- S IBTYP=$$GETTYP(IBTYP) Q:IBTYP<0 ; charge type, inst/prof
- S IBCHGU=$$GETCHGU() Q:IBCHGU<0 W ! ; unit charge
- ;
- S IBINCR=$$GETINCR() Q:IBINCR<0 ; type of incremental charge
- S IBCHGI=$$GETCHGI(IBINCR) Q:IBCHGI<0 W ! ; incremental charge
- ;
- S IBINP=$$GETIINP() Q:IBINP<0 ; inpatient indicator
- S IBSNF=$$GETISNF() Q:IBSNF<0 ; snf indicator
- S IBOPT=$$GETIOPT() Q:IBOPT<0 ; outpatient indictor
- S IBFS=$$GETIFS() Q:IBFS<0 ; freestanding indicator
- ;
- S IBLINE=+IBCPT_U_+IBEFF_U_IBMOD_U_IBTYP_U_IBCHGU_U_IBINCR_U_IBCHGI_U_IBINP_U_IBSNF_U_IBOPT_U_IBFS
- Q
- ;
- GETCPT(EFFDT) ; Get CPT/HCPCS procedure associated with charge
- ; Returns: IFN of CPT/HCPCS selected, -1 if invalid
- N IBX,DIC,DIE,DA,DR,I,X,Y,DTOUT,DUOUT S IBX=-1
- ;
- S DIC("A")="Select PROCEDURE CPT/HCPCS: " I +$G(EFFDT) S DIC("S")="I $$CPTACT^IBACSV(+Y,EFFDT)"
- S DIC="^ICPT(",DIC(0)="AEMNQ" D ^DIC K DIC I +Y>0 S IBX=+Y
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- GETEFF(DEFAULT) ; Get Effective Date for charge, must be within date range of current version
- ; returns valid effective date, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y,IBY,IBI,IBZ,IBA,IBMIN S IBMIN="",IBA="",IBX=-1
- S IBY=$$VERSALL^IBCRHBRV() F IBI=1:1 S IBZ=$P(IBY,U,IBI) Q:IBZ="" S IBMIN=IBZ
- S DIR("?",1)="Charge Effective Date must be within the date range of the current RC"
- S DIR("?",2)="version, v"_+IBMIN_". Date must be between "_$$DATE(+$P(IBMIN,";",2))_" and Today.",DIR("?",3)=""
- S DIR("?")="Enter Effective Date of Charge."
- ;
- S DIR("A")="EFFECTIVE DATE" I +$G(DEFAULT)>0 S DIR("B")=$$DATE(DEFAULT),IBA="A",DIR("A")=DIR("A")_": "
- S DIR(0)="D"_IBA_"^"_+$P(IBMIN,";",2)_":"_DT_":EX" D ^DIR K DIR I Y?7N S IBX=+Y
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- GETMOD() ; Get Modifier associated with the procedure charge
- ; Modifier not limited to valid CPTs since that list is often out of date
- ; Returns: IFN of selected modifier, null if no modifier selected, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=""
- S DIR("?",1)="Modifier is optional. If a modifier is added then the charge will only"
- S DIR("?",2)="be applied if the modifier is assigned to the procedure on the bill.",DIR("?",3)=""
- S DIR("?")="Enter the Modifier associated with the procedure charge."
- ;
- S DIR("A")="MODIFIER"
- S DIR(0)="PO^DIC(81.3,:AEMQ" D ^DIR K DIR I Y>0 S IBX=+Y
- I $D(DUOUT)!$D(DTOUT) S IBX=-1
- Q IBX
- ;
- GETTYP(DEFAULT) ; Get Charge Type: Institutional or Professional
- ; Returns: I for Institutional, P for Professional, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=-1
- I $G(DEFAULT)'="" S DEFAULT=$S(DEFAULT="I":"Institutional",DEFAULT="P":"Professional",1:"")
- S DIR("?")="Enter the type of charge, either Institutional or Professional."
- ;
- S DIR("A")="CHARGE TYPE" I $G(DEFAULT)'="" S DIR("B")=DEFAULT
- S DIR(0)="SB^I:Institutional;P:Professional" D ^DIR S IBX=Y
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- GETCHGU() ; get procedures unit charge
- ; Returns: dollar amount (non-zero), -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=-1
- S DIR("?",1)="The dollar amount to be added to a bill for each of this procedure on the bill."
- S DIR("?",2)="Enter an amount greater than zero and less than 99999, 2 decimal digits."
- S DIR("?")="Enter the unit charge for Procedure to be used at all sites."
- ;
- S DIR("A")="UNIT CHARGE: "
- S DIR(0)="NA^.001:99999:2" D ^DIR K DIR I +Y>0 S IBX=Y
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- GETINCR() ; get the type of charge, identifies Charge Method and incremental calculations
- ; Returns: PR for standard, HR for observation, MN for anesthesia, ML for ambulance, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=-1
- S DIR("?",1)="Most charges are a standard charge per procedure. There are three types of"
- S DIR("?",2)="charges that require special calculations that add charge based on an "
- S DIR("?",3)="increment of units: Anesthesia, Observation, Ambulance."
- S DIR("?")="Enter type of care that will identify the charge calculation."
- ;
- S DIR("A")="Standard, Observation, Anesthesia, or Ambulance",DIR("B")="Standard"
- S DIR(0)="SB^PR:Standard;HR:Observation;MN:Anesthesia;ML:Ambulance" D ^DIR S IBX=Y
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- ;
- Q IBX
- ;
- GETCHGI(TYPE) ; if a special charge then get the incremental charge amount, anesthesia and observation only
- ; Returns: dollar amount if applicable (non-zero), null if not applicable, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y,IBTYP S TYPE=$G(TYPE),IBX=-1
- S IBTYP=$S(TYPE="MN":"Anesthesia",TYPE="HR":"Observation",1:"") I IBTYP="" S IBX=""
- S DIR("?",1)="Anesthesia and Observation have a unit charge added to a base/incremental"
- S DIR("?",2)="charge that is multiplied by the time associated with the procedure."
- S DIR("?",3)="Enter an amount greater than zero and less than 99999, 2 decimal digits.",DIR("?",4)=""
- S DIR("?")="Enter the base or incremental "_IBTYP_" charge for this procedure."
- ;
- S DIR("A")=IBTYP_" BASE CHARGE: "
- I IBTYP'="" S DIR(0)="NA^.001:99999:2" D ^DIR K DIR I +Y>0 S IBX=Y
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- GETIINP() ; Get Inpatient Indicator, is this charge billable for Inpatient care
- ; Returns: 1 for Yes Billable for Inpatient care, 0 for not billable, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=0
- S DIR("?")="Enter Yes if this charge is billable for Inpatient care, No otherwise."
- ;
- S DIR(0)="Y",DIR("A")="INPATIENT",DIR("B")="No" D ^DIR I Y=1 S IBX=1
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- GETISNF() ; Get SNF Indicator, is this charge billable for Skilled Nursing care
- ; Returns: 1 for Yes Billable for SNF care, 0 for not billable, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=0
- S DIR("?")="Enter Yes if this charge is billable for SNF care, No otherwise."
- ;
- S DIR(0)="Y",DIR("A")="SKILLED NURSING",DIR("B")="Yes" D ^DIR I Y=1 S IBX=1
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- GETIOPT() ; Get Outpatient Indicator, is this charge billable for Outpatient care
- ; Returns: 1 for Yes Billable for outpatient care, 0 for not billable, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=0
- S DIR("?")="Enter Yes if this charge is billable for Outpatient care, No otherwise."
- ;
- S DIR(0)="Y",DIR("A")="OUTPATIENT",DIR("B")="Yes" D ^DIR I Y=1 S IBX=1
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- GETIFS() ; Get Freestanding Indicator, is this charge billable at Freestanding Sites
- ; Returns: 1 for Yes Billable at Non-Provider Based/Freestanding sites, 0 for not billable, -1 if invalid
- N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=0
- S DIR("?",1)="All charges for Freestanding sites will be stored as Professional charges."
- S DIR("?")="Enter Yes if this charge is billable at Freestanding Sites, No otherwise."
- ;
- S DIR(0)="Y",DIR("A")="FREESTANDING",DIR("B")="Yes" D ^DIR I Y=1 S IBX=1
- I $D(DTOUT)!$D(DUOUT) S IBX=-1
- Q IBX
- ;
- DATE(X) ; returns VA date in external form
- N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRER1 7879 printed Feb 18, 2025@23:45:30 Page 2
- IBCRER1 ;ALB/ARH - RATES: CM RC NATIONAL ENTER/EDIT OPTION (CONT) ; 13-FEB-2007
- +1 ;;2.0;INTEGRATED BILLING;**370**;21-MAR-94;Build 5
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;
- CHGLN(IBEFF,IBTYP,IBLINE) ; get all user data for charge
- +1 ; Input: pass by reference to get/retain defaults: Effective Date, Inst/Prof
- +2 ; Output: IBLINE if passed by reference
- +3 ; IBLINE = 'cpt ifn^eff dt^mod ifn^type (I/P)^charge^incr type (PR/ML/HR/MN)^incr charge^inpt^snf^opt^free'
- +4 ; or null if no CPT, or -1 if invalid (exit)
- +5 NEW IBCPT,IBMOD,IBCHGU,IBINCR,IBCHGI,IBINP,IBSNF,IBOPT,IBFS
- SET IBEFF=$GET(IBEFF)
- SET IBTYP=$GET(IBTYP)
- SET IBLINE=""
- +6 ;
- +7 ; active cpt code
- SET IBCPT=$$GETCPT(IBEFF)
- IF IBCPT<1
- SET IBLINE=-1
- QUIT
- +8 ; charge effective date
- SET IBEFF=$$GETEFF(IBEFF)
- if IBEFF<1
- QUIT
- +9 ; modifier for procedure charge
- SET IBMOD=$$GETMOD()
- if IBMOD<0
- QUIT
- +10 ; charge type, inst/prof
- SET IBTYP=$$GETTYP(IBTYP)
- if IBTYP<0
- QUIT
- +11 ; unit charge
- SET IBCHGU=$$GETCHGU()
- if IBCHGU<0
- QUIT
- WRITE !
- +12 ;
- +13 ; type of incremental charge
- SET IBINCR=$$GETINCR()
- if IBINCR<0
- QUIT
- +14 ; incremental charge
- SET IBCHGI=$$GETCHGI(IBINCR)
- if IBCHGI<0
- QUIT
- WRITE !
- +15 ;
- +16 ; inpatient indicator
- SET IBINP=$$GETIINP()
- if IBINP<0
- QUIT
- +17 ; snf indicator
- SET IBSNF=$$GETISNF()
- if IBSNF<0
- QUIT
- +18 ; outpatient indictor
- SET IBOPT=$$GETIOPT()
- if IBOPT<0
- QUIT
- +19 ; freestanding indicator
- SET IBFS=$$GETIFS()
- if IBFS<0
- QUIT
- +20 ;
- +21 SET IBLINE=+IBCPT_U_+IBEFF_U_IBMOD_U_IBTYP_U_IBCHGU_U_IBINCR_U_IBCHGI_U_IBINP_U_IBSNF_U_IBOPT_U_IBFS
- +22 QUIT
- +23 ;
- GETCPT(EFFDT) ; Get CPT/HCPCS procedure associated with charge
- +1 ; Returns: IFN of CPT/HCPCS selected, -1 if invalid
- +2 NEW IBX,DIC,DIE,DA,DR,I,X,Y,DTOUT,DUOUT
- SET IBX=-1
- +3 ;
- +4 SET DIC("A")="Select PROCEDURE CPT/HCPCS: "
- IF +$GET(EFFDT)
- SET DIC("S")="I $$CPTACT^IBACSV(+Y,EFFDT)"
- +5 SET DIC="^ICPT("
- SET DIC(0)="AEMNQ"
- DO ^DIC
- KILL DIC
- IF +Y>0
- SET IBX=+Y
- +6 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +7 QUIT IBX
- +8 ;
- GETEFF(DEFAULT) ; Get Effective Date for charge, must be within date range of current version
- +1 ; returns valid effective date, -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y,IBY,IBI,IBZ,IBA,IBMIN
- SET IBMIN=""
- SET IBA=""
- SET IBX=-1
- +3 SET IBY=$$VERSALL^IBCRHBRV()
- FOR IBI=1:1
- SET IBZ=$PIECE(IBY,U,IBI)
- if IBZ=""
- QUIT
- SET IBMIN=IBZ
- +4 SET DIR("?",1)="Charge Effective Date must be within the date range of the current RC"
- +5 SET DIR("?",2)="version, v"_+IBMIN_". Date must be between "_$$DATE(+$PIECE(IBMIN,";",2))_" and Today."
- SET DIR("?",3)=""
- +6 SET DIR("?")="Enter Effective Date of Charge."
- +7 ;
- +8 SET DIR("A")="EFFECTIVE DATE"
- IF +$GET(DEFAULT)>0
- SET DIR("B")=$$DATE(DEFAULT)
- SET IBA="A"
- SET DIR("A")=DIR("A")_": "
- +9 SET DIR(0)="D"_IBA_"^"_+$PIECE(IBMIN,";",2)_":"_DT_":EX"
- DO ^DIR
- KILL DIR
- IF Y?7N
- SET IBX=+Y
- +10 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +11 QUIT IBX
- +12 ;
- GETMOD() ; Get Modifier associated with the procedure charge
- +1 ; Modifier not limited to valid CPTs since that list is often out of date
- +2 ; Returns: IFN of selected modifier, null if no modifier selected, -1 if invalid
- +3 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
- SET IBX=""
- +4 SET DIR("?",1)="Modifier is optional. If a modifier is added then the charge will only"
- +5 SET DIR("?",2)="be applied if the modifier is assigned to the procedure on the bill."
- SET DIR("?",3)=""
- +6 SET DIR("?")="Enter the Modifier associated with the procedure charge."
- +7 ;
- +8 SET DIR("A")="MODIFIER"
- +9 SET DIR(0)="PO^DIC(81.3,:AEMQ"
- DO ^DIR
- KILL DIR
- IF Y>0
- SET IBX=+Y
- +10 IF $DATA(DUOUT)!$DATA(DTOUT)
- SET IBX=-1
- +11 QUIT IBX
- +12 ;
- GETTYP(DEFAULT) ; Get Charge Type: Institutional or Professional
- +1 ; Returns: I for Institutional, P for Professional, -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
- SET IBX=-1
- +3 IF $GET(DEFAULT)'=""
- SET DEFAULT=$SELECT(DEFAULT="I":"Institutional",DEFAULT="P":"Professional",1:"")
- +4 SET DIR("?")="Enter the type of charge, either Institutional or Professional."
- +5 ;
- +6 SET DIR("A")="CHARGE TYPE"
- IF $GET(DEFAULT)'=""
- SET DIR("B")=DEFAULT
- +7 SET DIR(0)="SB^I:Institutional;P:Professional"
- DO ^DIR
- SET IBX=Y
- +8 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +9 QUIT IBX
- +10 ;
- GETCHGU() ; get procedures unit charge
- +1 ; Returns: dollar amount (non-zero), -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
- SET IBX=-1
- +3 SET DIR("?",1)="The dollar amount to be added to a bill for each of this procedure on the bill."
- +4 SET DIR("?",2)="Enter an amount greater than zero and less than 99999, 2 decimal digits."
- +5 SET DIR("?")="Enter the unit charge for Procedure to be used at all sites."
- +6 ;
- +7 SET DIR("A")="UNIT CHARGE: "
- +8 SET DIR(0)="NA^.001:99999:2"
- DO ^DIR
- KILL DIR
- IF +Y>0
- SET IBX=Y
- +9 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +10 QUIT IBX
- +11 ;
- GETINCR() ; get the type of charge, identifies Charge Method and incremental calculations
- +1 ; Returns: PR for standard, HR for observation, MN for anesthesia, ML for ambulance, -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
- SET IBX=-1
- +3 SET DIR("?",1)="Most charges are a standard charge per procedure. There are three types of"
- +4 SET DIR("?",2)="charges that require special calculations that add charge based on an "
- +5 SET DIR("?",3)="increment of units: Anesthesia, Observation, Ambulance."
- +6 SET DIR("?")="Enter type of care that will identify the charge calculation."
- +7 ;
- +8 SET DIR("A")="Standard, Observation, Anesthesia, or Ambulance"
- SET DIR("B")="Standard"
- +9 SET DIR(0)="SB^PR:Standard;HR:Observation;MN:Anesthesia;ML:Ambulance"
- DO ^DIR
- SET IBX=Y
- +10 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +11 ;
- +12 QUIT IBX
- +13 ;
- GETCHGI(TYPE) ; if a special charge then get the incremental charge amount, anesthesia and observation only
- +1 ; Returns: dollar amount if applicable (non-zero), null if not applicable, -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y,IBTYP
- SET TYPE=$GET(TYPE)
- SET IBX=-1
- +3 SET IBTYP=$SELECT(TYPE="MN":"Anesthesia",TYPE="HR":"Observation",1:"")
- IF IBTYP=""
- SET IBX=""
- +4 SET DIR("?",1)="Anesthesia and Observation have a unit charge added to a base/incremental"
- +5 SET DIR("?",2)="charge that is multiplied by the time associated with the procedure."
- +6 SET DIR("?",3)="Enter an amount greater than zero and less than 99999, 2 decimal digits."
- SET DIR("?",4)=""
- +7 SET DIR("?")="Enter the base or incremental "_IBTYP_" charge for this procedure."
- +8 ;
- +9 SET DIR("A")=IBTYP_" BASE CHARGE: "
- +10 IF IBTYP'=""
- SET DIR(0)="NA^.001:99999:2"
- DO ^DIR
- KILL DIR
- IF +Y>0
- SET IBX=Y
- +11 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +12 QUIT IBX
- +13 ;
- GETIINP() ; Get Inpatient Indicator, is this charge billable for Inpatient care
- +1 ; Returns: 1 for Yes Billable for Inpatient care, 0 for not billable, -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
- SET IBX=0
- +3 SET DIR("?")="Enter Yes if this charge is billable for Inpatient care, No otherwise."
- +4 ;
- +5 SET DIR(0)="Y"
- SET DIR("A")="INPATIENT"
- SET DIR("B")="No"
- DO ^DIR
- IF Y=1
- SET IBX=1
- +6 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +7 QUIT IBX
- +8 ;
- GETISNF() ; Get SNF Indicator, is this charge billable for Skilled Nursing care
- +1 ; Returns: 1 for Yes Billable for SNF care, 0 for not billable, -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
- SET IBX=0
- +3 SET DIR("?")="Enter Yes if this charge is billable for SNF care, No otherwise."
- +4 ;
- +5 SET DIR(0)="Y"
- SET DIR("A")="SKILLED NURSING"
- SET DIR("B")="Yes"
- DO ^DIR
- IF Y=1
- SET IBX=1
- +6 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +7 QUIT IBX
- +8 ;
- GETIOPT() ; Get Outpatient Indicator, is this charge billable for Outpatient care
- +1 ; Returns: 1 for Yes Billable for outpatient care, 0 for not billable, -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
- SET IBX=0
- +3 SET DIR("?")="Enter Yes if this charge is billable for Outpatient care, No otherwise."
- +4 ;
- +5 SET DIR(0)="Y"
- SET DIR("A")="OUTPATIENT"
- SET DIR("B")="Yes"
- DO ^DIR
- IF Y=1
- SET IBX=1
- +6 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +7 QUIT IBX
- +8 ;
- GETIFS() ; Get Freestanding Indicator, is this charge billable at Freestanding Sites
- +1 ; Returns: 1 for Yes Billable at Non-Provider Based/Freestanding sites, 0 for not billable, -1 if invalid
- +2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
- SET IBX=0
- +3 SET DIR("?",1)="All charges for Freestanding sites will be stored as Professional charges."
- +4 SET DIR("?")="Enter Yes if this charge is billable at Freestanding Sites, No otherwise."
- +5 ;
- +6 SET DIR(0)="Y"
- SET DIR("A")="FREESTANDING"
- SET DIR("B")="Yes"
- DO ^DIR
- IF Y=1
- SET IBX=1
- +7 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET IBX=-1
- +8 QUIT IBX
- +9 ;
- DATE(X) ; returns VA date in external form
- +1 NEW Y
- SET Y=""
- IF $GET(X)?7N.E
- SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- +2 QUIT Y