IBTRH5A ;ALB/FA - HCSR Create 278 Request ;12-AUG-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;;
; Contains Entry points and functions used in creating a 278 request from a
; selected entry in the HCSR Response worklist
;
; -------------------------- Entry Points --------------------------------
; CERTCAT - Function called from within Input Template: IB CREATE 278 REQUEST
; to allow the user to enter Certification information for a
; selected Certification Code Category.
; CERTCOND - Dictionary Screen function for Certification Conditions.
; Prevents duplicate Certification Conditions from being entered.
; CERTCNDP - Function to check for subsequent Certification Conditions
; values for the specified field
; DXCODE - Dictionary Screen function for Diagnosis Code field 356.22,3.02
; RCAUSEP - Function to check for subsequent Related Causes values for
; the specified field
; RCAUSE - Dictionary Screen function for Related Causes fields.
; (356.22,2.8,356.22,2.9,356.22,2.1)
;-----------------------------------------------------------------------------
;
RCAUSE(FIELD) ;EP
; Dictionary Screen function called from the following fields: 2.08,2.09,2.1
; Prevents the same Related Cause from being entered in more than one field.
; Input: FIELD - Field # of the field being checked
; DA - IEN of the 356.22 entry being edited
; Y - Internal Value of the user response
; Returns: 1 - Data input by the user is valid, 0 otherwise
N NDE,RETURN
S RETURN=1 ; Assume Valid Input
Q:Y="" 1 ; No value entered
S NDE=$G(^IBT(356.22,DA,2))
;
; Make sure there are no duplicates
I FIELD=2.08 D Q RETURN
. I $P(NDE,"^",9)=Y S RETURN=0 Q
. I $P(NDE,"^",10)=Y S RETURN=0 Q
I FIELD=2.09 D Q RETURN
. I $P(NDE,"^",8)=Y S RETURN=0 Q
. I $P(NDE,"^",10)=Y S RETURN=0 Q
. I Y'="AP",Y'="EM" S RETURN=0 Q
I FIELD=2.1 D Q RETURN
. I Y'="AP" S RETURN=0 Q
Q RETURN
;
RCAUSEP(FIELD) ;EP
; Called from Input Template IB CREATE 278 REQUEST for fields: 2.08, 2.09
; Checks to see if subsequent Related Causes entries have values.
; Input: FIELD - Field # of the field being checked
; Set to 'ALL' to see if any of the 3 have a value
; DA - IEN of the 356.22 entry being edited
; Returns: 1 - Subsequent entries have values, 0 otherwise
N NDE,RETURN
S NDE=$G(^IBT(356.22,DA,2))
S RETURN=0
;
I FIELD="ALL" D Q RETURN
. I $P(NDE,"^",8)'="" S RETURN=1 Q
. I $P(NDE,"^",9)'="" S RETURN=1 Q
. I $P(NDE,"^",10)'="" S RETURN=1 Q
I FIELD=2.08 D Q RETURN
. I $P(NDE,"^",9)'="" S RETURN=1 Q
. I $P(NDE,"^",10)'="" S RETURN=1 Q
I FIELD=2.09 D Q RETURN
. I ($P(NDE,"^",8)="AP")!($P(NDE,"^",9)="AP") S RETURN=0 Q
. I $P(NDE,"^",10)="AP" S RETURN=1 Q
. I $P(NDE,"^",9)="",$P(NDE,"^",10)="" S RETURN=0 Q
. S RETURN=1
Q RETURN
;
DXCODE() ;EP
; Dictionary Screen function called from field: 3.02
; Prevents a duplicate ICD-9/ICD-10 or DRG Diagnosis from being entered
; Input: DA - IEN of Diagnosis multiple being entered/edited 95.3
; DA(1) - IEN of the 356.22 entry being edited
; DIC - Contains the global ref of dictionary being checked
; Y - Internal Value of the user response
; Returns: 1 - Data input by the user is valid, 0 otherwise
N CTYPE,DXCD,DXCDS,DXTYPE,IX,XX
Q:Y="" 1
S DXTYPE=$P($G(^IBT(356.22,DA(1),3,DA,0)),"^",1)
Q:DXTYPE="" 1
;
; Diagnosis Code must be from file 80.2 for a Diagnosis Type of
; Diagnosis Related Group (DRG)
I DXTYPE=9,$P(DIC,"^",2)'="ICD(" Q 0
;
; Check for LOI - Logical Observation Identifier Codes
I DXTYPE=10,$P(DIC,"^",2)'="LAB(95.3," Q 0
;
; Diagnosis Code must be from file 80 for all other Diagnosis Types
I DXTYPE'=9,$P(DIC,"^",2)'="ICD9(" Q 0
;
S CTYPE=$$GET1^DIQ(80,Y_",",1.1) ; Coding System
I CTYPE'="",DXTYPE'<1,DXTYPE'>4,CTYPE'["ICD-10-" Q 0 ; Not an ICD-10 Code
I CTYPE'="",DXTYPE'<5,DXTYPE'>8,CTYPE'["ICD-9-" Q 0 ; Not an ICD-9 Code
;
S IX=0,DXCDS=""
F D Q:+IX=0
. S IX=$O(^IBT(356.22,DA(1),3,IX))
. Q:+IX=0
. Q:IX=DA ; Skip Diagnosis being edited
. S DXCD=$P(^IBT(356.22,DA(1),3,IX,0),"^",2)
. S DXCDS=$S(DXCDS="":DXCD,1:DXCDS_"^"_DXCD)
;
; Diagnosis already exists in a different multiple
S XX=$S(DXTYPE=10:Y_";LAB(95.3,",DXTYPE=9:Y_";ICD(",1:Y_";ICD9(")
I ("^"_DXCDS_"^")[("^"_XX_"^") Q 0
Q 1
;
CERTCAT(IBPSTAT) ;EP
; Called from Input Template: IB CREATE 278 REQUEST
; Used to ask the user if they want to add/edit information for a specified
; Certification Code Category. Prompts for a category and then returns the
; 'Branch To' Label for the specified category to be added edited
; Input: IBPSTAT - 'I' - Entry is for an In-Patient
; 'O' - Entry is for an Out-Patient
; Output: IHUPOUT - Defined and set to 1 if user entered '^'
; Returns: 'Branch To' Label in the input template
; 0 if User pressed ^ to exit the template
; NOTE: if 0 is returned, IBUPOUT=1 is also returned
N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,SEL,XX
S SEL="07:Ambulance Certification;08:Chiropractic Certification"
S SEL=SEL_";09:Durable Medical Equipment Certification;11:Oxygen Therapy Certification"
S SEL=SEL_";75:Functional Limitations;76:Activities Permitted"
S SEL=SEL_";77:Mental Status"
S XX="Select a Certification Condition Code Category for which you want to "
S XX=XX_"additional certification information."
S DIR("?")=XX
S DIR(0)="SAO^"_SEL
S DIR("A")="Additional Certification Information: "
D ^DIR K DIR
I $D(DUOUT) S IBUPOUT=1 Q 0 ; User pressed ^
I $D(DTOUT) Q "@1300" ; User timed out
Q:Y="" "@1300"
Q:+Y=7 "@370"
Q:+Y=8 "@600"
Q:+Y=9 "@700"
Q:+Y=11 "@800"
Q:+Y=75 "@900"
Q:+Y=76 "@1000"
Q:+Y=77 "@1100"
;
CERTCOND(FIELD) ;EP
; Dictionary Screen function called from the following Certification Condition
; fields in file 356.22: 4.1,4.11,4.12,4.13,4.14 (Ambulance Cert Conditions)
; 5.02,5.03,5.04,5.05,5.06 (Chiropractic Cert Conds)
; 5.08,5.09,5.1,5.11,5.12 (DME Cert Conditions)
; 5.14,5.15,5.16,5.17,5.18 (Oxygen Cert Conditions)
; 6.02,6.03,6.04,6.05,6.06 (Functional Limit Cert Cond)
; 6.08,6.09,6.1,6.11,6.12 (Activities Cert Conditions)
; 6.14,6.15,6.16,6.17,6.18 (Mental Health Cert Conds)
; Prevents the same Certification Condition from being answered in the
; specified Certification Condition Category (e.g. Ambulance, Chiropractic,
; etc.). Also restricts user selection to a specified list by Certification
; Condition Category. Finally, also prevents the user from deleting any EXCEPT
; the last entered Certification Condition in any category.
; Input: FIELD - Field # of the field being checked
; DA - IEN of the 356.22 entry being edited
; Y - Internal Value of the user response
; Returns: 1 - Data input by the user is valid, 0 otherwise
Q:Y="" 1 ; No value entered
;
; Otherwise, make sure there are no duplicate entries in a specified Condition
; Category and that only specified entries in 356.008 are selected for a
; specified Condition Category
I FIELD>4.09,FIELD<4.15 Q $$CONDAMB(DA,FIELD,Y)
I FIELD>5.01,FIELD<5.07 Q $$CONDCHR(DA,FIELD,Y)
I FIELD>5.07,FIELD<5.13 Q $$CONDDME(DA,FIELD,Y)
I FIELD>5.13,FIELD<5.19 Q $$CONDOXY(DA,FIELD,Y)
I FIELD>6.01,FIELD<6.07 Q $$CONDFL(DA,FIELD,Y)
I FIELD>6.07,FIELD<6.13 Q $$CONDA(DA,FIELD,Y)
I FIELD>6.13,FIELD<6.19 Q $$CONDMS(DA,FIELD,Y)
Q 1
;
CERTCNDP(IBTRIEN,FIELD) ;EP
; Called from Input Template IB CREATE 278 REQUEST for Certification Condition
; fields. Checks to see if subsequent Certification Condition entries have
; values.
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field the being checked
; Returns: 1 - Subsequent entries have values, 0 otherwise
N NDE,RETURN
S RETURN=0
;
; Ambulance Cert Conditions
S NDE=$G(^IBT(356.22,IBTRIEN,4))
I FIELD=4.1 D Q RETURN
. I $P(NDE,"^",11)'="" S RETURN=1 Q
. I $P(NDE,"^",12)'="" S RETURN=1 Q
. I $P(NDE,"^",13)'="" S RETURN=1 Q
. I $P(NDE,"^",14)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=4.11 D Q RETURN
. I $P(NDE,"^",12)'="" S RETURN=1 Q
. I $P(NDE,"^",13)'="" S RETURN=1 Q
. I $P(NDE,"^",14)'="" S RETURN=1 Q
I FIELD=4.12 D Q RETURN
. I $P(NDE,"^",13)'="" S RETURN=1 Q
. I $P(NDE,"^",14)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=4.13,($P(NDE,"^",14)'="") Q 1
;
; Chiropractic Cert Conditions
S NDE=$G(^IBT(356.22,IBTRIEN,5))
I FIELD=5.02 D Q RETURN
. I $P(NDE,"^",3)'="" S RETURN=1 Q
. I $P(NDE,"^",4)'="" S RETURN=1 Q
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. I $P(NDE,"^",6)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=5.03 D Q RETURN
. I $P(NDE,"^",4)'="" S RETURN=1 Q
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. I $P(NDE,"^",6)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=5.04 D Q RETURN
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. I $P(NDE,"^",6)'="" S RETURN=1 Q
I FIELD=5.05,($P(NDE,"^",6)'="") Q 1
;
; DME Cert Conditions
I FIELD=5.08 D Q RETURN
. I $P(NDE,"^",9)'="" S RETURN=1 Q
. I $P(NDE,"^",10)'="" S RETURN=1 Q
. I $P(NDE,"^",11)'="" S RETURN=1 Q
. I $P(NDE,"^",12)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=5.09 D Q RETURN
. I $P(NDE,"^",10)'="" S RETURN=1 Q
. I $P(NDE,"^",11)'="" S RETURN=1 Q
. I $P(NDE,"^",12)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=5.1 D Q RETURN
. I $P(NDE,"^",11)'="" S RETURN=1 Q
. I $P(NDE,"^",12)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=5.11,($P(NDE,"^",12)'="") Q 1
;
; Oxygen Cert Conditions
I FIELD=5.14 D Q RETURN
. I $P(NDE,"^",15)'="" S RETURN=1 Q
. I $P(NDE,"^",16)'="" S RETURN=1 Q
. I $P(NDE,"^",17)'="" S RETURN=1 Q
. I $P(NDE,"^",18)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=5.15 D Q RETURN
. I $P(NDE,"^",16)'="" S RETURN=1 Q
. I $P(NDE,"^",17)'="" S RETURN=1 Q
. I $P(NDE,"^",18)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=5.16 D Q RETURN
. I $P(NDE,"^",17)'="" S RETURN=1 Q
. I $P(NDE,"^",18)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=5.17,($P(NDE,"^",18)'="") Q 1
;
; Functional Limits Cert Conditions
S NDE=$G(^IBT(356.22,IBTRIEN,6))
I FIELD=6.02 D Q RETURN
. I $P(NDE,"^",3)'="" S RETURN=1 Q
. I $P(NDE,"^",4)'="" S RETURN=1 Q
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. I $P(NDE,"^",6)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.03 D Q RETURN
. I $P(NDE,"^",4)'="" S RETURN=1 Q
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. I $P(NDE,"^",6)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.04 D Q RETURN
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. I $P(NDE,"^",6)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.05,($P(NDE,"^",6)'="") Q 1
;
; Activities Cert Conditions
I FIELD=6.08 D Q RETURN
. I $P(NDE,"^",9)'="" S RETURN=1 Q
. I $P(NDE,"^",10)'="" S RETURN=1 Q
. I $P(NDE,"^",11)'="" S RETURN=1 Q
. I $P(NDE,"^",12)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.09 D Q RETURN
. I $P(NDE,"^",10)'="" S RETURN=1 Q
. I $P(NDE,"^",11)'="" S RETURN=1 Q
. I $P(NDE,"^",12)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.1 D Q RETURN
. I $P(NDE,"^",11)'="" S RETURN=1 Q
. I $P(NDE,"^",12)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.11,($P(NDE,"^",12)'="") Q 1
;
; Mental Status Cert Conditions
I FIELD=6.14 D Q RETURN
. I $P(NDE,"^",15)'="" S RETURN=1 Q
. I $P(NDE,"^",16)'="" S RETURN=1 Q
. I $P(NDE,"^",17)'="" S RETURN=1 Q
. I $P(NDE,"^",18)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.15 D Q RETURN
. I $P(NDE,"^",16)'="" S RETURN=1 Q
. I $P(NDE,"^",17)'="" S RETURN=1 Q
. I $P(NDE,"^",18)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.16 D Q RETURN
. I $P(NDE,"^",17)'="" S RETURN=1 Q
. I $P(NDE,"^",18)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=6.17,($P(NDE,"^",18)'="") Q 1
Q 0
;
CONDAMB(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
; Condition is valid for Ambulance Certification Conditions and it's not a
; duplicate
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field value being checked
; VALUE - Internal value being validated
; Returns: 1 if the field value is valid, 0 otherwise
N CCONDS,NDE,PCE,PCES,XX
S CCONDS="",NDE=$G(^IBT(356.22,IBTRIEN,4))
;
; First, set an array of valid entries of valid Ambulance Conditions
F XX=1:1:9,40,42,48,49,52 S CCONDS(XX)=""
;
; Value is not valid for Ambulance Certification Conditions
I '$D(CCONDS(VALUE)) Q 0
;
; Next, check for duplicate values
S PCES="10^11^12^13^14"
S PCE=$S(FIELD=4.1:10,FIELD=4.11:11,FIELD=4.12:12,FIELD=4.13:13,1:14)
Q $$CHKDUPS(PCE,VALUE,NDE,PCES)
;
CONDCHR(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
; Condition is valid for Chiropractic Certification Conditions and it's not a
; duplicate
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field value being checked
; VALUE - Internal value being validated
; Returns: 1 if the field value is valid, 0 otherwise
N CCONDS,NDE,PCE,PCES,XX
S CCONDS="",NDE=$G(^IBT(356.22,IBTRIEN,5))
;
; First, set an array of valid entries of valid Chiropractic Conditions
F XX=11,12,14,24,25,27,30 S CCONDS(XX)=""
;
; Value is not valid for Chiropractic Certification Conditions
I '$D(CCONDS(VALUE)) Q 0
;
; Next, check for duplicate values
S PCES="2^3^4^5^6"
S PCE=$S(FIELD=5.02:2,FIELD=5.03:3,FIELD=5.04:4,FIELD=5.05:5,1:6)
Q $$CHKDUPS(PCE,VALUE,NDE,PCES)
;
CONDDME(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
; Condition is valid for DME Certification Conditions and it's not a
; duplicate
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field value being checked
; VALUE - Internal value being validated
; Returns: 1 if the field value is valid, 0 otherwise
N CCONDS,NDE,PCE,PCES,XX
S CCONDS="",NDE=$G(^IBT(356.22,IBTRIEN,5))
;
; First, set an array of valid entries of valid DME Conditions
F XX=1:1:27,29:1:33,35,36,37,39:1:47,49,52,55,56,57,79,80,88 D
. S CCONDS(XX)=""
;
; Value is not valid for DME Certification Conditions
I '$D(CCONDS(VALUE)) Q 0
;
; Next, check for duplicate values
S PCES="8^9^10^11^12"
S PCE=$S(FIELD=5.08:8,FIELD=5.09:9,FIELD=5.1:10,FIELD=5.11:11,1:12)
Q $$CHKDUPS(PCE,VALUE,NDE,PCES)
;
CONDOXY(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
; Condition is valid for Oxygen Certification Conditions and it's not a
; duplicate
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field value being checked
; VALUE - Internal value being validated
; Returns: 1 if the field value is valid, 0 otherwise
N CCONDS,NDE,PCE,PCES,XX
S CCONDS="",NDE=$G(^IBT(356.22,IBTRIEN,5))
;
; First, set an array of valid entries of valid Oxygen Conditions
F XX=6,16,17,25,33,36,38,48,56,57,73 S CCONDS(XX)=""
;
; Value is not valid for Oxygen Certification Conditions
I '$D(CCONDS(VALUE)) Q 0
;
; Next, check for duplicate values
S PCES="14^15^16^17^18"
S PCE=$S(FIELD=5.14:14,FIELD=5.15:15,FIELD=5.16:16,FIELD=5.17:17,1:18)
Q $$CHKDUPS(PCE,VALUE,NDE,PCES)
;
CONDFL(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
; Condition is valid for Functional Limitations Certification Conditions and
; it's not a duplicate
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field value being checked
; VALUE - Internal value being validated
; Returns: 1 if the field value is valid, 0 otherwise
N CCONDS,NDE,PCE,PCES,XX
S CCONDS="",NDE=$G(^IBT(356.22,IBTRIEN,6))
;
; First, set an array of valid entries of valid Functional Limitations
; Conditions
F XX=2:1:6,11,12,14:1:28,30,31,32,35,36,38:1:45,48 D
. S CCONDS(XX)=""
F XX=50,51,53,54,55,58,60,61,62,64,65,66,68,69,73,74,75,78,80,81,84,86:1:89,93,94 D
. S CCONDS(XX)=""
;
; Value is not valid for Functional Limitations Certification Conditions
I '$D(CCONDS(VALUE)) Q 0
;
; Next, check for duplicate values
S PCES="2^3^4^5^6"
S PCE=$S(FIELD=6.02:2,FIELD=6.03:3,FIELD=6.04:4,FIELD=6.05:5,1:6)
Q $$CHKDUPS(PCE,VALUE,NDE,PCES)
;
CONDA(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
; Condition is valid for Activities Certification Conditions and
; it's not a duplicate
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field value being checked
; VALUE - Internal value being validated
; Returns: 1 if the field value is valid, 0 otherwise
N CCONDS,NDE,PCE,PCES,XX
S CCONDS="",NDE=$G(^IBT(356.22,IBTRIEN,6))
;
; First, set an array of valid entries of valid Activities Conditions
F XX=10,13,19,21,22,27,31,39,63,65,66,70,74,75,79,83,86,87,90,92,93,94 D
. S CCONDS(XX)=""
;
; Value is not valid for Activities Certification Conditions
I '$D(CCONDS(VALUE)) Q 0
;
; Next, check for duplicate values
S PCES="8^9^10^11^12"
S PCE=$S(FIELD=6.08:8,FIELD=6.09:9,FIELD=6.1:10,FIELD=6.11:11,1:12)
Q $$CHKDUPS(PCE,VALUE,NDE,PCES)
;
CONDMS(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
; Condition is valid for Mental Status Certification Conditions and
; it's not a duplicate
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field value being checked
; VALUE - Internal value being validated
; Returns: 1 if the field value is valid, 0 otherwise
N CCONDS,NDE,PCE,PCES,XX
S CCONDS="",NDE=$G(^IBT(356.22,IBTRIEN,6))
;
; First, set an array of valid entries of valid Mental Status Conditions
F XX=1,5,7,13,20,22,23,26,33,34,48,50,51,53,54,56,57,59,62,64,66,67,71,72,76,77,81,82,85,91 D
. S CCONDS(XX)=""
;
; Value is not valid for Functional Limitations Certification Conditions
I '$D(CCONDS(VALUE)) Q 0
;
; Next, check for duplicate values
S PCES="14^15^16^17^18"
S PCE=$S(FIELD=6.14:14,FIELD=6.15:15,FIELD=6.16:16,FIELD=6.17:17,1:18)
Q $$CHKDUPS(PCE,VALUE,NDE,PCES)
;
CHKDUPS(FPCE,VALUE,NDE,PCES) ;EP
; Generic duplicate field checker. Checks for a duplicate value in a list of
; fields to prevent the same value from being entered in more than field in
; the list
; Input: FPCE - Piece # of the field being checked
; VALUE - Internal Value of the user response
; NDE - HCSR Transmission file node that contains the fields
; PCES - '^' delimited list of storage locations for above fields
; Returns: 1 - No duplicates found, 0 otherwise
N IX,PCE,RETURN
S RETURN=1 ; Assume Valid Input
Q:VALUE="" 1 ; No value entered
;
; Make sure there are no duplicates
F IX=1:1:$L(PCES,"^") D Q:RETURN=0
. S PCE=$P(PCES,"^",IX)
. Q:PCE=FPCE
. I $P(NDE,"^",PCE)=VALUE S RETURN=0 Q
Q RETURN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH5A 19768 printed Apr 09, 2024@21:17:55 Page 2
IBTRH5A ;ALB/FA - HCSR Create 278 Request ;12-AUG-2014
+1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 ; Contains Entry points and functions used in creating a 278 request from a
+5 ; selected entry in the HCSR Response worklist
+6 ;
+7 ; -------------------------- Entry Points --------------------------------
+8 ; CERTCAT - Function called from within Input Template: IB CREATE 278 REQUEST
+9 ; to allow the user to enter Certification information for a
+10 ; selected Certification Code Category.
+11 ; CERTCOND - Dictionary Screen function for Certification Conditions.
+12 ; Prevents duplicate Certification Conditions from being entered.
+13 ; CERTCNDP - Function to check for subsequent Certification Conditions
+14 ; values for the specified field
+15 ; DXCODE - Dictionary Screen function for Diagnosis Code field 356.22,3.02
+16 ; RCAUSEP - Function to check for subsequent Related Causes values for
+17 ; the specified field
+18 ; RCAUSE - Dictionary Screen function for Related Causes fields.
+19 ; (356.22,2.8,356.22,2.9,356.22,2.1)
+20 ;-----------------------------------------------------------------------------
+21 ;
RCAUSE(FIELD) ;EP
+1 ; Dictionary Screen function called from the following fields: 2.08,2.09,2.1
+2 ; Prevents the same Related Cause from being entered in more than one field.
+3 ; Input: FIELD - Field # of the field being checked
+4 ; DA - IEN of the 356.22 entry being edited
+5 ; Y - Internal Value of the user response
+6 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+7 NEW NDE,RETURN
+8 ; Assume Valid Input
SET RETURN=1
+9 ; No value entered
if Y=""
QUIT 1
+10 SET NDE=$GET(^IBT(356.22,DA,2))
+11 ;
+12 ; Make sure there are no duplicates
+13 IF FIELD=2.08
Begin DoDot:1
+14 IF $PIECE(NDE,"^",9)=Y
SET RETURN=0
QUIT
+15 IF $PIECE(NDE,"^",10)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+16 IF FIELD=2.09
Begin DoDot:1
+17 IF $PIECE(NDE,"^",8)=Y
SET RETURN=0
QUIT
+18 IF $PIECE(NDE,"^",10)=Y
SET RETURN=0
QUIT
+19 IF Y'="AP"
IF Y'="EM"
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+20 IF FIELD=2.1
Begin DoDot:1
+21 IF Y'="AP"
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+22 QUIT RETURN
+23 ;
RCAUSEP(FIELD) ;EP
+1 ; Called from Input Template IB CREATE 278 REQUEST for fields: 2.08, 2.09
+2 ; Checks to see if subsequent Related Causes entries have values.
+3 ; Input: FIELD - Field # of the field being checked
+4 ; Set to 'ALL' to see if any of the 3 have a value
+5 ; DA - IEN of the 356.22 entry being edited
+6 ; Returns: 1 - Subsequent entries have values, 0 otherwise
+7 NEW NDE,RETURN
+8 SET NDE=$GET(^IBT(356.22,DA,2))
+9 SET RETURN=0
+10 ;
+11 IF FIELD="ALL"
Begin DoDot:1
+12 IF $PIECE(NDE,"^",8)'=""
SET RETURN=1
QUIT
+13 IF $PIECE(NDE,"^",9)'=""
SET RETURN=1
QUIT
+14 IF $PIECE(NDE,"^",10)'=""
SET RETURN=1
QUIT
End DoDot:1
QUIT RETURN
+15 IF FIELD=2.08
Begin DoDot:1
+16 IF $PIECE(NDE,"^",9)'=""
SET RETURN=1
QUIT
+17 IF $PIECE(NDE,"^",10)'=""
SET RETURN=1
QUIT
End DoDot:1
QUIT RETURN
+18 IF FIELD=2.09
Begin DoDot:1
+19 IF ($PIECE(NDE,"^",8)="AP")!($PIECE(NDE,"^",9)="AP")
SET RETURN=0
QUIT
+20 IF $PIECE(NDE,"^",10)="AP"
SET RETURN=1
QUIT
+21 IF $PIECE(NDE,"^",9)=""
IF $PIECE(NDE,"^",10)=""
SET RETURN=0
QUIT
+22 SET RETURN=1
End DoDot:1
QUIT RETURN
+23 QUIT RETURN
+24 ;
DXCODE() ;EP
+1 ; Dictionary Screen function called from field: 3.02
+2 ; Prevents a duplicate ICD-9/ICD-10 or DRG Diagnosis from being entered
+3 ; Input: DA - IEN of Diagnosis multiple being entered/edited 95.3
+4 ; DA(1) - IEN of the 356.22 entry being edited
+5 ; DIC - Contains the global ref of dictionary being checked
+6 ; Y - Internal Value of the user response
+7 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+8 NEW CTYPE,DXCD,DXCDS,DXTYPE,IX,XX
+9 if Y=""
QUIT 1
+10 SET DXTYPE=$PIECE($GET(^IBT(356.22,DA(1),3,DA,0)),"^",1)
+11 if DXTYPE=""
QUIT 1
+12 ;
+13 ; Diagnosis Code must be from file 80.2 for a Diagnosis Type of
+14 ; Diagnosis Related Group (DRG)
+15 IF DXTYPE=9
IF $PIECE(DIC,"^",2)'="ICD("
QUIT 0
+16 ;
+17 ; Check for LOI - Logical Observation Identifier Codes
+18 IF DXTYPE=10
IF $PIECE(DIC,"^",2)'="LAB(95.3,"
QUIT 0
+19 ;
+20 ; Diagnosis Code must be from file 80 for all other Diagnosis Types
+21 IF DXTYPE'=9
IF $PIECE(DIC,"^",2)'="ICD9("
QUIT 0
+22 ;
+23 ; Coding System
SET CTYPE=$$GET1^DIQ(80,Y_",",1.1)
+24 ; Not an ICD-10 Code
IF CTYPE'=""
IF DXTYPE'<1
IF DXTYPE'>4
IF CTYPE'["ICD-10-"
QUIT 0
+25 ; Not an ICD-9 Code
IF CTYPE'=""
IF DXTYPE'<5
IF DXTYPE'>8
IF CTYPE'["ICD-9-"
QUIT 0
+26 ;
+27 SET IX=0
SET DXCDS=""
+28 FOR
Begin DoDot:1
+29 SET IX=$ORDER(^IBT(356.22,DA(1),3,IX))
+30 if +IX=0
QUIT
+31 ; Skip Diagnosis being edited
if IX=DA
QUIT
+32 SET DXCD=$PIECE(^IBT(356.22,DA(1),3,IX,0),"^",2)
+33 SET DXCDS=$SELECT(DXCDS="":DXCD,1:DXCDS_"^"_DXCD)
End DoDot:1
if +IX=0
QUIT
+34 ;
+35 ; Diagnosis already exists in a different multiple
+36 SET XX=$SELECT(DXTYPE=10:Y_";LAB(95.3,",DXTYPE=9:Y_";ICD(",1:Y_";ICD9(")
+37 IF ("^"_DXCDS_"^")[("^"_XX_"^")
QUIT 0
+38 QUIT 1
+39 ;
CERTCAT(IBPSTAT) ;EP
+1 ; Called from Input Template: IB CREATE 278 REQUEST
+2 ; Used to ask the user if they want to add/edit information for a specified
+3 ; Certification Code Category. Prompts for a category and then returns the
+4 ; 'Branch To' Label for the specified category to be added edited
+5 ; Input: IBPSTAT - 'I' - Entry is for an In-Patient
+6 ; 'O' - Entry is for an Out-Patient
+7 ; Output: IHUPOUT - Defined and set to 1 if user entered '^'
+8 ; Returns: 'Branch To' Label in the input template
+9 ; 0 if User pressed ^ to exit the template
+10 ; NOTE: if 0 is returned, IBUPOUT=1 is also returned
+11 NEW DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,SEL,XX
+12 SET SEL="07:Ambulance Certification;08:Chiropractic Certification"
+13 SET SEL=SEL_";09:Durable Medical Equipment Certification;11:Oxygen Therapy Certification"
+14 SET SEL=SEL_";75:Functional Limitations;76:Activities Permitted"
+15 SET SEL=SEL_";77:Mental Status"
+16 SET XX="Select a Certification Condition Code Category for which you want to "
+17 SET XX=XX_"additional certification information."
+18 SET DIR("?")=XX
+19 SET DIR(0)="SAO^"_SEL
+20 SET DIR("A")="Additional Certification Information: "
+21 DO ^DIR
KILL DIR
+22 ; User pressed ^
IF $DATA(DUOUT)
SET IBUPOUT=1
QUIT 0
+23 ; User timed out
IF $DATA(DTOUT)
QUIT "@1300"
+24 if Y=""
QUIT "@1300"
+25 if +Y=7
QUIT "@370"
+26 if +Y=8
QUIT "@600"
+27 if +Y=9
QUIT "@700"
+28 if +Y=11
QUIT "@800"
+29 if +Y=75
QUIT "@900"
+30 if +Y=76
QUIT "@1000"
+31 if +Y=77
QUIT "@1100"
+32 ;
CERTCOND(FIELD) ;EP
+1 ; Dictionary Screen function called from the following Certification Condition
+2 ; fields in file 356.22: 4.1,4.11,4.12,4.13,4.14 (Ambulance Cert Conditions)
+3 ; 5.02,5.03,5.04,5.05,5.06 (Chiropractic Cert Conds)
+4 ; 5.08,5.09,5.1,5.11,5.12 (DME Cert Conditions)
+5 ; 5.14,5.15,5.16,5.17,5.18 (Oxygen Cert Conditions)
+6 ; 6.02,6.03,6.04,6.05,6.06 (Functional Limit Cert Cond)
+7 ; 6.08,6.09,6.1,6.11,6.12 (Activities Cert Conditions)
+8 ; 6.14,6.15,6.16,6.17,6.18 (Mental Health Cert Conds)
+9 ; Prevents the same Certification Condition from being answered in the
+10 ; specified Certification Condition Category (e.g. Ambulance, Chiropractic,
+11 ; etc.). Also restricts user selection to a specified list by Certification
+12 ; Condition Category. Finally, also prevents the user from deleting any EXCEPT
+13 ; the last entered Certification Condition in any category.
+14 ; Input: FIELD - Field # of the field being checked
+15 ; DA - IEN of the 356.22 entry being edited
+16 ; Y - Internal Value of the user response
+17 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+18 ; No value entered
if Y=""
QUIT 1
+19 ;
+20 ; Otherwise, make sure there are no duplicate entries in a specified Condition
+21 ; Category and that only specified entries in 356.008 are selected for a
+22 ; specified Condition Category
+23 IF FIELD>4.09
IF FIELD<4.15
QUIT $$CONDAMB(DA,FIELD,Y)
+24 IF FIELD>5.01
IF FIELD<5.07
QUIT $$CONDCHR(DA,FIELD,Y)
+25 IF FIELD>5.07
IF FIELD<5.13
QUIT $$CONDDME(DA,FIELD,Y)
+26 IF FIELD>5.13
IF FIELD<5.19
QUIT $$CONDOXY(DA,FIELD,Y)
+27 IF FIELD>6.01
IF FIELD<6.07
QUIT $$CONDFL(DA,FIELD,Y)
+28 IF FIELD>6.07
IF FIELD<6.13
QUIT $$CONDA(DA,FIELD,Y)
+29 IF FIELD>6.13
IF FIELD<6.19
QUIT $$CONDMS(DA,FIELD,Y)
+30 QUIT 1
+31 ;
CERTCNDP(IBTRIEN,FIELD) ;EP
+1 ; Called from Input Template IB CREATE 278 REQUEST for Certification Condition
+2 ; fields. Checks to see if subsequent Certification Condition entries have
+3 ; values.
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; FIELD - Field number of the field the being checked
+6 ; Returns: 1 - Subsequent entries have values, 0 otherwise
+7 NEW NDE,RETURN
+8 SET RETURN=0
+9 ;
+10 ; Ambulance Cert Conditions
+11 SET NDE=$GET(^IBT(356.22,IBTRIEN,4))
+12 IF FIELD=4.1
Begin DoDot:1
+13 IF $PIECE(NDE,"^",11)'=""
SET RETURN=1
QUIT
+14 IF $PIECE(NDE,"^",12)'=""
SET RETURN=1
QUIT
+15 IF $PIECE(NDE,"^",13)'=""
SET RETURN=1
QUIT
+16 IF $PIECE(NDE,"^",14)'=""
SET RETURN=1
QUIT
+17 SET RETURN=0
End DoDot:1
QUIT RETURN
+18 IF FIELD=4.11
Begin DoDot:1
+19 IF $PIECE(NDE,"^",12)'=""
SET RETURN=1
QUIT
+20 IF $PIECE(NDE,"^",13)'=""
SET RETURN=1
QUIT
+21 IF $PIECE(NDE,"^",14)'=""
SET RETURN=1
QUIT
End DoDot:1
QUIT RETURN
+22 IF FIELD=4.12
Begin DoDot:1
+23 IF $PIECE(NDE,"^",13)'=""
SET RETURN=1
QUIT
+24 IF $PIECE(NDE,"^",14)'=""
SET RETURN=1
QUIT
+25 SET RETURN=0
End DoDot:1
QUIT RETURN
+26 IF FIELD=4.13
IF ($PIECE(NDE,"^",14)'="")
QUIT 1
+27 ;
+28 ; Chiropractic Cert Conditions
+29 SET NDE=$GET(^IBT(356.22,IBTRIEN,5))
+30 IF FIELD=5.02
Begin DoDot:1
+31 IF $PIECE(NDE,"^",3)'=""
SET RETURN=1
QUIT
+32 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+33 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+34 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+35 SET RETURN=0
End DoDot:1
QUIT RETURN
+36 IF FIELD=5.03
Begin DoDot:1
+37 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+38 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+39 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+40 SET RETURN=0
End DoDot:1
QUIT RETURN
+41 IF FIELD=5.04
Begin DoDot:1
+42 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+43 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
End DoDot:1
QUIT RETURN
+44 IF FIELD=5.05
IF ($PIECE(NDE,"^",6)'="")
QUIT 1
+45 ;
+46 ; DME Cert Conditions
+47 IF FIELD=5.08
Begin DoDot:1
+48 IF $PIECE(NDE,"^",9)'=""
SET RETURN=1
QUIT
+49 IF $PIECE(NDE,"^",10)'=""
SET RETURN=1
QUIT
+50 IF $PIECE(NDE,"^",11)'=""
SET RETURN=1
QUIT
+51 IF $PIECE(NDE,"^",12)'=""
SET RETURN=1
QUIT
+52 SET RETURN=0
End DoDot:1
QUIT RETURN
+53 IF FIELD=5.09
Begin DoDot:1
+54 IF $PIECE(NDE,"^",10)'=""
SET RETURN=1
QUIT
+55 IF $PIECE(NDE,"^",11)'=""
SET RETURN=1
QUIT
+56 IF $PIECE(NDE,"^",12)'=""
SET RETURN=1
QUIT
+57 SET RETURN=0
End DoDot:1
QUIT RETURN
+58 IF FIELD=5.1
Begin DoDot:1
+59 IF $PIECE(NDE,"^",11)'=""
SET RETURN=1
QUIT
+60 IF $PIECE(NDE,"^",12)'=""
SET RETURN=1
QUIT
+61 SET RETURN=0
End DoDot:1
QUIT RETURN
+62 IF FIELD=5.11
IF ($PIECE(NDE,"^",12)'="")
QUIT 1
+63 ;
+64 ; Oxygen Cert Conditions
+65 IF FIELD=5.14
Begin DoDot:1
+66 IF $PIECE(NDE,"^",15)'=""
SET RETURN=1
QUIT
+67 IF $PIECE(NDE,"^",16)'=""
SET RETURN=1
QUIT
+68 IF $PIECE(NDE,"^",17)'=""
SET RETURN=1
QUIT
+69 IF $PIECE(NDE,"^",18)'=""
SET RETURN=1
QUIT
+70 SET RETURN=0
End DoDot:1
QUIT RETURN
+71 IF FIELD=5.15
Begin DoDot:1
+72 IF $PIECE(NDE,"^",16)'=""
SET RETURN=1
QUIT
+73 IF $PIECE(NDE,"^",17)'=""
SET RETURN=1
QUIT
+74 IF $PIECE(NDE,"^",18)'=""
SET RETURN=1
QUIT
+75 SET RETURN=0
End DoDot:1
QUIT RETURN
+76 IF FIELD=5.16
Begin DoDot:1
+77 IF $PIECE(NDE,"^",17)'=""
SET RETURN=1
QUIT
+78 IF $PIECE(NDE,"^",18)'=""
SET RETURN=1
QUIT
+79 SET RETURN=0
End DoDot:1
QUIT RETURN
+80 IF FIELD=5.17
IF ($PIECE(NDE,"^",18)'="")
QUIT 1
+81 ;
+82 ; Functional Limits Cert Conditions
+83 SET NDE=$GET(^IBT(356.22,IBTRIEN,6))
+84 IF FIELD=6.02
Begin DoDot:1
+85 IF $PIECE(NDE,"^",3)'=""
SET RETURN=1
QUIT
+86 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+87 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+88 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+89 SET RETURN=0
End DoDot:1
QUIT RETURN
+90 IF FIELD=6.03
Begin DoDot:1
+91 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+92 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+93 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+94 SET RETURN=0
End DoDot:1
QUIT RETURN
+95 IF FIELD=6.04
Begin DoDot:1
+96 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+97 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+98 SET RETURN=0
End DoDot:1
QUIT RETURN
+99 IF FIELD=6.05
IF ($PIECE(NDE,"^",6)'="")
QUIT 1
+100 ;
+101 ; Activities Cert Conditions
+102 IF FIELD=6.08
Begin DoDot:1
+103 IF $PIECE(NDE,"^",9)'=""
SET RETURN=1
QUIT
+104 IF $PIECE(NDE,"^",10)'=""
SET RETURN=1
QUIT
+105 IF $PIECE(NDE,"^",11)'=""
SET RETURN=1
QUIT
+106 IF $PIECE(NDE,"^",12)'=""
SET RETURN=1
QUIT
+107 SET RETURN=0
End DoDot:1
QUIT RETURN
+108 IF FIELD=6.09
Begin DoDot:1
+109 IF $PIECE(NDE,"^",10)'=""
SET RETURN=1
QUIT
+110 IF $PIECE(NDE,"^",11)'=""
SET RETURN=1
QUIT
+111 IF $PIECE(NDE,"^",12)'=""
SET RETURN=1
QUIT
+112 SET RETURN=0
End DoDot:1
QUIT RETURN
+113 IF FIELD=6.1
Begin DoDot:1
+114 IF $PIECE(NDE,"^",11)'=""
SET RETURN=1
QUIT
+115 IF $PIECE(NDE,"^",12)'=""
SET RETURN=1
QUIT
+116 SET RETURN=0
End DoDot:1
QUIT RETURN
+117 IF FIELD=6.11
IF ($PIECE(NDE,"^",12)'="")
QUIT 1
+118 ;
+119 ; Mental Status Cert Conditions
+120 IF FIELD=6.14
Begin DoDot:1
+121 IF $PIECE(NDE,"^",15)'=""
SET RETURN=1
QUIT
+122 IF $PIECE(NDE,"^",16)'=""
SET RETURN=1
QUIT
+123 IF $PIECE(NDE,"^",17)'=""
SET RETURN=1
QUIT
+124 IF $PIECE(NDE,"^",18)'=""
SET RETURN=1
QUIT
+125 SET RETURN=0
End DoDot:1
QUIT RETURN
+126 IF FIELD=6.15
Begin DoDot:1
+127 IF $PIECE(NDE,"^",16)'=""
SET RETURN=1
QUIT
+128 IF $PIECE(NDE,"^",17)'=""
SET RETURN=1
QUIT
+129 IF $PIECE(NDE,"^",18)'=""
SET RETURN=1
QUIT
+130 SET RETURN=0
End DoDot:1
QUIT RETURN
+131 IF FIELD=6.16
Begin DoDot:1
+132 IF $PIECE(NDE,"^",17)'=""
SET RETURN=1
QUIT
+133 IF $PIECE(NDE,"^",18)'=""
SET RETURN=1
QUIT
+134 SET RETURN=0
End DoDot:1
QUIT RETURN
+135 IF FIELD=6.17
IF ($PIECE(NDE,"^",18)'="")
QUIT 1
+136 QUIT 0
+137 ;
CONDAMB(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
+1 ; Condition is valid for Ambulance Certification Conditions and it's not a
+2 ; duplicate
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; FIELD - Field number of the field value being checked
+5 ; VALUE - Internal value being validated
+6 ; Returns: 1 if the field value is valid, 0 otherwise
+7 NEW CCONDS,NDE,PCE,PCES,XX
+8 SET CCONDS=""
SET NDE=$GET(^IBT(356.22,IBTRIEN,4))
+9 ;
+10 ; First, set an array of valid entries of valid Ambulance Conditions
+11 FOR XX=1:1:9,40,42,48,49,52
SET CCONDS(XX)=""
+12 ;
+13 ; Value is not valid for Ambulance Certification Conditions
+14 IF '$DATA(CCONDS(VALUE))
QUIT 0
+15 ;
+16 ; Next, check for duplicate values
+17 SET PCES="10^11^12^13^14"
+18 SET PCE=$SELECT(FIELD=4.1:10,FIELD=4.11:11,FIELD=4.12:12,FIELD=4.13:13,1:14)
+19 QUIT $$CHKDUPS(PCE,VALUE,NDE,PCES)
+20 ;
CONDCHR(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
+1 ; Condition is valid for Chiropractic Certification Conditions and it's not a
+2 ; duplicate
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; FIELD - Field number of the field value being checked
+5 ; VALUE - Internal value being validated
+6 ; Returns: 1 if the field value is valid, 0 otherwise
+7 NEW CCONDS,NDE,PCE,PCES,XX
+8 SET CCONDS=""
SET NDE=$GET(^IBT(356.22,IBTRIEN,5))
+9 ;
+10 ; First, set an array of valid entries of valid Chiropractic Conditions
+11 FOR XX=11,12,14,24,25,27,30
SET CCONDS(XX)=""
+12 ;
+13 ; Value is not valid for Chiropractic Certification Conditions
+14 IF '$DATA(CCONDS(VALUE))
QUIT 0
+15 ;
+16 ; Next, check for duplicate values
+17 SET PCES="2^3^4^5^6"
+18 SET PCE=$SELECT(FIELD=5.02:2,FIELD=5.03:3,FIELD=5.04:4,FIELD=5.05:5,1:6)
+19 QUIT $$CHKDUPS(PCE,VALUE,NDE,PCES)
+20 ;
CONDDME(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
+1 ; Condition is valid for DME Certification Conditions and it's not a
+2 ; duplicate
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; FIELD - Field number of the field value being checked
+5 ; VALUE - Internal value being validated
+6 ; Returns: 1 if the field value is valid, 0 otherwise
+7 NEW CCONDS,NDE,PCE,PCES,XX
+8 SET CCONDS=""
SET NDE=$GET(^IBT(356.22,IBTRIEN,5))
+9 ;
+10 ; First, set an array of valid entries of valid DME Conditions
+11 FOR XX=1:1:27,29:1:33,35,36,37,39:1:47,49,52,55,56,57,79,80,88
Begin DoDot:1
+12 SET CCONDS(XX)=""
End DoDot:1
+13 ;
+14 ; Value is not valid for DME Certification Conditions
+15 IF '$DATA(CCONDS(VALUE))
QUIT 0
+16 ;
+17 ; Next, check for duplicate values
+18 SET PCES="8^9^10^11^12"
+19 SET PCE=$SELECT(FIELD=5.08:8,FIELD=5.09:9,FIELD=5.1:10,FIELD=5.11:11,1:12)
+20 QUIT $$CHKDUPS(PCE,VALUE,NDE,PCES)
+21 ;
CONDOXY(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
+1 ; Condition is valid for Oxygen Certification Conditions and it's not a
+2 ; duplicate
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; FIELD - Field number of the field value being checked
+5 ; VALUE - Internal value being validated
+6 ; Returns: 1 if the field value is valid, 0 otherwise
+7 NEW CCONDS,NDE,PCE,PCES,XX
+8 SET CCONDS=""
SET NDE=$GET(^IBT(356.22,IBTRIEN,5))
+9 ;
+10 ; First, set an array of valid entries of valid Oxygen Conditions
+11 FOR XX=6,16,17,25,33,36,38,48,56,57,73
SET CCONDS(XX)=""
+12 ;
+13 ; Value is not valid for Oxygen Certification Conditions
+14 IF '$DATA(CCONDS(VALUE))
QUIT 0
+15 ;
+16 ; Next, check for duplicate values
+17 SET PCES="14^15^16^17^18"
+18 SET PCE=$SELECT(FIELD=5.14:14,FIELD=5.15:15,FIELD=5.16:16,FIELD=5.17:17,1:18)
+19 QUIT $$CHKDUPS(PCE,VALUE,NDE,PCES)
+20 ;
CONDFL(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
+1 ; Condition is valid for Functional Limitations Certification Conditions and
+2 ; it's not a duplicate
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; FIELD - Field number of the field value being checked
+5 ; VALUE - Internal value being validated
+6 ; Returns: 1 if the field value is valid, 0 otherwise
+7 NEW CCONDS,NDE,PCE,PCES,XX
+8 SET CCONDS=""
SET NDE=$GET(^IBT(356.22,IBTRIEN,6))
+9 ;
+10 ; First, set an array of valid entries of valid Functional Limitations
+11 ; Conditions
+12 FOR XX=2:1:6,11,12,14:1:28,30,31,32,35,36,38:1:45,48
Begin DoDot:1
+13 SET CCONDS(XX)=""
End DoDot:1
+14 FOR XX=50,51,53,54,55,58,60,61,62,64,65,66,68,69,73,74,75,78,80,81,84,86:1:89,93,94
Begin DoDot:1
+15 SET CCONDS(XX)=""
End DoDot:1
+16 ;
+17 ; Value is not valid for Functional Limitations Certification Conditions
+18 IF '$DATA(CCONDS(VALUE))
QUIT 0
+19 ;
+20 ; Next, check for duplicate values
+21 SET PCES="2^3^4^5^6"
+22 SET PCE=$SELECT(FIELD=6.02:2,FIELD=6.03:3,FIELD=6.04:4,FIELD=6.05:5,1:6)
+23 QUIT $$CHKDUPS(PCE,VALUE,NDE,PCES)
+24 ;
CONDA(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
+1 ; Condition is valid for Activities Certification Conditions and
+2 ; it's not a duplicate
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; FIELD - Field number of the field value being checked
+5 ; VALUE - Internal value being validated
+6 ; Returns: 1 if the field value is valid, 0 otherwise
+7 NEW CCONDS,NDE,PCE,PCES,XX
+8 SET CCONDS=""
SET NDE=$GET(^IBT(356.22,IBTRIEN,6))
+9 ;
+10 ; First, set an array of valid entries of valid Activities Conditions
+11 FOR XX=10,13,19,21,22,27,31,39,63,65,66,70,74,75,79,83,86,87,90,92,93,94
Begin DoDot:1
+12 SET CCONDS(XX)=""
End DoDot:1
+13 ;
+14 ; Value is not valid for Activities Certification Conditions
+15 IF '$DATA(CCONDS(VALUE))
QUIT 0
+16 ;
+17 ; Next, check for duplicate values
+18 SET PCES="8^9^10^11^12"
+19 SET PCE=$SELECT(FIELD=6.08:8,FIELD=6.09:9,FIELD=6.1:10,FIELD=6.11:11,1:12)
+20 QUIT $$CHKDUPS(PCE,VALUE,NDE,PCES)
+21 ;
CONDMS(IBTRIEN,FIELD,VALUE) ; Makes sure the user entry for a Certification
+1 ; Condition is valid for Mental Status Certification Conditions and
+2 ; it's not a duplicate
+3 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+4 ; FIELD - Field number of the field value being checked
+5 ; VALUE - Internal value being validated
+6 ; Returns: 1 if the field value is valid, 0 otherwise
+7 NEW CCONDS,NDE,PCE,PCES,XX
+8 SET CCONDS=""
SET NDE=$GET(^IBT(356.22,IBTRIEN,6))
+9 ;
+10 ; First, set an array of valid entries of valid Mental Status Conditions
+11 FOR XX=1,5,7,13,20,22,23,26,33,34,48,50,51,53,54,56,57,59,62,64,66,67,71,72,76,77,81,82,85,91
Begin DoDot:1
+12 SET CCONDS(XX)=""
End DoDot:1
+13 ;
+14 ; Value is not valid for Functional Limitations Certification Conditions
+15 IF '$DATA(CCONDS(VALUE))
QUIT 0
+16 ;
+17 ; Next, check for duplicate values
+18 SET PCES="14^15^16^17^18"
+19 SET PCE=$SELECT(FIELD=6.14:14,FIELD=6.15:15,FIELD=6.16:16,FIELD=6.17:17,1:18)
+20 QUIT $$CHKDUPS(PCE,VALUE,NDE,PCES)
+21 ;
CHKDUPS(FPCE,VALUE,NDE,PCES) ;EP
+1 ; Generic duplicate field checker. Checks for a duplicate value in a list of
+2 ; fields to prevent the same value from being entered in more than field in
+3 ; the list
+4 ; Input: FPCE - Piece # of the field being checked
+5 ; VALUE - Internal Value of the user response
+6 ; NDE - HCSR Transmission file node that contains the fields
+7 ; PCES - '^' delimited list of storage locations for above fields
+8 ; Returns: 1 - No duplicates found, 0 otherwise
+9 NEW IX,PCE,RETURN
+10 ; Assume Valid Input
SET RETURN=1
+11 ; No value entered
if VALUE=""
QUIT 1
+12 ;
+13 ; Make sure there are no duplicates
+14 FOR IX=1:1:$LENGTH(PCES,"^")
Begin DoDot:1
+15 SET PCE=$PIECE(PCES,"^",IX)
+16 if PCE=FPCE
QUIT
+17 IF $PIECE(NDE,"^",PCE)=VALUE
SET RETURN=0
QUIT
End DoDot:1
if RETURN=0
QUIT
+18 QUIT RETURN
+19 ;
