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

ENXIP57.m

Go to the documentation of this file.
ENXIP57 ;WCIOFO/SAB- PATCH INSTALL ROUTINE ;9/24/1998
 ;;7.0;ENGINEERING;**57**;Aug 17, 1993
 Q
 ;
PS ;Post Install Entry Point
 N ENX
 ;
 ; only perform during 1st install
 I $$PATCH^XPDUTL("EN*7.0*57") D BMES^XPDUTL("  Skipping post install since patch was previously installed.") Q
 ;
 ; create KIDS checkpoints with call backs
 F ENX="AMAF","EIL64" D
 . S Y=$$NEWCP^XPDUTL(ENX,ENX_"^ENXIP57")
 . I 'Y D BMES^XPDUTL("ERROR Creating "_ENX_" Checkpoint.")
 Q
 ;
EIL64 ; update EIL department 64
 N ENDA,ENFDA,ENIEN
 ;
 D BMES^XPDUTL("  Department 64 in the National EIL (#6914.9) file will be modified.")
 D MES^XPDUTL("    The description will be changed from CHIEF ATTORNEY to GENERAL COUNSEL.")
 D MES^XPDUTL("    The valid A/O will be changed from 20 (VBA) to 02 (GENERAL COUNSEL).")
 ;
 ; find entry
 S ENDA=$$FIND1^DIC(6914.9,"","X","64","B")
 I 'ENDA D BMES^XPDUTL("    ERROR: Could not find department 64.")
 ;
 I ENDA D
 . ; get current values
 . S ENIEN=ENDA_","
 . D GETS^DIQ(6914.9,ENIEN,"1;3","","ENFDA")
 . ;
 . ; check if already updated
 . I ENFDA(6914.9,ENIEN,1)="GENERAL COUNSEL",ENFDA(6914.9,ENIEN,3)="02" D  Q
 . . D BMES^XPDUTL("    The description and valid A/O have already been updated.")
 . . D MES^XPDUTL("    No change is necessary.")
 . ;
 . ; check for unexpected values
 . I ENFDA(6914.9,ENIEN,1)'="CHIEF ATTORNEY"!(ENFDA(6914.9,ENIEN,3)'="20") D  Q
 . . D BMES^XPDUTL("   WARNING: Current value(s) are unexpected and appear to have been locally")
 . . D MES^XPDUTL("   modified. No changes will be made.")
 . . D MES^XPDUTL("   Please investigate and manually update as appropriate.")
 . . D MES^XPDUTL("   Current description: "_ENFDA(6914.9,ENIEN,1)_".  Expected Value: CHIEF ATTORNEY.")
 . . D MES^XPDUTL("   Current A/O: "_ENFDA(6914.9,ENIEN,3)_".  Expected value: 20.")
 . ;
 . ; update file
 . S ENFDA(6914.9,ENIEN,1)="GENERAL COUNSEL"
 . S ENFDA(6914.9,ENIEN,3)="02"
 . D FILE^DIE("E","ENFDA") D MSG^DIALOG()
 . I '$G(DIERR) D MES^XPDUTL("  EIL Update complete.")
 Q
