ENX1P92 ;ALB/BR - ENG National Update ; 4/15/13 1:03pm
;;7.0;ENGINEERING;**92**;Aug 17, 1993;Build 10
;
;this routine is used as a post-init in a KIDS build
;to modify the NX SGL (#6914.3) file
;and the NX BOC (#6914.4) file
;
Q
;
START ; entry point for post-init
;
D ADDBOC
D CHNGSGL
Q
;
ADDBOC ;* add new entry to the NX BOC (#6914.4) file
;
;
; ENGBOC is in format:
; CODE^TITLE^CORRESPONDING SGL
;
N ENGBOC,ENGDINUM,ENGNX,ENGCBOC,ENGBOCT,ENGCSGL
D MES^XPDUTL(" ")
D BMES^XPDUTL("Adding new entries to the NX BOC #6914.4 File...")
D MES^XPDUTL(" ")
F ENGNX=1:1 S ENGBOC=$P($T(NXBOC+ENGNX),";;",2) Q:ENGBOC="QUIT" D
.S ENGCBOC=$P(ENGBOC,U,1),ENGBOCT=$P(ENGBOC,U,2),ENGCSGL=$P(ENGBOC,U,3)
.D FILBOC
Q
FILBOC ;file boc
N X,Y,ENGSTR
I $D(^ENG(6914.4,"B",ENGCBOC)) D
.D MES^XPDUTL(" ")
.D BMES^XPDUTL("Entry # "_ENGCBOC_" already added")
.D MES^XPDUTL(" ")
I '$D(^ENG(6914.4,"B",ENGCBOC)) D
.S X=ENGCBOC,DIC="^ENG(6914.4,",DIC(0)="",DIC("DR")="1///^S X=ENGBOCT;2///^S X=ENGCSGL"
.D FILE^DICN
.I +Y>0 D
..D MES^XPDUTL(" ")
..S ENGSTR=" Entry #"_+Y_" for "_$P(Y,U,2)
..D BMES^XPDUTL(ENGSTR_" ...successfully added.")
.I Y=-1 D
..D MES^XPDUTL(" ")
..D BMES^XPDUTL("ERROR when attempting to add "_ENGCBOC)
Q
NXBOC ;CAPITALIZED BUDGET OBJECT CODE^BOC TITLE^CORRESPONDING SGL
;;2335^SOFTWARE^1830
;;QUIT
;
Q
CHNGSGL ;Change 1524 SGL to 1995 in 6914.4 file
N ENDA,ENFDA
;
;update fields .01,1, and 3. prevent adding entry during install
S ENDA=$$FIND1^DIC(6914.3,"","X","1524","B")
I ENDA D
.D BMES^XPDUTL(" Renaming the Excess SGL from 1524 to 1995. ")
.K ENFDA S ENFDA(6914.3,ENDA_",",.01)="1995"
.S ENFDA(6914.3,ENDA_",",1)="PP&E REMOVED FROM SERVICE BUT NOT DISPOSED"
.S ENFDA(6914.3,ENDA_",",3)="EQ PEND DISP"
.D FILE^DIE("","ENFDA") D MSG^DIALOG()
.D BMES^XPDUTL("Renaming completed")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENX1P92 1917 printed Dec 13, 2024@01:56:33 Page 2
ENX1P92 ;ALB/BR - ENG National Update ; 4/15/13 1:03pm
+1 ;;7.0;ENGINEERING;**92**;Aug 17, 1993;Build 10
+2 ;
+3 ;this routine is used as a post-init in a KIDS build
+4 ;to modify the NX SGL (#6914.3) file
+5 ;and the NX BOC (#6914.4) file
+6 ;
+7 QUIT
+8 ;
START ; entry point for post-init
+1 ;
+2 DO ADDBOC
+3 DO CHNGSGL
+4 QUIT
+5 ;
ADDBOC ;* add new entry to the NX BOC (#6914.4) file
+1 ;
+2 ;
+3 ; ENGBOC is in format:
+4 ; CODE^TITLE^CORRESPONDING SGL
+5 ;
+6 NEW ENGBOC,ENGDINUM,ENGNX,ENGCBOC,ENGBOCT,ENGCSGL
+7 DO MES^XPDUTL(" ")
+8 DO BMES^XPDUTL("Adding new entries to the NX BOC #6914.4 File...")
+9 DO MES^XPDUTL(" ")
+10 FOR ENGNX=1:1
SET ENGBOC=$PIECE($TEXT(NXBOC+ENGNX),";;",2)
if ENGBOC="QUIT"
QUIT
Begin DoDot:1
+11 SET ENGCBOC=$PIECE(ENGBOC,U,1)
SET ENGBOCT=$PIECE(ENGBOC,U,2)
SET ENGCSGL=$PIECE(ENGBOC,U,3)
+12 DO FILBOC
End DoDot:1
+13 QUIT
FILBOC ;file boc
+1 NEW X,Y,ENGSTR
+2 IF $DATA(^ENG(6914.4,"B",ENGCBOC))
Begin DoDot:1
+3 DO MES^XPDUTL(" ")
+4 DO BMES^XPDUTL("Entry # "_ENGCBOC_" already added")
+5 DO MES^XPDUTL(" ")
End DoDot:1
+6 IF '$DATA(^ENG(6914.4,"B",ENGCBOC))
Begin DoDot:1
+7 SET X=ENGCBOC
SET DIC="^ENG(6914.4,"
SET DIC(0)=""
SET DIC("DR")="1///^S X=ENGBOCT;2///^S X=ENGCSGL"
+8 DO FILE^DICN
+9 IF +Y>0
Begin DoDot:2
+10 DO MES^XPDUTL(" ")
+11 SET ENGSTR=" Entry #"_+Y_" for "_$PIECE(Y,U,2)
+12 DO BMES^XPDUTL(ENGSTR_" ...successfully added.")
End DoDot:2
+13 IF Y=-1
Begin DoDot:2
+14 DO MES^XPDUTL(" ")
+15 DO BMES^XPDUTL("ERROR when attempting to add "_ENGCBOC)
End DoDot:2
End DoDot:1
+16 QUIT
NXBOC ;CAPITALIZED BUDGET OBJECT CODE^BOC TITLE^CORRESPONDING SGL
+1 ;;2335^SOFTWARE^1830
+2 ;;QUIT
+3 ;
+4 QUIT
CHNGSGL ;Change 1524 SGL to 1995 in 6914.4 file
+1 NEW ENDA,ENFDA
+2 ;
+3 ;update fields .01,1, and 3. prevent adding entry during install
+4 SET ENDA=$$FIND1^DIC(6914.3,"","X","1524","B")
+5 IF ENDA
Begin DoDot:1
+6 DO BMES^XPDUTL(" Renaming the Excess SGL from 1524 to 1995. ")
+7 KILL ENFDA
SET ENFDA(6914.3,ENDA_",",.01)="1995"
+8 SET ENFDA(6914.3,ENDA_",",1)="PP&E REMOVED FROM SERVICE BUT NOT DISPOSED"
+9 SET ENFDA(6914.3,ENDA_",",3)="EQ PEND DISP"
+10 DO FILE^DIE("","ENFDA")
DO MSG^DIALOG()
+11 DO BMES^XPDUTL("Renaming completed")
End DoDot:1
+12 QUIT
