DGENEGT ;ALB/KCL/RGL - Enrollment Group Threshold API's ; 11/20/03 3:39pm
;;5.3;Registration;**232,451,1015**;Aug 13, 1993;Build 21
;
;
LOCK(IEN) ;
; Description: Used to lock the ENROLLMENT GROUP THRESHOLD record.
;
; Input:
; IEN - internal entry number of record in the ENROLLMENT GROUP TRHESHOLD file
;
; Output:
; Function Value: Returns 1 if the ENROLLMENT GROUP THRESHOLD record
; can be locked, otherwise returns 0 on failure
;
I $G(IEN) L +^DGEN(27.16,IEN,0):2
Q $T
;
;
UNLOCK(IEN) ;
; Description: Used to unlock the ENROLLMENT GROUP THRESHOLD record.
;
; Input:
; IEN - internal entry number of record in the ENROLLMENT GROUP TRHESHOLD file
;
; Output:
; None
;
I $G(IEN) L -^DGEN(27.16,IEN,0)
Q
;
;
FINDCUR(ENRDT) ;
; Description: Used to find a record in the ENROLLMENT GROUP THRESHOLD file.
;
; Input: Enrollment Date (optional - if not specified, today is assumed)
;
; Output:
; Function Value: If successful, returns internal entry number of
; record in the ENROLLMENT GROUP THRESHOLD file,
; otherwise returns 0 on failure
;
N DGEGTDT,STOP,DGEGTIEN,DGEGTF
S DGEGTDT=$G(ENRDT)+.000001,STOP=0,DGEGTIEN=""
S:'$G(ENRDT) DGEGTDT=$$DT^XLFDT+DGEGTDT
F S DGEGTDT=$O(^DGEN(27.16,"B",DGEGTDT),-1) Q:STOP!(DGEGTDT="") D
.F S DGEGTIEN=$O(^(DGEGTDT,DGEGTIEN),-1) Q:DGEGTIEN=""!STOP D
..S:'$P($G(^DGEN(27.16,+DGEGTIEN,0)),"^",8) STOP=DGEGTIEN
S DGEGTF=1
I $G(ENRDT),ENRDT'>DT,$$INACT(STOP) ;inactivate old EGT settings
Q +STOP
;
;
GET(EGTIEN,DGEGT) ;
; Description: Used to obtain a record in the ENROLLMENT GROUP THRESHOLD file. The values will be returned in the DGEGT() array.
;
; Input:
; EGTIEN - internal entry number of record in the ENROLLMENT GROUP THRESHOLD file
;
; Output:
; DGEGT - The ENROLLMENT GROUP THRESHOLD array, passed by reference
;
; Subscript Field
; --------- ---------------------
; "EFFDATE" EGT EFFECTIVE DATE
; "PRIORITY" EGT PRIORITY
; "SUBGRP" EGT SUBGROUP
; "TYPE" EGT TYPE
; "FEDDATE" FEDERAL REGISTER DATE
; "ENTDATE" DATE ENTERED
; "SOURCE" SOURCE OF EGT
; "REMARKS" REMARKS
;
N SUB,NODE
K DGEGT S DGEGT=""
;
I '$G(EGTIEN) D Q 0
.F SUB="EFFDATE","PRIORITY","SUBGRP","TYPE","FEDDATE","ENTDATE","SOURCE","REMARKS" S DGEGT(SUB)=""
;
S NODE=$G(^DGEN(27.16,EGTIEN,0))
S DGEGT("EFFDATE")=$P(NODE,"^")
S DGEGT("PRIORITY")=$P(NODE,"^",2)
S DGEGT("SUBGRP")=$P(NODE,"^",3)
S DGEGT("TYPE")=$P(NODE,"^",4)
S DGEGT("FEDDATE")=$P(NODE,"^",5)
S DGEGT("ENTDATE")=$P(NODE,"^",6)
S DGEGT("SOURCE")=$P(NODE,"^",7)
S NODE=$G(^DGEN(27.16,EGTIEN,"R"))
S DGEGT("REMARKS")=$P(NODE,"^")
;
Q 1
;
;
STORE(DGEGT,ERROR,CHKFLG) ;
; Description: Creates a new entry in the ENROLLMENT GROUP THRESHOLD file.
;
; Input:
; DGEGT - the ENROLLMENT GROUP THRESHOLD array, passed by reference
; CHKFLG - a flag, if set to 1 means that field validation checks
; were completed, 0 indicates field validation checks should
; be performed (optional)
;
; Output:
; Function Value - Returns internal entry number of record created, or 0 on failure
; ERROR - if not successful, an error message is returned,
; pass by reference (optional)
;
;
S ERROR=""
I $G(CHKFLG)'=1 Q:'$$VALID(.DGEGT,.ERROR) 0
;
N ADD,DATA,OLDEGT,INACT
S OLDEGT=$$FINDCUR()
S DATA(.01)=DGEGT("EFFDATE")
S DATA(.02)=DGEGT("PRIORITY")
S DATA(.03)=DGEGT("SUBGRP")
S DATA(.04)=DGEGT("TYPE")
S DATA(.05)=DGEGT("FEDDATE")
S DATA(.06)=DGEGT("ENTDATE")
S DATA(.07)=DGEGT("SOURCE")
S DATA(25)=DGEGT("REMARKS")
S ADD=$$ADD^DGENDBS(27.16,,.DATA,.ERROR)
;
; inactivate "old" EGT settings
S INACT=$$INACT(ADD,.OLDEGT,.DGEGT)
;
Q +ADD
;
;
UPDATE(EGTIEN,DGEGT,ERROR) ;
; Description: Updates an Enrollment Group Threshold record in the
; ENROLLMENT GROUP THRESHOLD file. This function locks the Enrollment
; Group Threshold record and releases the lock when the update is
; complete.
;
; Input:
; EGTIEN - internal entry number of record in the ENROLLMENT GROUP THRESHOLD file
; DGEGT - the ENROLLMENT GROUP THRESHOLD array, passed by reference
;
; Output:
; Function Value - Returns 1 if successful, otherwise 0
; ERROR - if not successful, an error message is returned,
; pass by reference
;
N SUCCESS,DATA
S SUCCESS=1
S ERROR=""
;
D ; drops out of do block if invalid condition is found
.I $G(EGTIEN),$D(^DGEN(27.16,EGTIEN,0))
.E S SUCCESS=0,ERROR="ENROLLMENT GROUP THRESHOLD RECORD NOT FOUND" Q
.I '$$LOCK(EGTIEN) S SUCCESS=0,ERROR="ENROLLMENT GROUP THRESHOLD RECORD IS LOCKED, CAN'T BE EDITED" Q
.;
.S DATA(.01)=DGEGT("EFFDATE")
.S DATA(.02)=DGEGT("PRIORITY")
.S DATA(.03)=DGEGT("SUBGRP")
.S DATA(.04)=DGEGT("TYPE")
.S DATA(.05)=DGEGT("FEDDATE")
.S DATA(.06)=DGEGT("ENTDATE")
.S DATA(.07)=DGEGT("SOURCE")
.S DATA(25)=DGEGT("REMARKS")
.;
.I '$$UPD^DGENDBS(27.16,EGTIEN,.DATA) S ERROR="FILEMAN UNABLE TO PERFORM UPDATE",SUCCESS=0 Q
;
D UNLOCK(EGTIEN)
;
Q SUCCESS
;
;
DELETE(EGTIEN) ; Description: This function will delete a record in the ENROLLMENT GROUP THRESHOLD file.
;
; Input:
; EGTIEN - as internal entry number of record to delete
;
; Outpu:
; Function Value - Returns 1 if successful, otherwise 0
;
Q:'$G(EGTIEN) 0
N DIK,DA
S DIK="^DGEN(27.16,"
S DA=EGTIEN
D ^DIK
Q 1
;
;
VALID(DGEGT,ERROR) ;
; Description: Performs validation checks on ENROLLMENT GROUP THRESHOLD record contained in the DGEGT array.
;
; Input:
; DGEGT - the ENROLLMENT GROUP THRESHOLD array, passed by reference
;
; Output:
; Function Value - Returns 1 if validation checks passed, 0 otherwise
; ERROR - if validation checks fail, an error message is
; returned, pass by reference
;
N VALID,EXTERNAL,RESULT
S VALID=1
S ERROR=""
;
D ; drops out of DO block if an invalid condition found
.;
.; check for required fields
.I $G(DGEGT("EFFDATE"))="" S VALID=0,ERROR="REQUIRED FIELD 'EGT EFFECTIVE DATE' MISSING" Q
.I $G(DGEGT("PRIORITY"))="" S VALID=0,ERROR="REQUIRED FIELD 'EGT PRIORITY' MISSING" Q
.I $G(DGEGT("TYPE"))="" S VALID=0,ERROR="REQUIRED FIELD 'EGT TYPE' MISSING" Q
.I $G(DGEGT("ENTDATE"))="" S VALID=0,ERROR="REQUIRED FIELD 'DATE ENTERED' MISSING" Q
.I $G(DGEGT("SOURCE"))="" S VALID=0,ERROR="REQUIRED FIELD 'SOURCE OF EGT' MISSING" Q
.;
.; check if field values are valid
.I '$$TESTVAL("EFFDATE",DGEGT("EFFDATE")) S VALID=0,ERROR="'EGT EFFECTIVE DATE' NOT VALID" Q
.I '$$TESTVAL("PRIORITY",DGEGT("PRIORITY")) S VALID=0,ERROR="'EGT PRIORITY' NOT VALID" Q
.I '$$TESTVAL("SUBGRP",DGEGT("SUBGRP")) S VALID=0,ERROR="'EGT SUBGRP' NOT VALID" Q
.I '$$TESTVAL("TYPE",DGEGT("TYPE")) S VALID=0,ERROR="'EGT TYPE' NOT VALID" Q
.I '$$TESTVAL("FEDDATE",DGEGT("FEDDATE")) S VALID=0,ERROR="'FEDERAL REGISTER DATE' NOT VALID" Q
.I '$$TESTVAL("ENTDATE",DGEGT("ENTDATE")) S VALID=0,ERROR="'DATE ENTERED' NOT VALID" Q
.I '$$TESTVAL("SOURCE",DGEGT("SOURCE")) S VALID=0,ERROR="'SOURCE OF EGT' NOT VALID" Q
.I ($G(DGEGT("REMARKS"))'="")&($L($G(DGEGT("REMARKS")))<3)!($L($G(DGEGT("REMARKS")))>80) S VALID=0,ERROR="'REMARKS' NOT VALID" Q
;
Q VALID
;
;
TESTVAL(SUB,VAL) ; Description: Used to determine if a field value is valid.
;
; Input:
; SUB - as the field subscript
; VAL - as the field value
;
; Output:
; Function value: Returns 1 if the field value (VAL) is valid for
; the subscript (SUB), returns 0 otherwise.
;
N DISPLAY,FIELD,RESULT,VALID
;
S VALID=1
;
I (VAL'="") D
.S FIELD=$$FIELD(SUB)
.; if there is no external value then not valid
.S DISPLAY=$$EXTERNAL^DILFD(27.16,FIELD,"F",VAL)
.I (DISPLAY="") S VALID=0 Q
.I $$GET1^DID(27.16,FIELD,"","TYPE")'="POINTER" D
..D CHK^DIE(27.16,FIELD,,VAL,.RESULT) I RESULT="^" S VALID=0 Q
;
Q VALID
;
;
FIELD(SUB) ; Description: Used to determine the field number for a given subscript in the EGT array.
;
; Input:
; SUB - as the field subscript
;
; Output:
; Function value: Returns the field number for the given subscript,
; otherwise null is returned.
;
;
N FLD
S FLD=""
;
D ; drops out of DO block once SUB is determined
.I SUB="EFFDATE" S FLD=.01 Q
.I SUB="PRIORITY" S FLD=.02 Q
.I SUB="SUBGRP" S FLD=.03 Q
.I SUB="TYPE" S FLD=.04 Q
.I SUB="FEDDATE" S FLD=.05 Q
.I SUB="ENTDATE" S FLD=.06 Q
.I SUB="SOURCE" S FLD=.07 Q
.I SUB="REMARKS" S FLD=25 Q
;
Q FLD
;
INACT(EGTIEN,OLDIEN,DGEGT) ;inactivate EGT settings that are currently not in effect
;
; input: EGTIEN -Current EGT ien from 27.16
; DGEGT (optional array) - Current EGT setting information
; DGEGTF (optional) - do not inactivate future EGT
;
Q:'$G(EGTIEN) 0
N EGTFDA,EGTDT,EGTREC,ERR
S:'$G(OLDIEN) OLDIEN=""
I '$D(DGEGT),'$$GET(EGTIEN,.DGEGT) Q 0
S:DGEGT("EFFDATE")>$$DT^XLFDT EGTF=1 ;future EGT setting
S EGTDT=""
F S EGTDT=$O(^DGEN(27.16,"B",EGTDT),-1) Q:'EGTDT D
.S EGTREC=""
.F S EGTREC=$O(^DGEN(27.16,"B",EGTDT,EGTREC),-1) Q:'EGTREC D
..Q:EGTREC=EGTIEN ;new EGT setting
..Q:$G(EGTF)&(EGTREC=OLDIEN)
..I $P($G(^DGEN(27.16,EGTREC,0)),"^")>DT D Q
...Q:$G(DGEGTF)
...Q:$$DELETE(EGTREC)
..S EGTFDA(27.16,EGTREC_",",.08)=1
D:$D(EGTFDA) UPDATE^DIE("","EGTFDA","","ERR")
Q 1
DGENEGT ;ALB/KCL/RGL - Enrollment Group Threshold API's ; 11/20/03 3:39pm
+1 ;;5.3;Registration;**232,451,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;
LOCK(IEN) ;
+1 ; Description: Used to lock the ENROLLMENT GROUP THRESHOLD record.
+2 ;
+3 ; Input:
+4 ; IEN - internal entry number of record in the ENROLLMENT GROUP TRHESHOLD file
+5 ;
+6 ; Output:
+7 ; Function Value: Returns 1 if the ENROLLMENT GROUP THRESHOLD record
+8 ; can be locked, otherwise returns 0 on failure
+9 ;
+10 IF $GET(IEN)
LOCK +^DGEN(27.16,IEN,0):2
+11 QUIT $TEST
+12 ;
+13 ;
UNLOCK(IEN) ;
+1 ; Description: Used to unlock the ENROLLMENT GROUP THRESHOLD record.
+2 ;
+3 ; Input:
+4 ; IEN - internal entry number of record in the ENROLLMENT GROUP TRHESHOLD file
+5 ;
+6 ; Output:
+7 ; None
+8 ;
+9 IF $GET(IEN)
LOCK -^DGEN(27.16,IEN,0)
+10 QUIT
+11 ;
+12 ;
FINDCUR(ENRDT) ;
+1 ; Description: Used to find a record in the ENROLLMENT GROUP THRESHOLD file.
+2 ;
+3 ; Input: Enrollment Date (optional - if not specified, today is assumed)
+4 ;
+5 ; Output:
+6 ; Function Value: If successful, returns internal entry number of
+7 ; record in the ENROLLMENT GROUP THRESHOLD file,
+8 ; otherwise returns 0 on failure
+9 ;
+10 NEW DGEGTDT,STOP,DGEGTIEN,DGEGTF
+11 SET DGEGTDT=$GET(ENRDT)+.000001
SET STOP=0
SET DGEGTIEN=""
+12 IF '$GET(ENRDT)
SET DGEGTDT=$$DT^XLFDT+DGEGTDT
+13 FOR
SET DGEGTDT=$ORDER(^DGEN(27.16,"B",DGEGTDT),-1)
IF STOP!(DGEGTDT="")
QUIT
Begin DoDot:1
+14 FOR
SET DGEGTIEN=$ORDER(^(DGEGTDT,DGEGTIEN),-1)
IF DGEGTIEN=""!STOP
QUIT
Begin DoDot:2
+15 IF '$PIECE($GET(^DGEN(27.16,+DGEGTIEN,0)),"^",8)
SET STOP=DGEGTIEN
End DoDot:2
End DoDot:1
+16 SET DGEGTF=1
+17 ;inactivate old EGT settings
IF $GET(ENRDT)
IF ENRDT'>DT
IF $$INACT(STOP)
+18 QUIT +STOP
+19 ;
+20 ;
GET(EGTIEN,DGEGT) ;
+1 ; Description: Used to obtain a record in the ENROLLMENT GROUP THRESHOLD file. The values will be returned in the DGEGT() array.
+2 ;
+3 ; Input:
+4 ; EGTIEN - internal entry number of record in the ENROLLMENT GROUP THRESHOLD file
+5 ;
+6 ; Output:
+7 ; DGEGT - The ENROLLMENT GROUP THRESHOLD array, passed by reference
+8 ;
+9 ; Subscript Field
+10 ; --------- ---------------------
+11 ; "EFFDATE" EGT EFFECTIVE DATE
+12 ; "PRIORITY" EGT PRIORITY
+13 ; "SUBGRP" EGT SUBGROUP
+14 ; "TYPE" EGT TYPE
+15 ; "FEDDATE" FEDERAL REGISTER DATE
+16 ; "ENTDATE" DATE ENTERED
+17 ; "SOURCE" SOURCE OF EGT
+18 ; "REMARKS" REMARKS
+19 ;
+20 NEW SUB,NODE
+21 KILL DGEGT
SET DGEGT=""
+22 ;
+23 IF '$GET(EGTIEN)
Begin DoDot:1
+24 FOR SUB="EFFDATE","PRIORITY","SUBGRP","TYPE","FEDDATE","ENTDATE","SOURCE","REMARKS"
SET DGEGT(SUB)=""
End DoDot:1
QUIT 0
+25 ;
+26 SET NODE=$GET(^DGEN(27.16,EGTIEN,0))
+27 SET DGEGT("EFFDATE")=$PIECE(NODE,"^")
+28 SET DGEGT("PRIORITY")=$PIECE(NODE,"^",2)
+29 SET DGEGT("SUBGRP")=$PIECE(NODE,"^",3)
+30 SET DGEGT("TYPE")=$PIECE(NODE,"^",4)
+31 SET DGEGT("FEDDATE")=$PIECE(NODE,"^",5)
+32 SET DGEGT("ENTDATE")=$PIECE(NODE,"^",6)
+33 SET DGEGT("SOURCE")=$PIECE(NODE,"^",7)
+34 SET NODE=$GET(^DGEN(27.16,EGTIEN,"R"))
+35 SET DGEGT("REMARKS")=$PIECE(NODE,"^")
+36 ;
+37 QUIT 1
+38 ;
+39 ;
STORE(DGEGT,ERROR,CHKFLG) ;
+1 ; Description: Creates a new entry in the ENROLLMENT GROUP THRESHOLD file.
+2 ;
+3 ; Input:
+4 ; DGEGT - the ENROLLMENT GROUP THRESHOLD array, passed by reference
+5 ; CHKFLG - a flag, if set to 1 means that field validation checks
+6 ; were completed, 0 indicates field validation checks should
+7 ; be performed (optional)
+8 ;
+9 ; Output:
+10 ; Function Value - Returns internal entry number of record created, or 0 on failure
+11 ; ERROR - if not successful, an error message is returned,
+12 ; pass by reference (optional)
+13 ;
+14 ;
+15 SET ERROR=""
+16 IF $GET(CHKFLG)'=1
IF '$$VALID(.DGEGT,.ERROR)
QUIT 0
+17 ;
+18 NEW ADD,DATA,OLDEGT,INACT
+19 SET OLDEGT=$$FINDCUR()
+20 SET DATA(.01)=DGEGT("EFFDATE")
+21 SET DATA(.02)=DGEGT("PRIORITY")
+22 SET DATA(.03)=DGEGT("SUBGRP")
+23 SET DATA(.04)=DGEGT("TYPE")
+24 SET DATA(.05)=DGEGT("FEDDATE")
+25 SET DATA(.06)=DGEGT("ENTDATE")
+26 SET DATA(.07)=DGEGT("SOURCE")
+27 SET DATA(25)=DGEGT("REMARKS")
+28 SET ADD=$$ADD^DGENDBS(27.16,,.DATA,.ERROR)
+29 ;
+30 ; inactivate "old" EGT settings
+31 SET INACT=$$INACT(ADD,.OLDEGT,.DGEGT)
+32 ;
+33 QUIT +ADD
+34 ;
+35 ;
UPDATE(EGTIEN,DGEGT,ERROR) ;
+1 ; Description: Updates an Enrollment Group Threshold record in the
+2 ; ENROLLMENT GROUP THRESHOLD file. This function locks the Enrollment
+3 ; Group Threshold record and releases the lock when the update is
+4 ; complete.
+5 ;
+6 ; Input:
+7 ; EGTIEN - internal entry number of record in the ENROLLMENT GROUP THRESHOLD file
+8 ; DGEGT - the ENROLLMENT GROUP THRESHOLD array, passed by reference
+9 ;
+10 ; Output:
+11 ; Function Value - Returns 1 if successful, otherwise 0
+12 ; ERROR - if not successful, an error message is returned,
+13 ; pass by reference
+14 ;
+15 NEW SUCCESS,DATA
+16 SET SUCCESS=1
+17 SET ERROR=""
+18 ;
+19 ; drops out of do block if invalid condition is found
Begin DoDot:1
+20 IF $GET(EGTIEN)
IF $DATA(^DGEN(27.16,EGTIEN,0))
+21 IF '$TEST
SET SUCCESS=0
SET ERROR="ENROLLMENT GROUP THRESHOLD RECORD NOT FOUND"
QUIT
+22 IF '$$LOCK(EGTIEN)
SET SUCCESS=0
SET ERROR="ENROLLMENT GROUP THRESHOLD RECORD IS LOCKED, CAN'T BE EDITED"
QUIT
+23 ;
+24 SET DATA(.01)=DGEGT("EFFDATE")
+25 SET DATA(.02)=DGEGT("PRIORITY")
+26 SET DATA(.03)=DGEGT("SUBGRP")
+27 SET DATA(.04)=DGEGT("TYPE")
+28 SET DATA(.05)=DGEGT("FEDDATE")
+29 SET DATA(.06)=DGEGT("ENTDATE")
+30 SET DATA(.07)=DGEGT("SOURCE")
+31 SET DATA(25)=DGEGT("REMARKS")
+32 ;
+33 IF '$$UPD^DGENDBS(27.16,EGTIEN,.DATA)
SET ERROR="FILEMAN UNABLE TO PERFORM UPDATE"
SET SUCCESS=0
QUIT
End DoDot:1
+34 ;
+35 DO UNLOCK(EGTIEN)
+36 ;
+37 QUIT SUCCESS
+38 ;
+39 ;
DELETE(EGTIEN) ; Description: This function will delete a record in the ENROLLMENT GROUP THRESHOLD file.
+1 ;
+2 ; Input:
+3 ; EGTIEN - as internal entry number of record to delete
+4 ;
+5 ; Outpu:
+6 ; Function Value - Returns 1 if successful, otherwise 0
+7 ;
+8 IF '$GET(EGTIEN)
QUIT 0
+9 NEW DIK,DA
+10 SET DIK="^DGEN(27.16,"
+11 SET DA=EGTIEN
+12 DO ^DIK
+13 QUIT 1
+14 ;
+15 ;
VALID(DGEGT,ERROR) ;
+1 ; Description: Performs validation checks on ENROLLMENT GROUP THRESHOLD record contained in the DGEGT array.
+2 ;
+3 ; Input:
+4 ; DGEGT - the ENROLLMENT GROUP THRESHOLD array, passed by reference
+5 ;
+6 ; Output:
+7 ; Function Value - Returns 1 if validation checks passed, 0 otherwise
+8 ; ERROR - if validation checks fail, an error message is
+9 ; returned, pass by reference
+10 ;
+11 NEW VALID,EXTERNAL,RESULT
+12 SET VALID=1
+13 SET ERROR=""
+14 ;
+15 ; drops out of DO block if an invalid condition found
Begin DoDot:1
+16 ;
+17 ; check for required fields
+18 IF $GET(DGEGT("EFFDATE"))=""
SET VALID=0
SET ERROR="REQUIRED FIELD 'EGT EFFECTIVE DATE' MISSING"
QUIT
+19 IF $GET(DGEGT("PRIORITY"))=""
SET VALID=0
SET ERROR="REQUIRED FIELD 'EGT PRIORITY' MISSING"
QUIT
+20 IF $GET(DGEGT("TYPE"))=""
SET VALID=0
SET ERROR="REQUIRED FIELD 'EGT TYPE' MISSING"
QUIT
+21 IF $GET(DGEGT("ENTDATE"))=""
SET VALID=0
SET ERROR="REQUIRED FIELD 'DATE ENTERED' MISSING"
QUIT
+22 IF $GET(DGEGT("SOURCE"))=""
SET VALID=0
SET ERROR="REQUIRED FIELD 'SOURCE OF EGT' MISSING"
QUIT
+23 ;
+24 ; check if field values are valid
+25 IF '$$TESTVAL("EFFDATE",DGEGT("EFFDATE"))
SET VALID=0
SET ERROR="'EGT EFFECTIVE DATE' NOT VALID"
QUIT
+26 IF '$$TESTVAL("PRIORITY",DGEGT("PRIORITY"))
SET VALID=0
SET ERROR="'EGT PRIORITY' NOT VALID"
QUIT
+27 IF '$$TESTVAL("SUBGRP",DGEGT("SUBGRP"))
SET VALID=0
SET ERROR="'EGT SUBGRP' NOT VALID"
QUIT
+28 IF '$$TESTVAL("TYPE",DGEGT("TYPE"))
SET VALID=0
SET ERROR="'EGT TYPE' NOT VALID"
QUIT
+29 IF '$$TESTVAL("FEDDATE",DGEGT("FEDDATE"))
SET VALID=0
SET ERROR="'FEDERAL REGISTER DATE' NOT VALID"
QUIT
+30 IF '$$TESTVAL("ENTDATE",DGEGT("ENTDATE"))
SET VALID=0
SET ERROR="'DATE ENTERED' NOT VALID"
QUIT
+31 IF '$$TESTVAL("SOURCE",DGEGT("SOURCE"))
SET VALID=0
SET ERROR="'SOURCE OF EGT' NOT VALID"
QUIT
+32 IF ($GET(DGEGT("REMARKS"))'="")&($LENGTH($GET(DGEGT("REMARKS")))<3)!($LENGTH($GET(DGEGT("REMARKS")))>80)
SET VALID=0
SET ERROR="'REMARKS' NOT VALID"
QUIT
End DoDot:1
+33 ;
+34 QUIT VALID
+35 ;
+36 ;
TESTVAL(SUB,VAL) ; Description: Used to determine if a field value is valid.
+1 ;
+2 ; Input:
+3 ; SUB - as the field subscript
+4 ; VAL - as the field value
+5 ;
+6 ; Output:
+7 ; Function value: Returns 1 if the field value (VAL) is valid for
+8 ; the subscript (SUB), returns 0 otherwise.
+9 ;
+10 NEW DISPLAY,FIELD,RESULT,VALID
+11 ;
+12 SET VALID=1
+13 ;
+14 IF (VAL'="")
Begin DoDot:1
+15 SET FIELD=$$FIELD(SUB)
+16 ; if there is no external value then not valid
+17 SET DISPLAY=$$EXTERNAL^DILFD(27.16,FIELD,"F",VAL)
+18 IF (DISPLAY="")
SET VALID=0
QUIT
+19 IF $$GET1^DID(27.16,FIELD,"","TYPE")'="POINTER"
Begin DoDot:2
+20 DO CHK^DIE(27.16,FIELD,,VAL,.RESULT)
IF RESULT="^"
SET VALID=0
QUIT
End DoDot:2
End DoDot:1
+21 ;
+22 QUIT VALID
+23 ;
+24 ;
FIELD(SUB) ; Description: Used to determine the field number for a given subscript in the EGT array.
+1 ;
+2 ; Input:
+3 ; SUB - as the field subscript
+4 ;
+5 ; Output:
+6 ; Function value: Returns the field number for the given subscript,
+7 ; otherwise null is returned.
+8 ;
+9 ;
+10 NEW FLD
+11 SET FLD=""
+12 ;
+13 ; drops out of DO block once SUB is determined
Begin DoDot:1
+14 IF SUB="EFFDATE"
SET FLD=.01
QUIT
+15 IF SUB="PRIORITY"
SET FLD=.02
QUIT
+16 IF SUB="SUBGRP"
SET FLD=.03
QUIT
+17 IF SUB="TYPE"
SET FLD=.04
QUIT
+18 IF SUB="FEDDATE"
SET FLD=.05
QUIT
+19 IF SUB="ENTDATE"
SET FLD=.06
QUIT
+20 IF SUB="SOURCE"
SET FLD=.07
QUIT
+21 IF SUB="REMARKS"
SET FLD=25
QUIT
End DoDot:1
+22 ;
+23 QUIT FLD
+24 ;
INACT(EGTIEN,OLDIEN,DGEGT) ;inactivate EGT settings that are currently not in effect
+1 ;
+2 ; input: EGTIEN -Current EGT ien from 27.16
+3 ; DGEGT (optional array) - Current EGT setting information
+4 ; DGEGTF (optional) - do not inactivate future EGT
+5 ;
+6 IF '$GET(EGTIEN)
QUIT 0
+7 NEW EGTFDA,EGTDT,EGTREC,ERR
+8 IF '$GET(OLDIEN)
SET OLDIEN=""
+9 IF '$DATA(DGEGT)
IF '$$GET(EGTIEN,.DGEGT)
QUIT 0
+10 ;future EGT setting
IF DGEGT("EFFDATE")>$$DT^XLFDT
SET EGTF=1
+11 SET EGTDT=""
+12 FOR
SET EGTDT=$ORDER(^DGEN(27.16,"B",EGTDT),-1)
IF 'EGTDT
QUIT
Begin DoDot:1
+13 SET EGTREC=""
+14 FOR
SET EGTREC=$ORDER(^DGEN(27.16,"B",EGTDT,EGTREC),-1)
IF 'EGTREC
QUIT
Begin DoDot:2
+15 ;new EGT setting
IF EGTREC=EGTIEN
QUIT
+16 IF $GET(EGTF)&(EGTREC=OLDIEN)
QUIT
+17 IF $PIECE($GET(^DGEN(27.16,EGTREC,0)),"^")>DT
Begin DoDot:3
+18 IF $GET(DGEGTF)
QUIT
+19 IF $$DELETE(EGTREC)
QUIT
End DoDot:3
QUIT
+20 SET EGTFDA(27.16,EGTREC_",",.08)=1
End DoDot:2
End DoDot:1
+21 IF $DATA(EGTFDA)
DO UPDATE^DIE("","EGTFDA","","ERR")
+22 QUIT 1