AMAF ; Transfer AMAF fund assets to new fund
 N ENAMAF,ENAMT,ENC,ENDA,ENEIL,ENFUNDN,ENFUNDNI,ENSGL,ENSTA,ENT,EXCEPTHD
 ;
 D BMES^XPDUTL("  Generating FR Documents to transfer Equipment from the 'AMAF' fund...")
 ;
 ; estimate count of equipment to examine
 S ENC("TOT")=$P($G(^ENG(6915.2,0)),U,4)-$P($G(^ENG(6915.5,0)),U,4)
 I ENC("TOT")<1 S ENC("TOT")=1
 S ENC("EQ")=0 ; count of evaluated equipment
 S XPDIDTOT=ENC("TOT") ; set total for status bar
 S ENC("UPD")=5  ; initial % required to update status bar
 ;
 ; determine AMAF ien
 S ENAMAF=$O(^ENG(6914.6,"B","AMAF",0))
 ;
 ; loop thru equipment in FA DOCUMENT LOG file
 S EXCEPTHD=0
 S ENDA=0 F  S ENDA=$O(^ENG(6915.2,"B",ENDA)) Q:'ENDA  D
 . Q:+$$CHKFA^ENFAUTL(ENDA)'>0  ; not currently reported to FAP
 . ;
 . S ENC("EQ")=ENC("EQ")+1
 . S ENC("%")=ENC("EQ")*100/ENC("TOT") ; calculate % complete
 . ; check if status bar should be updated
 . I ENC("%")>ENC("UPD"),ENC("%")<100 D
 . . D UPDATE^XPDID(ENC("EQ")) ; update status bar
 . . S ENC("UPD")=ENC("UPD")+5 ; increase update criteria by 5%
 . ;
 . Q:$P($G(^ENG(6914,ENDA,9)),U,7)'=ENAMAF  ; not in AMAF
 . S ENEIL=$E($$GET1^DIQ(6914,ENDA_",",19),1,2)
 . ; don't move following EILs
 . I "^06^56^75^90^98^99^"[(U_ENEIL_U) D  Q
 . . I 'EXCEPTHD D  ; exception header not yet printed
 . . . S EXCEPTHD=1
 . . . D BMES^XPDUTL("    The following equipment can not be automatically moved out of the AMAF fund")
 . . . D MES^XPDUTL("    because the EIL department number does not map to one of the new funds.")
 . . . D BMES^XPDUTL("     ENTRY #      EIL DEPT")
 . . . D MES^XPDUTL("     ----------   --------")
 . . D MES^XPDUTL("      "_$$LJ^XLFSTR(ENDA,10)_"   "_ENEIL)
 . ;
 . ; determine the new fund based on the EIL
 . D
 . . I "^57^58^"[(U_ENEIL_U) S ENFUNDN="AMAFNC" Q
 . . I "^38^39^40^80^81^"[(U_ENEIL_U) S ENFUNDN="AMAFRE" Q
 . . I "^60^61^62^63^64^65^66^67^68^"[(U_ENEIL_U) S ENFUNDN="AMAFGE" Q
 . . S ENFUNDN="AMAFMC" ; all others
 . S ENFUNDNI=$O(^ENG(6914.6,"B",ENFUNDN,0))
 . I 'ENFUNDNI D MES^XPDUTL("ERROR: Couldn't determine Fund. # "_ENDA) Q
 . ;
 . ; generate an FR Document
 . S ENX=$$XFUND(ENDA,ENFUNDNI)
 . I 'ENX D MES^XPDUTL("ERROR: Couldn't create FR Doc. # "_ENDA) Q
 . ;
 . ; update counters and totals
 . S ENSTA=$$GET1^DIQ(6914,ENDA_",",60) S:ENSTA="" ENSTA="UNK"
 . S ENSGL=$$GET1^DIQ(6914,ENDA_",",38) S:ENSGL="" ENSGL="UNK"
 . S ENAMT=$P($G(^ENG(6914,ENDA,2)),U,3)
 . S $P(ENT(ENSTA,ENFUNDN,ENSGL),U)=$P($G(ENT(ENSTA,ENFUNDN,ENSGL)),U)+1
 . S $P(ENT(ENSTA,ENFUNDN,ENSGL),U,2)=$P($G(ENT(ENSTA,ENFUNDN,ENSGL)),U,2)+ENAMT
 ;
 ; report results
 D BMES^XPDUTL("  Summary report of FR Documents generated by the patch to move existing")
 D MES^XPDUTL("  equipment from AMAF to a new fund.")
 S ENT="0^0"
 S ENSTA="" F  S ENSTA=$O(ENT(ENSTA)) Q:ENSTA=""  D
 . D BMES^XPDUTL("    Station: "_ENSTA)
 . S ENT(ENSTA)="0^0"
 . S ENFUNDN="" F  S ENFUNDN=$O(ENT(ENSTA,ENFUNDN)) Q:ENFUNDN=""  D
 . . D MES^XPDUTL("      to Fund: "_ENFUNDN)
 . . S ENT(ENSTA,ENFUNDN)="0^0"
 . . S ENSGL="" F  S ENSGL=$O(ENT(ENSTA,ENFUNDN,ENSGL)) Q:ENSGL=""  D
 . . . S ENX="        SGL: "_ENSGL
 . . . S ENX=ENX_"   Count: "_$J($P(ENT(ENSTA,ENFUNDN,ENSGL),U),3,0)
 . . . S ENX=ENX_"   Value: "_$J("$"_$FN($P(ENT(ENSTA,ENFUNDN,ENSGL),U,2),",",2),16)
 . . . D MES^XPDUTL(ENX)
 . . . S $P(ENT(ENSTA,ENFUNDN),U)=$P(ENT(ENSTA,ENFUNDN),U)+$P(ENT(ENSTA,ENFUNDN,ENSGL),U)
 . . . S $P(ENT(ENSTA,ENFUNDN),U,2)=$P(ENT(ENSTA,ENFUNDN),U,2)+$P(ENT(ENSTA,ENFUNDN,ENSGL),U,2)
 . . S ENX="                           ---          ----------------"
 . . D MES^XPDUTL(ENX)
 . . S ENX="      Fund total:"
 . . S ENX=ENX_"   Count: "_$J($P(ENT(ENSTA,ENFUNDN),U),3,0)
 . . S ENX=ENX_"   Value: "_$J("$"_$FN($P(ENT(ENSTA,ENFUNDN),U,2),",",2),16)
 . . D MES^XPDUTL(ENX)
 . . D MES^XPDUTL(" ")
 . . S $P(ENT(ENSTA),U)=$P(ENT(ENSTA),U)+$P(ENT(ENSTA,ENFUNDN),U)
 . . S $P(ENT(ENSTA),U,2)=$P(ENT(ENSTA),U,2)+$P(ENT(ENSTA,ENFUNDN),U,2)
 . S ENX="                           ---          ----------------"
 . D MES^XPDUTL(ENX)
 . S ENX="    Station total:"
 . S ENX=ENX_"  Count: "_$J($P(ENT(ENSTA),U),3,0)
 . S ENX=ENX_"   Value: "_$J("$"_$FN($P(ENT(ENSTA),U,2),",",2),16)
 . D MES^XPDUTL(ENX)
 . S $P(ENT,U)=$P(ENT,U)+$P(ENT(ENSTA),U)
 . S $P(ENT,U,2)=$P(ENT,U,2)+$P(ENT(ENSTA),U,2)
 S ENX="                           ===          ================"
 D BMES^XPDUTL(ENX)
 S ENX="  Grand Total:   "
 S ENX=ENX_"   Count: "_$J($P(ENT,U),3,0)
 S ENX=ENX_"   Value: "_$J("$"_$FN($P(ENT,U,2),",",2),16)
 D MES^XPDUTL(ENX)
 Q
 ;
XFUND(ENDA,ENFUNDI) ; Change FUND
 ; input   ENDA    - equipment entry
 ;         ENFUNDI - new fund ien
 ; returns 1 if success or 0 if failed
 ;
 N DA,ENBAT,ENDO,ENEQ,ENFA,ENFAP,ENFR,ENX,I
 S ENEQ("DA")=ENDA
 S ENBAT("SILENT")=1
 S ENX=$$CHKFA^ENFAUTL(ENEQ("DA"))
 S ENFA("DA")=$P(ENX,U,4)
 F I=1,2,3,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
 ; create FR document to change fund
 S ENDO=1,ENFR("DA")=""
 D ADDFR^ENFAXFR
 D:ENDO
 . ; populate FR Document
 . S ENFAP(100)=$G(^ENG(6915.6,ENFR("DA"),100))
 . S $P(ENFAP(100),U,2)=ENFUNDI ; fund (required)
 . S $P(ENFAP(100),U,3)=$P(ENEQ(9),U,8) ; a/o (required)
 . S $P(ENFAP(100),U,5)=$P(ENEQ(9),U,6) ; boc (deleted when blank sent)
 . S $P(ENFAP(100),U,6)=$P(ENEQ(2),U,9) ; cmr (determines cost ctr)
 . S ^ENG(6915.6,ENFR("DA"),100)=ENFAP(100)
 D:ENDO CVTDATA^ENFAXFR
 D:ENDO
 . S ENFAP("DOC")="FR" D ^ENFAVAL
 . I $D(^TMP($J,"BAD",ENEQ("DA"))) S ENDO=0
 I 'ENDO,$G(ENFR("DA"))]"" D
 . S DA=ENFR("DA"),DIK="^ENG(6915.6," D ^DIK K DIK
 D:ENDO UPDATE^ENFAXFR
 I $G(ENFR("DA"))]"" L -^ENG(6915.6,ENFR("DA"))
 Q ENDO
 ;
 ;ENXIP57