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

ENX1P92.m

Go to the documentation of this file.
  1. ENX1P92 ;ALB/BR - ENG National Update ; 4/15/13 1:03pm
  1. ;;7.0;ENGINEERING;**92**;Aug 17, 1993;Build 10
  1. ;
  1. ;this routine is used as a post-init in a KIDS build
  1. ;to modify the NX SGL (#6914.3) file
  1. ;and the NX BOC (#6914.4) file
  1. ;
  1. Q
  1. ;
  1. START ; entry point for post-init
  1. ;
  1. D ADDBOC
  1. D CHNGSGL
  1. Q
  1. ;
  1. ADDBOC ;* add new entry to the NX BOC (#6914.4) file
  1. ;
  1. ;
  1. ; ENGBOC is in format:
  1. ; CODE^TITLE^CORRESPONDING SGL
  1. ;
  1. N ENGBOC,ENGDINUM,ENGNX,ENGCBOC,ENGBOCT,ENGCSGL
  1. D MES^XPDUTL(" ")
  1. D BMES^XPDUTL("Adding new entries to the NX BOC #6914.4 File...")
  1. D MES^XPDUTL(" ")
  1. F ENGNX=1:1 S ENGBOC=$P($T(NXBOC+ENGNX),";;",2) Q:ENGBOC="QUIT" D
  1. .S ENGCBOC=$P(ENGBOC,U,1),ENGBOCT=$P(ENGBOC,U,2),ENGCSGL=$P(ENGBOC,U,3)
  1. .D FILBOC
  1. Q
  1. FILBOC ;file boc
  1. N X,Y,ENGSTR
  1. I $D(^ENG(6914.4,"B",ENGCBOC)) D
  1. .D MES^XPDUTL(" ")
  1. .D BMES^XPDUTL("Entry # "_ENGCBOC_" already added")
  1. .D MES^XPDUTL(" ")
  1. I '$D(^ENG(6914.4,"B",ENGCBOC)) D
  1. .S X=ENGCBOC,DIC="^ENG(6914.4,",DIC(0)="",DIC("DR")="1///^S X=ENGBOCT;2///^S X=ENGCSGL"
  1. .D FILE^DICN
  1. .I +Y>0 D
  1. ..D MES^XPDUTL(" ")
  1. ..S ENGSTR=" Entry #"_+Y_" for "_$P(Y,U,2)
  1. ..D BMES^XPDUTL(ENGSTR_" ...successfully added.")
  1. .I Y=-1 D
  1. ..D MES^XPDUTL(" ")
  1. ..D BMES^XPDUTL("ERROR when attempting to add "_ENGCBOC)
  1. Q
  1. NXBOC ;CAPITALIZED BUDGET OBJECT CODE^BOC TITLE^CORRESPONDING SGL
  1. ;;2335^SOFTWARE^1830
  1. ;;QUIT
  1. ;
  1. Q
  1. CHNGSGL ;Change 1524 SGL to 1995 in 6914.4 file
  1. N ENDA,ENFDA
  1. ;
  1. ;update fields .01,1, and 3. prevent adding entry during install
  1. S ENDA=$$FIND1^DIC(6914.3,"","X","1524","B")
  1. I ENDA D
  1. .D BMES^XPDUTL(" Renaming the Excess SGL from 1524 to 1995. ")
  1. .K ENFDA S ENFDA(6914.3,ENDA_",",.01)="1995"
  1. .S ENFDA(6914.3,ENDA_",",1)="PP&E REMOVED FROM SERVICE BUT NOT DISPOSED"
  1. .S ENFDA(6914.3,ENDA_",",3)="EQ PEND DISP"
  1. .D FILE^DIE("","ENFDA") D MSG^DIALOG()
  1. .D BMES^XPDUTL("Renaming completed")
  1. Q