- 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 Jan 18, 2025@02:57:46 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