IBTRH5B ;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 --------------------------------
; OXYTTYPE - Dictionary Screen function for Oxygen Equipment Type Fields
; (8.01,8.02,8.03)
; OXYTTYPP - Called from within the Input Template to check if subsequent
; Equipment Types have values (8.01,8.02)
; OXYTFIND - Dictionary Screen function for Oxygen Test Finding Fields
; 9.04,9.05,9.06)
; OXYTFNDP - Called from within the Input Template to check if subsequent
; Test Findings have values (9.04,9.05)
; OUDREASP - Called from within the Input Template to check if subsequent
; Other UMO Denial Reasons have values
; ONESL - Used to create a new Professional, Institutional or Dental
; Service Line
; ORALCAV - Dictionary Screen function for Oral Cavity Fields
; 2216,3.01,2216,3.02,2216,3.03,2216,3.04,2216,3.05)
; ORALCAVP - Called from within the Input Template to check if subsequent
; Oral Cavity fields have values
; PITSL - Called from the Input Template.
; Asks the user the type of Service Line being created:
; Professional, Institutional or Dental. Files the Service
; Line Type, Service Request Category and Service Certification
; Type fields
; PROC - Dictionary Screen function for Procedure fields in 356.22
; (10.07, 16,1.02, 16,1.03)
; PROCTYPE - Dictionary Screen function for Proc Type (356.2216, 1.01)
; PROCMOD - Dictionary Screen function for Procedure Modifier Fields
; (2216,1.04,2216,1.05,2216,1.06,2216,1.07)
; PROCMODP - Called from within the Input Template to check if subsequent
; Service Line Procedure Modifiers have values
; SLDXP - Called from within the Input Template to check if subsequent
; Service Line Procedure Diagnoses have values
; TOOTHS - Dictionary Screen function for Dental Service Lines Tooth Fields
; (22164/.02, 22614/.03, 22614/.04, 22614/.05, 22614/.06)
;-----------------------------------------------------------------------------
;
OXYTTYPE(FIELD) ;EP
; Dictionary Screen function called from Home Oxygen Therapy Information fields:
; 8.01,8.02,8.03. Prevents the same Oxygen Equipment Type from being selected
; more than once.
; 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 NDE=$G(^IBT(356.22,DA,8))
S RETURN=1 ; Assume Valid Input
Q:Y="" 1 ; No value entered
;
; Make sure there are no duplicates
I FIELD=8.01 D Q RETURN
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
I FIELD=8.02 D Q RETURN
. I $P(NDE,"^",1)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
I FIELD=8.03 D Q RETURN
. I $P(NDE,"^",1)=Y S RETURN=0 Q
. I $P(NDE,"^",2)=Y S RETURN=0 Q
Q RETURN
;
OXYTTYPP(IBTRIEN,FIELD) ;EP
; Called from Input Template IB CREATE 278 REQUEST for Oxygen Equipment Type
; fields. Checks to see if subsequent Oxygen Entry Equipment Type entries have
; values.
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field being checked
; Returns: 1 - Subsequent entries have values, 0 otherwise
N NDE
S NDE=$G(^IBT(356.22,IBTRIEN,8))
I FIELD=8.01,(($P(NDE,"^",2)'="")!($P(NDE,"^",3)'="")) Q 1
I FIELD=8.02,($P(NDE,"^",3)'="") Q 1
Q 0
;
OXYTFIND(FIELD) ;EP
; Dictionary Screen function called from Home Oxygen Therapy Information fields:
; 9.04,9.05,9.06. Prevents the same Oxygen Equipment Test finding from being
; selected more than once.
; 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 NDE=$G(^IBT(356.22,DA,9))
S RETURN=1 ; Assume Valid Input
Q:Y="" 1 ; No value entered
;
; Make sure there are no duplicates
I FIELD=9.04 D Q RETURN
. I $P(NDE,"^",5)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
I FIELD=9.05 D Q RETURN
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
I FIELD=9.06 D Q RETURN
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
Q RETURN
;
OXYTFNDP(IBTRIEN,FIELD) ;EP
; Called from Input Template IB CREATE 278 REQUEST for Oxygen Test Finding
; fields. Checks to see if subsequent Oxygen Test Findings entries have
; values.
; Input: IBTRIEN - IEN of the 356.22 entry being edited
; FIELD - Field number of the field being checked
; Returns: 1 - Subsequent entries have values, 0 otherwise
N NDE
S NDE=$G(^IBT(356.22,IBTRIEN,9))
I FIELD=9.04,(($P(NDE,"^",5)'="")!($P(NDE,"^",6)'="")) Q 1
I FIELD=9.05,($P(NDE,"^",6)'="") Q 1
Q 0
;
OUDREASP(FIELD) ;EP
; Called from Input Template IB CREATE 278 REQUEST for Other UMO Denial Reasons
; fields. Checks to see if subsequent Denial Reasons have values.
; Input: FIELD - Field number of the field being checked
; DA - IEN of the 356.2215 multiple entry being edited
; DA(1) - IEN of the Patient Event Entry
; Returns: 1 - Subsequent entries have values, 0 otherwise
N NDE,RETURN
S NDE=$G(^IBT(356.22,DA(1),15,DA,0)) ; Other UMO Info node
I FIELD=.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=.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=.05,($P(NDE,"^",6)'="") Q 1
Q 0
;
ONESL(IBTRIEN,REQCAT,CERTCD,SLTYPE,IBSLCTR) ;EP
; Called from Input Template: IB CREATE 278 REQUEST
; Auto Files a new Profession, Institutional or Dental Service Line multiple
; into 356.22. Only auto files the .02, .03 and 1.12 field. Other specified
; fields are asked within the Input Template according to the Service Line
; Type.
; Input: IBTRIEN - IEN of the selected entry
; REQCAT - IEN of the Request Category to file in .01
; CERTCD - IEN of the Certification Code to file in .02
; SLTYPE - 'P' - Professional Service Line
; 'I' - Institutional Service Line
; 'D' - Dental Service Line
; IBSLCTR - Current number of Service Line multiples
; Output: Service Line multiple is filed into 356.2216
; IBSLCTR - Updated number of Service Line multiples
; Returns: 1 if a Provider Data multiple was filed, 0 otherwise
N FDA
S IBSLCTR=IBSLCTR+1
;
; File Service Line Multiple
S FDA(356.2216,"+1,"_IBTRIEN_",",.01)=REQCAT ; Request Category
S FDA(356.2216,"+1,"_IBTRIEN_",",.02)=CERTCD ; Certification Code
S FDA(356.2216,"+1,"_IBTRIEN_",",1.12)=SLTYPE ; Service Line Type
D UPDATE^DIE("","FDA")
Q 1
;
PITSL(IBREQCAT) ;EP
; Called from Input Template: IB CREATE 278 REQUEST
; Called when creating a new Service Line to determine the type of Service
; Line to be created
; Input: IBREQCAT - IEN of the Patient Event Request Category
; DA(1) - IEN of the selected entry
; DA - IEN of the Service Line Multiple
; Output: IBEXIT - 1 if user entered ^, timed out or answered E
; 0 otherwise.
; if 1 NO service line multiple is filed
; Service Line multiple is filed into 356.2216
; Returns: Label to jump to based upon the type of line selected
; Returns '0' to exit multiple if not entered
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,ERROR,FDA,SLTYPE,X,XX,Y
;
; Get the Service Line Type of the first line. If present, all other Service
; Lines for this entry must be of the same type. If not present AND the
; Request Category is 'AR' it's an Institutional line. If not present and
; the Request Category is not 'AR', then ask for service line type as we
; are creating the first service line
S SLTYPE=$$GET1^DIQ(356.2216,DA_","_DA(1)_",",1.12,"I")
Q:SLTYPE'="" $S(SLTYPE="P":"@1500",SLTYPE="I":"@1600",1:"@1700")
S DIR(0)="SA^I:Institutional;P:Professional;D:Dental;E:Exit"
S XX="Enter the type of Service line you wish to create. Select E if you don't"
S XX=XX_" want to create a new service line."
S DIR("?")=XX
S DIR("A")="Service Line Type: "
PITSL1 ; Looping Tag
D ^DIR
I $D(DTOUT)!$D(DUOUT)!(Y="E") S IBEXIT=1 Q 0
S SLTYPE=Y
;
; File Service Line Type
S FDA(356.2216,DA_","_DA(1)_",",1.12)=SLTYPE ; Service Line Type
D FILE^DIE("","FDA","ERROR")
Q $S(SLTYPE="P":"@1500",SLTYPE="I":"@1600",1:"@1700")
;
PROC(FIELD) ;EP
; Dictionary Screen function called from the following fields in file 356.22:
; 10.07, 16,1.02, 16,1.03
; Prevents dictionary lookup into the wrong dictionary of the variable pointer
; field.
; Input: FIELD - Field # of the field being screened
; DA - IEN of the 356.22 entry if FIELD=10.07. Otherwise, IEN of
; the service line multiple
; DA(1) - IEN of the 356.22 entry being edited if FIELD'=10.07
; 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
; NOTE: Dental search disabled for now
N DENTAL,PXTYPE
Q:Y="" 1
S DENTAL=""
I FIELD=10.07 S PXTYPE=$$GET1^DIQ(356.22,DA_",",10.06,"I")
E D
. S PXTYPE=$$GET1^DIQ(356.2216,DA_","_DA(1)_",",1.01,"I")
. S DENTAL=$S($$GET1^DIQ(356.2216,DA_","_DA(1)_",",1.12,"I")="D":1,1:0)
Q:PXTYPE="" 1
;
; Dental Procedure Code must be from file 81 and have right CPT CATEGORY
I DENTAL,($P(DIC,"^",2)'="ICPT(")!($P($$CPT^ICPTCOD(Y),"^",4)'=185) Q 0 ;DBIA1995
;
; Procedure Code must be from file 81 for a Type of 'HC'
I PXTYPE="HC",$P(DIC,"^",2)'="ICPT(" Q 0
;
; Procedure Code must be from file 80.1 for a Type of 'ID' or 'ZZ'
; for fields 10.07, 1.02 and 1.03.
; NOTE: 'ZZ' not valid for 10.07
I ((PXTYPE="ID")!(PXTYPE="ZZ")),$P(DIC,"^",2)'="ICD0(" Q 0
Q 1
;
PROCTYPE() ;EP
; Dictionary Screen function called from field in file 356.2216, 1.01
; Prevents selection of 'ID' or 'ZZ' if entry is not for an inpatient
; Input: DA - IEN of the 356.22 entry if FIELD=10.07. Otherwise, IEN of
; the service line multiple
; DA(1) - IEN of the 356.22 entry being edited if FIELD'=10.07
; Y - Internal Value of the user response
; Returns: 1 - Data input by the user is valid, 0 otherwise
N DENTAL,IBPSTAT,SLTYPE
Q:Y="" 1
S DENTAL=$S($P($G(^IBT(356.22,DA(1),16,DA,1)),"^",12)="D":1,1:0)
S SLTYPE=$$GET1^DIQ(356.2216,DA_","_DA(1)_",",1.12,"I")
I DENTAL,Y'="AD" Q 0
I 'DENTAL,Y="AD" Q 0
S IBPSTAT=$P($G(^IBT(356.22,DA(1),0)),"^",4)
I SLTYPE'="I",((Y="ID")!(Y="ZZ")) Q 0
I SLTYPE="I",IBPSTAT="O",((Y="ID")!(Y="ZZ")) Q 0
Q 1
;
PROCMOD(FIELD) ;EP
; Dictionary Screen function called from Service Line Procedure Modifier Fields:
; 32216,1.04, 32216,1.05, 32216,1.06, 32216,1.07.
; Prevents the same Procedure Modifier from being selected more than once.
; Input: FIELD - Field # of the field being checked
; DA - IEN of the Service Line Multiple being edited
; DA(1) - 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 NDE=$G(^IBT(356.22,DA(1),16,DA,1))
S RETURN=1 ; Assume Valid Input
Q:Y="" 1 ; No value entered
;
; Make sure there are no duplicates
I FIELD=1.04 D Q RETURN
. I $P(NDE,"^",5)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
. I $P(NDE,"^",7)=Y S RETURN=0 Q
I FIELD=1.05 D Q RETURN
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
. I $P(NDE,"^",7)=Y S RETURN=0 Q
I FIELD=1.06 D Q RETURN
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
. I $P(NDE,"^",7)=Y S RETURN=0 Q
I FIELD=1.07 D Q RETURN
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
Q RETURN
;
PROCMODP(FIELD) ;EP
; Called from Input Template IB CREATE 278 REQUEST for Service Line Procedure
; Modifier fields. Checks to see if subsequent Procedure Modifier entries have
; values.
; Input: FIELD - Field # of the field being checked
; DA - IEN of the Service Line Multiple being edited
; DA(1) - 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(1),16,DA,1))
I FIELD=1.04 D Q RETURN
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. I $P(NDE,"^",6)'="" S RETURN=1 Q
. I $P(NDE,"^",7)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=1.05 D Q RETURN
. I $P(NDE,"^",6)'="" S RETURN=1 Q
. I $P(NDE,"^",7)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=1.06,$P(NDE,"^",7)'="" Q 1
Q 0
;
SLDXP(FIELD) ;EP
; Called from Input Template IB CREATE 278 REQUEST for Service Line Procedure
; Diagnosis fields. Checks to see if subsequent Procedure Diagnosis entries
; have values.
; Input: FIELD - Field # of the field being checked
; DA - IEN of the Service Line Multiple being edited
; DA(1) - 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(1),16,DA,2))
I FIELD=2.01 D Q RETURN
. I $P(NDE,"^",2)'="" S RETURN=1 Q
. I $P(NDE,"^",3)'="" S RETURN=1 Q
. I $P(NDE,"^",4)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=2.02 D Q RETURN
. I $P(NDE,"^",3)'="" S RETURN=1 Q
. I $P(NDE,"^",4)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=2.03,$P(NDE,"^",4)'="" Q 1
Q 0
;
ORALCAV(FIELD) ;EP
; Dictionary Screen function called from Service Line Oral Cavity Fields:
; 32216,3.01, 32216,3.02, 32216,3.03, 32216,3.04, 32216,3.05.
; Prevents the same Oral Cavity from being selected more than once.
; Input: FIELD - Field # of the field being checked
; DA - IEN of the Service Line Multiple being edited
; DA(1) - 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 NDE=$G(^IBT(356.22,DA(1),16,DA,3))
S RETURN=1 ; Assume Valid Input
Q:Y="" 1 ; No value entered
;
; Make sure there are no duplicates
I FIELD=3.01 D Q RETURN
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
I FIELD=3.02 D Q RETURN
. I $P(NDE,"^",1)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
I FIELD=3.03 D Q RETURN
. I $P(NDE,"^",1)=Y S RETURN=0 Q
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
I FIELD=3.04 D Q RETURN
. I $P(NDE,"^",1)=Y S RETURN=0 Q
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
I FIELD=3.05 D Q RETURN
. I $P(NDE,"^",1)=Y S RETURN=0 Q
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
. I $P(NDE,"^",4)=Y S RETURN=0 Q
Q RETURN
;
ORALCAVP(FIELD) ;EP
; Called from Input Template IB CREATE 278 REQUEST for Service Line Oral Cavity
; fields. Checks to see if subsequent Oral Cavity entries have values.
; Input: DA - IEN of the Service Line Multiple being edited
; DA(1) - 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(1),16,DA,3))
I FIELD=3.01 D Q RETURN
. I $P(NDE,"^",2)'="" S RETURN=1 Q
. I $P(NDE,"^",3)'="" S RETURN=1 Q
. I $P(NDE,"^",4)'="" S RETURN=1 Q
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=3.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
. S RETURN=0
I FIELD=3.03 D Q RETURN
. I $P(NDE,"^",4)'="" S RETURN=1 Q
. I $P(NDE,"^",5)'="" S RETURN=1 Q
. S RETURN=0
I FIELD=3.04,$P(NDE,"^",5)'="" Q 1
Q 0
;
TOOTHS(FIELD) ;EP
; Dictionary Screen function called from Dental Service Line Tooth fields:
; 22164,.02, 22614,.03, 22614,.04, 22614,.05, 22614,.06. Prevents the
; same Tooth Surface from being selected
; more than once.
; Input: FIELD - Field # of the field being checked
; DA - Tooth Surface multiple IEN
; DA(1) - Service Line multiple IEN
; DA(2) - 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 NDE=$G(^IBT(356.22,DA(2),16,DA(1),4,DA,0))
S RETURN=1 ; Assume Valid Input
Q:Y="" 1 ; No value entered
;
; Make sure there are no duplicates
I FIELD=.02 D Q RETURN
. I $P(NDE,"^",3)=Y S RETURN=0 Q
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
I FIELD=.03 D Q RETURN
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
I FIELD=.04 D Q RETURN
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
I FIELD=.05 D Q RETURN
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",6)=Y S RETURN=0 Q
I FIELD=.06 D Q RETURN
. I $P(NDE,"^",2)=Y S RETURN=0 Q
. I $P(NDE,"^",3)=Y S RETURN=0 Q
. I $P(NDE,"^",4)=Y S RETURN=0 Q
. I $P(NDE,"^",5)=Y S RETURN=0 Q
Q RETURN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH5B 18923 printed Dec 13, 2024@02:28:09 Page 2
IBTRH5B ;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 ; OXYTTYPE - Dictionary Screen function for Oxygen Equipment Type Fields
+9 ; (8.01,8.02,8.03)
+10 ; OXYTTYPP - Called from within the Input Template to check if subsequent
+11 ; Equipment Types have values (8.01,8.02)
+12 ; OXYTFIND - Dictionary Screen function for Oxygen Test Finding Fields
+13 ; 9.04,9.05,9.06)
+14 ; OXYTFNDP - Called from within the Input Template to check if subsequent
+15 ; Test Findings have values (9.04,9.05)
+16 ; OUDREASP - Called from within the Input Template to check if subsequent
+17 ; Other UMO Denial Reasons have values
+18 ; ONESL - Used to create a new Professional, Institutional or Dental
+19 ; Service Line
+20 ; ORALCAV - Dictionary Screen function for Oral Cavity Fields
+21 ; 2216,3.01,2216,3.02,2216,3.03,2216,3.04,2216,3.05)
+22 ; ORALCAVP - Called from within the Input Template to check if subsequent
+23 ; Oral Cavity fields have values
+24 ; PITSL - Called from the Input Template.
+25 ; Asks the user the type of Service Line being created:
+26 ; Professional, Institutional or Dental. Files the Service
+27 ; Line Type, Service Request Category and Service Certification
+28 ; Type fields
+29 ; PROC - Dictionary Screen function for Procedure fields in 356.22
+30 ; (10.07, 16,1.02, 16,1.03)
+31 ; PROCTYPE - Dictionary Screen function for Proc Type (356.2216, 1.01)
+32 ; PROCMOD - Dictionary Screen function for Procedure Modifier Fields
+33 ; (2216,1.04,2216,1.05,2216,1.06,2216,1.07)
+34 ; PROCMODP - Called from within the Input Template to check if subsequent
+35 ; Service Line Procedure Modifiers have values
+36 ; SLDXP - Called from within the Input Template to check if subsequent
+37 ; Service Line Procedure Diagnoses have values
+38 ; TOOTHS - Dictionary Screen function for Dental Service Lines Tooth Fields
+39 ; (22164/.02, 22614/.03, 22614/.04, 22614/.05, 22614/.06)
+40 ;-----------------------------------------------------------------------------
+41 ;
OXYTTYPE(FIELD) ;EP
+1 ; Dictionary Screen function called from Home Oxygen Therapy Information fields:
+2 ; 8.01,8.02,8.03. Prevents the same Oxygen Equipment Type from being selected
+3 ; more than once.
+4 ; Input: FIELD - Field # of the field being checked
+5 ; DA - IEN of the 356.22 entry being edited
+6 ; Y - Internal Value of the user response
+7 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+8 NEW NDE,RETURN
+9 SET NDE=$GET(^IBT(356.22,DA,8))
+10 ; Assume Valid Input
SET RETURN=1
+11 ; No value entered
if Y=""
QUIT 1
+12 ;
+13 ; Make sure there are no duplicates
+14 IF FIELD=8.01
Begin DoDot:1
+15 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+16 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+17 IF FIELD=8.02
Begin DoDot:1
+18 IF $PIECE(NDE,"^",1)=Y
SET RETURN=0
QUIT
+19 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+20 IF FIELD=8.03
Begin DoDot:1
+21 IF $PIECE(NDE,"^",1)=Y
SET RETURN=0
QUIT
+22 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+23 QUIT RETURN
+24 ;
OXYTTYPP(IBTRIEN,FIELD) ;EP
+1 ; Called from Input Template IB CREATE 278 REQUEST for Oxygen Equipment Type
+2 ; fields. Checks to see if subsequent Oxygen Entry Equipment Type entries have
+3 ; values.
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; FIELD - Field number of the field being checked
+6 ; Returns: 1 - Subsequent entries have values, 0 otherwise
+7 NEW NDE
+8 SET NDE=$GET(^IBT(356.22,IBTRIEN,8))
+9 IF FIELD=8.01
IF (($PIECE(NDE,"^",2)'="")!($PIECE(NDE,"^",3)'=""))
QUIT 1
+10 IF FIELD=8.02
IF ($PIECE(NDE,"^",3)'="")
QUIT 1
+11 QUIT 0
+12 ;
OXYTFIND(FIELD) ;EP
+1 ; Dictionary Screen function called from Home Oxygen Therapy Information fields:
+2 ; 9.04,9.05,9.06. Prevents the same Oxygen Equipment Test finding from being
+3 ; selected more than once.
+4 ; Input: FIELD - Field # of the field being checked
+5 ; DA - IEN of the 356.22 entry being edited
+6 ; Y - Internal Value of the user response
+7 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+8 NEW NDE,RETURN
+9 SET NDE=$GET(^IBT(356.22,DA,9))
+10 ; Assume Valid Input
SET RETURN=1
+11 ; No value entered
if Y=""
QUIT 1
+12 ;
+13 ; Make sure there are no duplicates
+14 IF FIELD=9.04
Begin DoDot:1
+15 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
+16 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+17 IF FIELD=9.05
Begin DoDot:1
+18 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+19 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+20 IF FIELD=9.06
Begin DoDot:1
+21 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+22 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+23 QUIT RETURN
+24 ;
OXYTFNDP(IBTRIEN,FIELD) ;EP
+1 ; Called from Input Template IB CREATE 278 REQUEST for Oxygen Test Finding
+2 ; fields. Checks to see if subsequent Oxygen Test Findings entries have
+3 ; values.
+4 ; Input: IBTRIEN - IEN of the 356.22 entry being edited
+5 ; FIELD - Field number of the field being checked
+6 ; Returns: 1 - Subsequent entries have values, 0 otherwise
+7 NEW NDE
+8 SET NDE=$GET(^IBT(356.22,IBTRIEN,9))
+9 IF FIELD=9.04
IF (($PIECE(NDE,"^",5)'="")!($PIECE(NDE,"^",6)'=""))
QUIT 1
+10 IF FIELD=9.05
IF ($PIECE(NDE,"^",6)'="")
QUIT 1
+11 QUIT 0
+12 ;
OUDREASP(FIELD) ;EP
+1 ; Called from Input Template IB CREATE 278 REQUEST for Other UMO Denial Reasons
+2 ; fields. Checks to see if subsequent Denial Reasons have values.
+3 ; Input: FIELD - Field number of the field being checked
+4 ; DA - IEN of the 356.2215 multiple entry being edited
+5 ; DA(1) - IEN of the Patient Event Entry
+6 ; Returns: 1 - Subsequent entries have values, 0 otherwise
+7 NEW NDE,RETURN
+8 ; Other UMO Info node
SET NDE=$GET(^IBT(356.22,DA(1),15,DA,0))
+9 IF FIELD=.03
Begin DoDot:1
+10 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+11 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+12 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+13 SET RETURN=0
End DoDot:1
QUIT RETURN
+14 IF FIELD=.04
Begin DoDot:1
+15 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+16 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+17 SET RETURN=0
End DoDot:1
QUIT RETURN
+18 IF FIELD=.05
IF ($PIECE(NDE,"^",6)'="")
QUIT 1
+19 QUIT 0
+20 ;
ONESL(IBTRIEN,REQCAT,CERTCD,SLTYPE,IBSLCTR) ;EP
+1 ; Called from Input Template: IB CREATE 278 REQUEST
+2 ; Auto Files a new Profession, Institutional or Dental Service Line multiple
+3 ; into 356.22. Only auto files the .02, .03 and 1.12 field. Other specified
+4 ; fields are asked within the Input Template according to the Service Line
+5 ; Type.
+6 ; Input: IBTRIEN - IEN of the selected entry
+7 ; REQCAT - IEN of the Request Category to file in .01
+8 ; CERTCD - IEN of the Certification Code to file in .02
+9 ; SLTYPE - 'P' - Professional Service Line
+10 ; 'I' - Institutional Service Line
+11 ; 'D' - Dental Service Line
+12 ; IBSLCTR - Current number of Service Line multiples
+13 ; Output: Service Line multiple is filed into 356.2216
+14 ; IBSLCTR - Updated number of Service Line multiples
+15 ; Returns: 1 if a Provider Data multiple was filed, 0 otherwise
+16 NEW FDA
+17 SET IBSLCTR=IBSLCTR+1
+18 ;
+19 ; File Service Line Multiple
+20 ; Request Category
SET FDA(356.2216,"+1,"_IBTRIEN_",",.01)=REQCAT
+21 ; Certification Code
SET FDA(356.2216,"+1,"_IBTRIEN_",",.02)=CERTCD
+22 ; Service Line Type
SET FDA(356.2216,"+1,"_IBTRIEN_",",1.12)=SLTYPE
+23 DO UPDATE^DIE("","FDA")
+24 QUIT 1
+25 ;
PITSL(IBREQCAT) ;EP
+1 ; Called from Input Template: IB CREATE 278 REQUEST
+2 ; Called when creating a new Service Line to determine the type of Service
+3 ; Line to be created
+4 ; Input: IBREQCAT - IEN of the Patient Event Request Category
+5 ; DA(1) - IEN of the selected entry
+6 ; DA - IEN of the Service Line Multiple
+7 ; Output: IBEXIT - 1 if user entered ^, timed out or answered E
+8 ; 0 otherwise.
+9 ; if 1 NO service line multiple is filed
+10 ; Service Line multiple is filed into 356.2216
+11 ; Returns: Label to jump to based upon the type of line selected
+12 ; Returns '0' to exit multiple if not entered
+13 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,ERROR,FDA,SLTYPE,X,XX,Y
+14 ;
+15 ; Get the Service Line Type of the first line. If present, all other Service
+16 ; Lines for this entry must be of the same type. If not present AND the
+17 ; Request Category is 'AR' it's an Institutional line. If not present and
+18 ; the Request Category is not 'AR', then ask for service line type as we
+19 ; are creating the first service line
+20 SET SLTYPE=$$GET1^DIQ(356.2216,DA_","_DA(1)_",",1.12,"I")
+21 if SLTYPE'=""
QUIT $SELECT(SLTYPE="P":"@1500",SLTYPE="I":"@1600",1:"@1700")
+22 SET DIR(0)="SA^I:Institutional;P:Professional;D:Dental;E:Exit"
+23 SET XX="Enter the type of Service line you wish to create. Select E if you don't"
+24 SET XX=XX_" want to create a new service line."
+25 SET DIR("?")=XX
+26 SET DIR("A")="Service Line Type: "
PITSL1 ; Looping Tag
+1 DO ^DIR
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="E")
SET IBEXIT=1
QUIT 0
+3 SET SLTYPE=Y
+4 ;
+5 ; File Service Line Type
+6 ; Service Line Type
SET FDA(356.2216,DA_","_DA(1)_",",1.12)=SLTYPE
+7 DO FILE^DIE("","FDA","ERROR")
+8 QUIT $SELECT(SLTYPE="P":"@1500",SLTYPE="I":"@1600",1:"@1700")
+9 ;
PROC(FIELD) ;EP
+1 ; Dictionary Screen function called from the following fields in file 356.22:
+2 ; 10.07, 16,1.02, 16,1.03
+3 ; Prevents dictionary lookup into the wrong dictionary of the variable pointer
+4 ; field.
+5 ; Input: FIELD - Field # of the field being screened
+6 ; DA - IEN of the 356.22 entry if FIELD=10.07. Otherwise, IEN of
+7 ; the service line multiple
+8 ; DA(1) - IEN of the 356.22 entry being edited if FIELD'=10.07
+9 ; DIC - Contains the global ref of dictionary being checked
+10 ; Y - Internal Value of the user response
+11 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+12 ; NOTE: Dental search disabled for now
+13 NEW DENTAL,PXTYPE
+14 if Y=""
QUIT 1
+15 SET DENTAL=""
+16 IF FIELD=10.07
SET PXTYPE=$$GET1^DIQ(356.22,DA_",",10.06,"I")
+17 IF '$TEST
Begin DoDot:1
+18 SET PXTYPE=$$GET1^DIQ(356.2216,DA_","_DA(1)_",",1.01,"I")
+19 SET DENTAL=$SELECT($$GET1^DIQ(356.2216,DA_","_DA(1)_",",1.12,"I")="D":1,1:0)
End DoDot:1
+20 if PXTYPE=""
QUIT 1
+21 ;
+22 ; Dental Procedure Code must be from file 81 and have right CPT CATEGORY
+23 ;DBIA1995
IF DENTAL
IF ($PIECE(DIC,"^",2)'="ICPT(")!($PIECE($$CPT^ICPTCOD(Y),"^",4)'=185)
QUIT 0
+24 ;
+25 ; Procedure Code must be from file 81 for a Type of 'HC'
+26 IF PXTYPE="HC"
IF $PIECE(DIC,"^",2)'="ICPT("
QUIT 0
+27 ;
+28 ; Procedure Code must be from file 80.1 for a Type of 'ID' or 'ZZ'
+29 ; for fields 10.07, 1.02 and 1.03.
+30 ; NOTE: 'ZZ' not valid for 10.07
+31 IF ((PXTYPE="ID")!(PXTYPE="ZZ"))
IF $PIECE(DIC,"^",2)'="ICD0("
QUIT 0
+32 QUIT 1
+33 ;
PROCTYPE() ;EP
+1 ; Dictionary Screen function called from field in file 356.2216, 1.01
+2 ; Prevents selection of 'ID' or 'ZZ' if entry is not for an inpatient
+3 ; Input: DA - IEN of the 356.22 entry if FIELD=10.07. Otherwise, IEN of
+4 ; the service line multiple
+5 ; DA(1) - IEN of the 356.22 entry being edited if FIELD'=10.07
+6 ; Y - Internal Value of the user response
+7 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+8 NEW DENTAL,IBPSTAT,SLTYPE
+9 if Y=""
QUIT 1
+10 SET DENTAL=$SELECT($PIECE($GET(^IBT(356.22,DA(1),16,DA,1)),"^",12)="D":1,1:0)
+11 SET SLTYPE=$$GET1^DIQ(356.2216,DA_","_DA(1)_",",1.12,"I")
+12 IF DENTAL
IF Y'="AD"
QUIT 0
+13 IF 'DENTAL
IF Y="AD"
QUIT 0
+14 SET IBPSTAT=$PIECE($GET(^IBT(356.22,DA(1),0)),"^",4)
+15 IF SLTYPE'="I"
IF ((Y="ID")!(Y="ZZ"))
QUIT 0
+16 IF SLTYPE="I"
IF IBPSTAT="O"
IF ((Y="ID")!(Y="ZZ"))
QUIT 0
+17 QUIT 1
+18 ;
PROCMOD(FIELD) ;EP
+1 ; Dictionary Screen function called from Service Line Procedure Modifier Fields:
+2 ; 32216,1.04, 32216,1.05, 32216,1.06, 32216,1.07.
+3 ; Prevents the same Procedure Modifier from being selected more than once.
+4 ; Input: FIELD - Field # of the field being checked
+5 ; DA - IEN of the Service Line Multiple being edited
+6 ; DA(1) - IEN of the 356.22 entry being edited
+7 ; Y - Internal Value of the user response
+8 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+9 NEW NDE,RETURN
+10 SET NDE=$GET(^IBT(356.22,DA(1),16,DA,1))
+11 ; Assume Valid Input
SET RETURN=1
+12 ; No value entered
if Y=""
QUIT 1
+13 ;
+14 ; Make sure there are no duplicates
+15 IF FIELD=1.04
Begin DoDot:1
+16 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
+17 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
+18 IF $PIECE(NDE,"^",7)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+19 IF FIELD=1.05
Begin DoDot:1
+20 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+21 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
+22 IF $PIECE(NDE,"^",7)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+23 IF FIELD=1.06
Begin DoDot:1
+24 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+25 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
+26 IF $PIECE(NDE,"^",7)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+27 IF FIELD=1.07
Begin DoDot:1
+28 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+29 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
+30 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+31 QUIT RETURN
+32 ;
PROCMODP(FIELD) ;EP
+1 ; Called from Input Template IB CREATE 278 REQUEST for Service Line Procedure
+2 ; Modifier fields. Checks to see if subsequent Procedure Modifier entries have
+3 ; values.
+4 ; Input: FIELD - Field # of the field being checked
+5 ; DA - IEN of the Service Line Multiple being edited
+6 ; DA(1) - IEN of the 356.22 entry being edited
+7 ; Returns: 1 - Subsequent entries have values, 0 otherwise
+8 NEW NDE,RETURN
+9 SET NDE=$GET(^IBT(356.22,DA(1),16,DA,1))
+10 IF FIELD=1.04
Begin DoDot:1
+11 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+12 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+13 IF $PIECE(NDE,"^",7)'=""
SET RETURN=1
QUIT
+14 SET RETURN=0
End DoDot:1
QUIT RETURN
+15 IF FIELD=1.05
Begin DoDot:1
+16 IF $PIECE(NDE,"^",6)'=""
SET RETURN=1
QUIT
+17 IF $PIECE(NDE,"^",7)'=""
SET RETURN=1
QUIT
+18 SET RETURN=0
End DoDot:1
QUIT RETURN
+19 IF FIELD=1.06
IF $PIECE(NDE,"^",7)'=""
QUIT 1
+20 QUIT 0
+21 ;
SLDXP(FIELD) ;EP
+1 ; Called from Input Template IB CREATE 278 REQUEST for Service Line Procedure
+2 ; Diagnosis fields. Checks to see if subsequent Procedure Diagnosis entries
+3 ; have values.
+4 ; Input: FIELD - Field # of the field being checked
+5 ; DA - IEN of the Service Line Multiple being edited
+6 ; DA(1) - IEN of the 356.22 entry being edited
+7 ; Returns: 1 - Subsequent entries have values, 0 otherwise
+8 NEW NDE,RETURN
+9 SET NDE=$GET(^IBT(356.22,DA(1),16,DA,2))
+10 IF FIELD=2.01
Begin DoDot:1
+11 IF $PIECE(NDE,"^",2)'=""
SET RETURN=1
QUIT
+12 IF $PIECE(NDE,"^",3)'=""
SET RETURN=1
QUIT
+13 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+14 SET RETURN=0
End DoDot:1
QUIT RETURN
+15 IF FIELD=2.02
Begin DoDot:1
+16 IF $PIECE(NDE,"^",3)'=""
SET RETURN=1
QUIT
+17 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+18 SET RETURN=0
End DoDot:1
QUIT RETURN
+19 IF FIELD=2.03
IF $PIECE(NDE,"^",4)'=""
QUIT 1
+20 QUIT 0
+21 ;
ORALCAV(FIELD) ;EP
+1 ; Dictionary Screen function called from Service Line Oral Cavity Fields:
+2 ; 32216,3.01, 32216,3.02, 32216,3.03, 32216,3.04, 32216,3.05.
+3 ; Prevents the same Oral Cavity from being selected more than once.
+4 ; Input: FIELD - Field # of the field being checked
+5 ; DA - IEN of the Service Line Multiple being edited
+6 ; DA(1) - IEN of the 356.22 entry being edited
+7 ; Y - Internal Value of the user response
+8 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+9 NEW NDE,RETURN
+10 SET NDE=$GET(^IBT(356.22,DA(1),16,DA,3))
+11 ; Assume Valid Input
SET RETURN=1
+12 ; No value entered
if Y=""
QUIT 1
+13 ;
+14 ; Make sure there are no duplicates
+15 IF FIELD=3.01
Begin DoDot:1
+16 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+17 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
+18 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+19 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+20 IF FIELD=3.02
Begin DoDot:1
+21 IF $PIECE(NDE,"^",1)=Y
SET RETURN=0
QUIT
+22 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
+23 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+24 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+25 IF FIELD=3.03
Begin DoDot:1
+26 IF $PIECE(NDE,"^",1)=Y
SET RETURN=0
QUIT
+27 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+28 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+29 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+30 IF FIELD=3.04
Begin DoDot:1
+31 IF $PIECE(NDE,"^",1)=Y
SET RETURN=0
QUIT
+32 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+33 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
+34 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+35 IF FIELD=3.05
Begin DoDot:1
+36 IF $PIECE(NDE,"^",1)=Y
SET RETURN=0
QUIT
+37 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+38 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
+39 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+40 QUIT RETURN
+41 ;
ORALCAVP(FIELD) ;EP
+1 ; Called from Input Template IB CREATE 278 REQUEST for Service Line Oral Cavity
+2 ; fields. Checks to see if subsequent Oral Cavity entries have values.
+3 ; Input: DA - IEN of the Service Line Multiple being edited
+4 ; DA(1) - IEN of the 356.22 entry being edited
+5 ; Returns: 1 - Subsequent entries have values, 0 otherwise
+6 NEW NDE,RETURN
+7 SET NDE=$GET(^IBT(356.22,DA(1),16,DA,3))
+8 IF FIELD=3.01
Begin DoDot:1
+9 IF $PIECE(NDE,"^",2)'=""
SET RETURN=1
QUIT
+10 IF $PIECE(NDE,"^",3)'=""
SET RETURN=1
QUIT
+11 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+12 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+13 SET RETURN=0
End DoDot:1
QUIT RETURN
+14 IF FIELD=3.02
Begin DoDot:1
+15 IF $PIECE(NDE,"^",3)'=""
SET RETURN=1
QUIT
+16 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+17 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+18 SET RETURN=0
End DoDot:1
QUIT RETURN
+19 IF FIELD=3.03
Begin DoDot:1
+20 IF $PIECE(NDE,"^",4)'=""
SET RETURN=1
QUIT
+21 IF $PIECE(NDE,"^",5)'=""
SET RETURN=1
QUIT
+22 SET RETURN=0
End DoDot:1
QUIT RETURN
+23 IF FIELD=3.04
IF $PIECE(NDE,"^",5)'=""
QUIT 1
+24 QUIT 0
+25 ;
TOOTHS(FIELD) ;EP
+1 ; Dictionary Screen function called from Dental Service Line Tooth fields:
+2 ; 22164,.02, 22614,.03, 22614,.04, 22614,.05, 22614,.06. Prevents the
+3 ; same Tooth Surface from being selected
+4 ; more than once.
+5 ; Input: FIELD - Field # of the field being checked
+6 ; DA - Tooth Surface multiple IEN
+7 ; DA(1) - Service Line multiple IEN
+8 ; DA(2) - IEN of the 356.22 entry being edited
+9 ; Y - Internal Value of the user response
+10 ; Returns: 1 - Data input by the user is valid, 0 otherwise
+11 NEW NDE,RETURN
+12 SET NDE=$GET(^IBT(356.22,DA(2),16,DA(1),4,DA,0))
+13 ; Assume Valid Input
SET RETURN=1
+14 ; No value entered
if Y=""
QUIT 1
+15 ;
+16 ; Make sure there are no duplicates
+17 IF FIELD=.02
Begin DoDot:1
+18 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
+19 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+20 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
+21 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+22 IF FIELD=.03
Begin DoDot:1
+23 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+24 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+25 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
+26 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+27 IF FIELD=.04
Begin DoDot:1
+28 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+29 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
+30 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
+31 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+32 IF FIELD=.05
Begin DoDot:1
+33 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+34 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
+35 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+36 IF $PIECE(NDE,"^",6)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+37 IF FIELD=.06
Begin DoDot:1
+38 IF $PIECE(NDE,"^",2)=Y
SET RETURN=0
QUIT
+39 IF $PIECE(NDE,"^",3)=Y
SET RETURN=0
QUIT
+40 IF $PIECE(NDE,"^",4)=Y
SET RETURN=0
QUIT
+41 IF $PIECE(NDE,"^",5)=Y
SET RETURN=0
QUIT
End DoDot:1
QUIT RETURN
+42 QUIT RETURN
+43 ;
