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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENXIP57 7767 printed Dec 13, 2024@01:56:49 Page 2
ENXIP57 ;WCIOFO/SAB- PATCH INSTALL ROUTINE ;9/24/1998
+1 ;;7.0;ENGINEERING;**57**;Aug 17, 1993
+2 QUIT
+3 ;
PS ;Post Install Entry Point
+1 NEW ENX
+2 ;
+3 ; only perform during 1st install
+4 IF $$PATCH^XPDUTL("EN*7.0*57")
DO BMES^XPDUTL(" Skipping post install since patch was previously installed.")
QUIT
+5 ;
+6 ; create KIDS checkpoints with call backs
+7 FOR ENX="AMAF","EIL64"
Begin DoDot:1
+8 SET Y=$$NEWCP^XPDUTL(ENX,ENX_"^ENXIP57")
+9 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_ENX_" Checkpoint.")
End DoDot:1
+10 QUIT
+11 ;
EIL64 ; update EIL department 64
+1 NEW ENDA,ENFDA,ENIEN
+2 ;
+3 DO BMES^XPDUTL(" Department 64 in the National EIL (#6914.9) file will be modified.")
+4 DO MES^XPDUTL(" The description will be changed from CHIEF ATTORNEY to GENERAL COUNSEL.")
+5 DO MES^XPDUTL(" The valid A/O will be changed from 20 (VBA) to 02 (GENERAL COUNSEL).")
+6 ;
+7 ; find entry
+8 SET ENDA=$$FIND1^DIC(6914.9,"","X","64","B")
+9 IF 'ENDA
DO BMES^XPDUTL(" ERROR: Could not find department 64.")
+10 ;
+11 IF ENDA
Begin DoDot:1
+12 ; get current values
+13 SET ENIEN=ENDA_","
+14 DO GETS^DIQ(6914.9,ENIEN,"1;3","","ENFDA")
+15 ;
+16 ; check if already updated
+17 IF ENFDA(6914.9,ENIEN,1)="GENERAL COUNSEL"
IF ENFDA(6914.9,ENIEN,3)="02"
Begin DoDot:2
+18 DO BMES^XPDUTL(" The description and valid A/O have already been updated.")
+19 DO MES^XPDUTL(" No change is necessary.")
End DoDot:2
QUIT
+20 ;
+21 ; check for unexpected values
+22 IF ENFDA(6914.9,ENIEN,1)'="CHIEF ATTORNEY"!(ENFDA(6914.9,ENIEN,3)'="20")
Begin DoDot:2
+23 DO BMES^XPDUTL(" WARNING: Current value(s) are unexpected and appear to have been locally")
+24 DO MES^XPDUTL(" modified. No changes will be made.")
+25 DO MES^XPDUTL(" Please investigate and manually update as appropriate.")
+26 DO MES^XPDUTL(" Current description: "_ENFDA(6914.9,ENIEN,1)_". Expected Value: CHIEF ATTORNEY.")
+27 DO MES^XPDUTL(" Current A/O: "_ENFDA(6914.9,ENIEN,3)_". Expected value: 20.")
End DoDot:2
QUIT
+28 ;
+29 ; update file
+30 SET ENFDA(6914.9,ENIEN,1)="GENERAL COUNSEL"
+31 SET ENFDA(6914.9,ENIEN,3)="02"
+32 DO FILE^DIE("E","ENFDA")
DO MSG^DIALOG()
+33 IF '$GET(DIERR)
DO MES^XPDUTL(" EIL Update complete.")
End DoDot:1
+34 QUIT
AMAF ; Transfer AMAF fund assets to new fund
+1 NEW ENAMAF,ENAMT,ENC,ENDA,ENEIL,ENFUNDN,ENFUNDNI,ENSGL,ENSTA,ENT,EXCEPTHD
+2 ;
+3 DO BMES^XPDUTL(" Generating FR Documents to transfer Equipment from the 'AMAF' fund...")
+4 ;
+5 ; estimate count of equipment to examine
+6 SET ENC("TOT")=$PIECE($GET(^ENG(6915.2,0)),U,4)-$PIECE($GET(^ENG(6915.5,0)),U,4)
+7 IF ENC("TOT")<1
SET ENC("TOT")=1
+8 ; count of evaluated equipment
SET ENC("EQ")=0
+9 ; set total for status bar
SET XPDIDTOT=ENC("TOT")
+10 ; initial % required to update status bar
SET ENC("UPD")=5
+11 ;
+12 ; determine AMAF ien
+13 SET ENAMAF=$ORDER(^ENG(6914.6,"B","AMAF",0))
+14 ;
+15 ; loop thru equipment in FA DOCUMENT LOG file
+16 SET EXCEPTHD=0
+17 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6915.2,"B",ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+18 ; not currently reported to FAP
if +$$CHKFA^ENFAUTL(ENDA)'>0
QUIT
+19 ;
+20 SET ENC("EQ")=ENC("EQ")+1
+21 ; calculate % complete
SET ENC("%")=ENC("EQ")*100/ENC("TOT")
+22 ; check if status bar should be updated
+23 IF ENC("%")>ENC("UPD")
IF ENC("%")<100
Begin DoDot:2
+24 ; update status bar
DO UPDATE^XPDID(ENC("EQ"))
+25 ; increase update criteria by 5%
SET ENC("UPD")=ENC("UPD")+5
End DoDot:2
+26 ;
+27 ; not in AMAF
if $PIECE($GET(^ENG(6914,ENDA,9)),U,7)'=ENAMAF
QUIT
+28 SET ENEIL=$EXTRACT($$GET1^DIQ(6914,ENDA_",",19),1,2)
+29 ; don't move following EILs
+30 IF "^06^56^75^90^98^99^"[(U_ENEIL_U)
Begin DoDot:2
+31 ; exception header not yet printed
IF 'EXCEPTHD
Begin DoDot:3
+32 SET EXCEPTHD=1
+33 DO BMES^XPDUTL(" The following equipment can not be automatically moved out of the AMAF fund")
+34 DO MES^XPDUTL(" because the EIL department number does not map to one of the new funds.")
+35 DO BMES^XPDUTL(" ENTRY # EIL DEPT")
+36 DO MES^XPDUTL(" ---------- --------")
End DoDot:3
+37 DO MES^XPDUTL(" "_$$LJ^XLFSTR(ENDA,10)_" "_ENEIL)
End DoDot:2
QUIT
+38 ;
+39 ; determine the new fund based on the EIL
+40 Begin DoDot:2
+41 IF "^57^58^"[(U_ENEIL_U)
SET ENFUNDN="AMAFNC"
QUIT
+42 IF "^38^39^40^80^81^"[(U_ENEIL_U)
SET ENFUNDN="AMAFRE"
QUIT
+43 IF "^60^61^62^63^64^65^66^67^68^"[(U_ENEIL_U)
SET ENFUNDN="AMAFGE"
QUIT
+44 ; all others
SET ENFUNDN="AMAFMC"
End DoDot:2
+45 SET ENFUNDNI=$ORDER(^ENG(6914.6,"B",ENFUNDN,0))
+46 IF 'ENFUNDNI
DO MES^XPDUTL("ERROR: Couldn't determine Fund. # "_ENDA)
QUIT
+47 ;
+48 ; generate an FR Document
+49 SET ENX=$$XFUND(ENDA,ENFUNDNI)
+50 IF 'ENX
DO MES^XPDUTL("ERROR: Couldn't create FR Doc. # "_ENDA)
QUIT
+51 ;
+52 ; update counters and totals
+53 SET ENSTA=$$GET1^DIQ(6914,ENDA_",",60)
if ENSTA=""
SET ENSTA="UNK"
+54 SET ENSGL=$$GET1^DIQ(6914,ENDA_",",38)
if ENSGL=""
SET ENSGL="UNK"
+55 SET ENAMT=$PIECE($GET(^ENG(6914,ENDA,2)),U,3)
+56 SET $PIECE(ENT(ENSTA,ENFUNDN,ENSGL),U)=$PIECE($GET(ENT(ENSTA,ENFUNDN,ENSGL)),U)+1
+57 SET $PIECE(ENT(ENSTA,ENFUNDN,ENSGL),U,2)=$PIECE($GET(ENT(ENSTA,ENFUNDN,ENSGL)),U,2)+ENAMT
End DoDot:1
+58 ;
+59 ; report results
+60 DO BMES^XPDUTL(" Summary report of FR Documents generated by the patch to move existing")
+61 DO MES^XPDUTL(" equipment from AMAF to a new fund.")
+62 SET ENT="0^0"
+63 SET ENSTA=""
FOR
SET ENSTA=$ORDER(ENT(ENSTA))
if ENSTA=""
QUIT
Begin DoDot:1
+64 DO BMES^XPDUTL(" Station: "_ENSTA)
+65 SET ENT(ENSTA)="0^0"
+66 SET ENFUNDN=""
FOR
SET ENFUNDN=$ORDER(ENT(ENSTA,ENFUNDN))
if ENFUNDN=""
QUIT
Begin DoDot:2
+67 DO MES^XPDUTL(" to Fund: "_ENFUNDN)
+68 SET ENT(ENSTA,ENFUNDN)="0^0"
+69 SET ENSGL=""
FOR
SET ENSGL=$ORDER(ENT(ENSTA,ENFUNDN,ENSGL))
if ENSGL=""
QUIT
Begin DoDot:3
+70 SET ENX=" SGL: "_ENSGL
+71 SET ENX=ENX_" Count: "_$JUSTIFY($PIECE(ENT(ENSTA,ENFUNDN,ENSGL),U),3,0)
+72 SET ENX=ENX_" Value: "_$JUSTIFY("$"_$FNUMBER($PIECE(ENT(ENSTA,ENFUNDN,ENSGL),U,2),",",2),16)
+73 DO MES^XPDUTL(ENX)
+74 SET $PIECE(ENT(ENSTA,ENFUNDN),U)=$PIECE(ENT(ENSTA,ENFUNDN),U)+$PIECE(ENT(ENSTA,ENFUNDN,ENSGL),U)
+75 SET $PIECE(ENT(ENSTA,ENFUNDN),U,2)=$PIECE(ENT(ENSTA,ENFUNDN),U,2)+$PIECE(ENT(ENSTA,ENFUNDN,ENSGL),U,2)
End DoDot:3
+76 SET ENX=" --- ----------------"
+77 DO MES^XPDUTL(ENX)
+78 SET ENX=" Fund total:"
+79 SET ENX=ENX_" Count: "_$JUSTIFY($PIECE(ENT(ENSTA,ENFUNDN),U),3,0)
+80 SET ENX=ENX_" Value: "_$JUSTIFY("$"_$FNUMBER($PIECE(ENT(ENSTA,ENFUNDN),U,2),",",2),16)
+81 DO MES^XPDUTL(ENX)
+82 DO MES^XPDUTL(" ")
+83 SET $PIECE(ENT(ENSTA),U)=$PIECE(ENT(ENSTA),U)+$PIECE(ENT(ENSTA,ENFUNDN),U)
+84 SET $PIECE(ENT(ENSTA),U,2)=$PIECE(ENT(ENSTA),U,2)+$PIECE(ENT(ENSTA,ENFUNDN),U,2)
End DoDot:2
+85 SET ENX=" --- ----------------"
+86 DO MES^XPDUTL(ENX)
+87 SET ENX=" Station total:"
+88 SET ENX=ENX_" Count: "_$JUSTIFY($PIECE(ENT(ENSTA),U),3,0)
+89 SET ENX=ENX_" Value: "_$JUSTIFY("$"_$FNUMBER($PIECE(ENT(ENSTA),U,2),",",2),16)
+90 DO MES^XPDUTL(ENX)
+91 SET $PIECE(ENT,U)=$PIECE(ENT,U)+$PIECE(ENT(ENSTA),U)
+92 SET $PIECE(ENT,U,2)=$PIECE(ENT,U,2)+$PIECE(ENT(ENSTA),U,2)
End DoDot:1
+93 SET ENX=" === ================"
+94 DO BMES^XPDUTL(ENX)
+95 SET ENX=" Grand Total: "
+96 SET ENX=ENX_" Count: "_$JUSTIFY($PIECE(ENT,U),3,0)
+97 SET ENX=ENX_" Value: "_$JUSTIFY("$"_$FNUMBER($PIECE(ENT,U,2),",",2),16)
+98 DO MES^XPDUTL(ENX)
+99 QUIT
+100 ;
XFUND(ENDA,ENFUNDI) ; Change FUND
+1 ; input ENDA - equipment entry
+2 ; ENFUNDI - new fund ien
+3 ; returns 1 if success or 0 if failed
+4 ;
+5 NEW DA,ENBAT,ENDO,ENEQ,ENFA,ENFAP,ENFR,ENX,I
+6 SET ENEQ("DA")=ENDA
+7 SET ENBAT("SILENT")=1
+8 SET ENX=$$CHKFA^ENFAUTL(ENEQ("DA"))
+9 SET ENFA("DA")=$PIECE(ENX,U,4)
+10 FOR I=1,2,3,8,9
SET ENEQ(I)=$GET(^ENG(6914,ENEQ("DA"),I))
+11 ; create FR document to change fund
+12 SET ENDO=1
SET ENFR("DA")=""
+13 DO ADDFR^ENFAXFR
+14 if ENDO
Begin DoDot:1
+15 ; populate FR Document
+16 SET ENFAP(100)=$GET(^ENG(6915.6,ENFR("DA"),100))
+17 ; fund (required)
SET $PIECE(ENFAP(100),U,2)=ENFUNDI
+18 ; a/o (required)
SET $PIECE(ENFAP(100),U,3)=$PIECE(ENEQ(9),U,8)
+19 ; boc (deleted when blank sent)
SET $PIECE(ENFAP(100),U,5)=$PIECE(ENEQ(9),U,6)
+20 ; cmr (determines cost ctr)
SET $PIECE(ENFAP(100),U,6)=$PIECE(ENEQ(2),U,9)
+21 SET ^ENG(6915.6,ENFR("DA"),100)=ENFAP(100)
End DoDot:1
+22 if ENDO
DO CVTDATA^ENFAXFR
+23 if ENDO
Begin DoDot:1
+24 SET ENFAP("DOC")="FR"
DO ^ENFAVAL
+25 IF $DATA(^TMP($JOB,"BAD",ENEQ("DA")))
SET ENDO=0
End DoDot:1
+26 IF 'ENDO
IF $GET(ENFR("DA"))]""
Begin DoDot:1
+27 SET DA=ENFR("DA")
SET DIK="^ENG(6915.6,"
DO ^DIK
KILL DIK
End DoDot:1
+28 if ENDO
DO UPDATE^ENFAXFR
+29 IF $GET(ENFR("DA"))]""
LOCK -^ENG(6915.6,ENFR("DA"))
+30 QUIT ENDO
+31 ;
+32 ;ENXIP57
