Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENEGT

DGENEGT.m

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