ENFAACQ ;WASHINGTON IRMFO/SAB; EQUIPMENT ACQUISITION; 1/3/97
;;7.0;ENGINEERING;**29,39**;Aug 17, 1993
;This routine should not be modified.
;called from routines ENEQ1, ENEQ2, ENEQ3, ENFADEL and ENFAXMTM
; Input
; ENEQ("DA") - equipment entry #
; should already be locked (if appropriate)
; must not already have an active FA Document on file
; ENBAT("SILENT") - (optional) $D true for silent batch processing
; ENBAT("SEL") - (optional) $D true for batch (by CMR or Station)
; Output
; ^TMP($J,"BAD",ENEQ("DA"), - validation problems (if any)
; only returned when $D(ENBAT("SILENT"))
D SETUP
D:ENDO VALEQ
D:ENDO ADDFA
K ENAV I ENDO,'$D(ENBAT("SEL")) D I $G(ENUT) S ENDO=0 K ENUT
. S ENAV=$$AVP^ENFAAV("6915.2",ENFA("DA"))
. I 'ENAV W !,"Adjustment voucher was NOT created."
D:'ENDO DEL
D:ENDO UPDATE
D WRAPUP
Q
SETUP ;
S ENDO=1
S ENFA("DA")=""
S ENFAP("DOC")="FA"
F I=0:1:3,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
S:'$D(ENFAP("SITE")) ENFAP("SITE")=+^ENG(6915.1,1,0)
Q
VALEQ ; validate equipment
K ^TMP($J,"BAD",ENEQ("DA"))
D ^ENFAVAL
I $D(^TMP($J,"BAD",ENEQ("DA"))) D:'$D(ENBAT("SILENT")) LISTP^ENFAXMTM S ENDO=0 Q
Q
ADDFA ; create entry for FA code sheet
S DIC="^ENG(6915.2,",DIC(0)="L",DLAYGO=6915.2
S X=ENEQ("DA"),DIC("DR")="1///NOW;1.5////^S X=DUZ"
K DD,DO D FILE^DICN K DLAYGO
I Y'>0 D S ENDO=0 Q
. I $D(ENBAT("SILENT")) D BAD("Can't add to FA DOCUMENT LOG") Q
. W !!,"Can't update the FA DOCUMENT LOG file. Better contact IRM."
S ENFA("DA")=+Y
L +^ENG(6915.2,+Y):0 I '$T D S ENDO=0 Q
. I $D(ENBAT("SILENT")) D BAD("Can't lock FA Document") Q
. W !!,"The FA document that you just created can not be locked."
. W !,"Please notify your ADPAC."
S ENFAP(0)=$G(^ENG(6915.2,ENFA("DA"),0))
Q
DEL ;
I $G(ENFA("DA"))]"" D
. S DA=ENFA("DA"),DIK="^ENG(6915.2," D ^DIK K DIK
. W:'$D(ENBAT("SILENT")) !,"FA Document deleted..."
I '$D(ENBAT("SILENT")) D
. W $C(7),!,"No action taken. Database unchanged."
. S DIR(0)="E" D ^DIR K DIR
Q
UPDATE ;
; update equipment file
; populate station number field when blank
I $P(ENEQ(9),U,5)="" D
. S $P(^ENG(6914,ENEQ("DA"),9),U,5)=ENFAP("SITE")
. S $P(ENEQ(9),U,5)=ENFAP("SITE")
; make sure value contains 2 decimals
I $P(ENEQ(2),U,3)'?1.12N1"."2N D
. S $P(ENEQ(2),U,3)=$$DEC^ENFAUTL($P(ENEQ(2),U,3))
. S $P(^ENG(6914,ENEQ("DA"),2),U,3)=$P(ENEQ(2),U,3)
; if acquisition day not specified use 01
I $E($P(ENEQ(2),U,4),6,7)="00" D
. S $P(ENEQ(2),U,4)=$E($P(ENEQ(2),U,4),1,5)_"01"
. S $P(^ENG(6914,ENEQ("DA"),2),U,4)=$P(ENEQ(2),U,4)
; if replacement day not specified use 01
I $E($P(ENEQ(2),U,10),6,7)="00" D
. S $P(ENEQ(2),U,10)=$E($P(ENEQ(2),U,10),1,5)_"01"
. S $P(^ENG(6914,ENEQ("DA"),2),U,10)=$P(ENEQ(2),U,10)
; save current value in adjusted value field on code sheet
S ^ENG(6915.2,ENFA("DA"),200)=$P(ENEQ(2),U,3)
; update FAP Balance
D ADJBAL^ENFABAL($P(ENEQ(9),U,5),$P(ENEQ(9),U,7),$P(ENEQ(8),U,6),$P($P(ENFAP(0),U,2),"."),$P(ENEQ(2),U,3))
; transmit code sheet
W:'$D(ENBAT("SILENT")) !!,"Sending FA document to FAP..."
D ^ENFAXMT
; save adjustment voucher
I $G(ENAV) D
. S DIE="^ENG(6915.2,",DR="301///NOW",DA=ENFA("DA") D ^DIE
. W !,"Adjustment Voucher was created.",!
Q
WRAPUP ;
I $G(ENFA("DA"))]"" L -^ENG(6915.2,ENFA("DA"))
F I=0:1:3,8,9 K ENEQ(I)
K ENAV,ENDO,ENFAP,ENFA
K DA,DIC,DIE,DR,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y
Q
BAD(X) ; add text to validation problem list
N I
S I=$P($G(^TMP($J,"BAD",ENEQ("DA"))),U)+1
S ^TMP($J,"BAD",ENEQ("DA"),I)=X
S ^TMP($J,"BAD",ENEQ("DA"))=I
Q
;ENFAACQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAACQ 3709 printed Dec 13, 2024@01:53:15 Page 2
ENFAACQ ;WASHINGTON IRMFO/SAB; EQUIPMENT ACQUISITION; 1/3/97
+1 ;;7.0;ENGINEERING;**29,39**;Aug 17, 1993
+2 ;This routine should not be modified.
+3 ;called from routines ENEQ1, ENEQ2, ENEQ3, ENFADEL and ENFAXMTM
+4 ; Input
+5 ; ENEQ("DA") - equipment entry #
+6 ; should already be locked (if appropriate)
+7 ; must not already have an active FA Document on file
+8 ; ENBAT("SILENT") - (optional) $D true for silent batch processing
+9 ; ENBAT("SEL") - (optional) $D true for batch (by CMR or Station)
+10 ; Output
+11 ; ^TMP($J,"BAD",ENEQ("DA"), - validation problems (if any)
+12 ; only returned when $D(ENBAT("SILENT"))
+13 DO SETUP
+14 if ENDO
DO VALEQ
+15 if ENDO
DO ADDFA
+16 KILL ENAV
IF ENDO
IF '$DATA(ENBAT("SEL"))
Begin DoDot:1
+17 SET ENAV=$$AVP^ENFAAV("6915.2",ENFA("DA"))
+18 IF 'ENAV
WRITE !,"Adjustment voucher was NOT created."
End DoDot:1
IF $GET(ENUT)
SET ENDO=0
KILL ENUT
+19 if 'ENDO
DO DEL
+20 if ENDO
DO UPDATE
+21 DO WRAPUP
+22 QUIT
SETUP ;
+1 SET ENDO=1
+2 SET ENFA("DA")=""
+3 SET ENFAP("DOC")="FA"
+4 FOR I=0:1:3,8,9
SET ENEQ(I)=$GET(^ENG(6914,ENEQ("DA"),I))
+5 if '$DATA(ENFAP("SITE"))
SET ENFAP("SITE")=+^ENG(6915.1,1,0)
+6 QUIT
VALEQ ; validate equipment
+1 KILL ^TMP($JOB,"BAD",ENEQ("DA"))
+2 DO ^ENFAVAL
+3 IF $DATA(^TMP($JOB,"BAD",ENEQ("DA")))
if '$DATA(ENBAT("SILENT"))
DO LISTP^ENFAXMTM
SET ENDO=0
QUIT
+4 QUIT
ADDFA ; create entry for FA code sheet
+1 SET DIC="^ENG(6915.2,"
SET DIC(0)="L"
SET DLAYGO=6915.2
+2 SET X=ENEQ("DA")
SET DIC("DR")="1///NOW;1.5////^S X=DUZ"
+3 KILL DD,DO
DO FILE^DICN
KILL DLAYGO
+4 IF Y'>0
Begin DoDot:1
+5 IF $DATA(ENBAT("SILENT"))
DO BAD("Can't add to FA DOCUMENT LOG")
QUIT
+6 WRITE !!,"Can't update the FA DOCUMENT LOG file. Better contact IRM."
End DoDot:1
SET ENDO=0
QUIT
+7 SET ENFA("DA")=+Y
+8 LOCK +^ENG(6915.2,+Y):0
IF '$TEST
Begin DoDot:1
+9 IF $DATA(ENBAT("SILENT"))
DO BAD("Can't lock FA Document")
QUIT
+10 WRITE !!,"The FA document that you just created can not be locked."
+11 WRITE !,"Please notify your ADPAC."
End DoDot:1
SET ENDO=0
QUIT
+12 SET ENFAP(0)=$GET(^ENG(6915.2,ENFA("DA"),0))
+13 QUIT
DEL ;
+1 IF $GET(ENFA("DA"))]""
Begin DoDot:1
+2 SET DA=ENFA("DA")
SET DIK="^ENG(6915.2,"
DO ^DIK
KILL DIK
+3 if '$DATA(ENBAT("SILENT"))
WRITE !,"FA Document deleted..."
End DoDot:1
+4 IF '$DATA(ENBAT("SILENT"))
Begin DoDot:1
+5 WRITE $CHAR(7),!,"No action taken. Database unchanged."
+6 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+7 QUIT
UPDATE ;
+1 ; update equipment file
+2 ; populate station number field when blank
+3 IF $PIECE(ENEQ(9),U,5)=""
Begin DoDot:1
+4 SET $PIECE(^ENG(6914,ENEQ("DA"),9),U,5)=ENFAP("SITE")
+5 SET $PIECE(ENEQ(9),U,5)=ENFAP("SITE")
End DoDot:1
+6 ; make sure value contains 2 decimals
+7 IF $PIECE(ENEQ(2),U,3)'?1.12N1"."2N
Begin DoDot:1
+8 SET $PIECE(ENEQ(2),U,3)=$$DEC^ENFAUTL($PIECE(ENEQ(2),U,3))
+9 SET $PIECE(^ENG(6914,ENEQ("DA"),2),U,3)=$PIECE(ENEQ(2),U,3)
End DoDot:1
+10 ; if acquisition day not specified use 01
+11 IF $EXTRACT($PIECE(ENEQ(2),U,4),6,7)="00"
Begin DoDot:1
+12 SET $PIECE(ENEQ(2),U,4)=$EXTRACT($PIECE(ENEQ(2),U,4),1,5)_"01"
+13 SET $PIECE(^ENG(6914,ENEQ("DA"),2),U,4)=$PIECE(ENEQ(2),U,4)
End DoDot:1
+14 ; if replacement day not specified use 01
+15 IF $EXTRACT($PIECE(ENEQ(2),U,10),6,7)="00"
Begin DoDot:1
+16 SET $PIECE(ENEQ(2),U,10)=$EXTRACT($PIECE(ENEQ(2),U,10),1,5)_"01"
+17 SET $PIECE(^ENG(6914,ENEQ("DA"),2),U,10)=$PIECE(ENEQ(2),U,10)
End DoDot:1
+18 ; save current value in adjusted value field on code sheet
+19 SET ^ENG(6915.2,ENFA("DA"),200)=$PIECE(ENEQ(2),U,3)
+20 ; update FAP Balance
+21 DO ADJBAL^ENFABAL($PIECE(ENEQ(9),U,5),$PIECE(ENEQ(9),U,7),$PIECE(ENEQ(8),U,6),$PIECE($PIECE(ENFAP(0),U,2),"."),$PIECE(ENEQ(2),U,3))
+22 ; transmit code sheet
+23 if '$DATA(ENBAT("SILENT"))
WRITE !!,"Sending FA document to FAP..."
+24 DO ^ENFAXMT
+25 ; save adjustment voucher
+26 IF $GET(ENAV)
Begin DoDot:1
+27 SET DIE="^ENG(6915.2,"
SET DR="301///NOW"
SET DA=ENFA("DA")
DO ^DIE
+28 WRITE !,"Adjustment Voucher was created.",!
End DoDot:1
+29 QUIT
WRAPUP ;
+1 IF $GET(ENFA("DA"))]""
LOCK -^ENG(6915.2,ENFA("DA"))
+2 FOR I=0:1:3,8,9
KILL ENEQ(I)
+3 KILL ENAV,ENDO,ENFAP,ENFA
+4 KILL DA,DIC,DIE,DR,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y
+5 QUIT
BAD(X) ; add text to validation problem list
+1 NEW I
+2 SET I=$PIECE($GET(^TMP($JOB,"BAD",ENEQ("DA"))),U)+1
+3 SET ^TMP($JOB,"BAD",ENEQ("DA"),I)=X
+4 SET ^TMP($JOB,"BAD",ENEQ("DA"))=I
+5 QUIT
+6 ;ENFAACQ
