- DGENEGT ;ALB/KCL/RGL - Enrollment Group Threshold API's ; 11/20/03 3:39pm
- ;;5.3;Registration;**232,451**;Aug 13, 1993
- ;
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENEGT 9657 printed Jan 18, 2025@03:43:17 Page 2
- DGENEGT ;ALB/KCL/RGL - Enrollment Group Threshold API's ; 11/20/03 3:39pm
- +1 ;;5.3;Registration;**232,451**;Aug 13, 1993
- +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