ENFACHG ;WASHINGTON IRMFO/KLD/DH/SAB; EQUIPMENT CHANGES; 1/3/97
;;7.0;ENGINEERING;**29,39**;Aug 17, 1993
;This routine should not be modified.
D SETUP
D:ENDO ASKEQ
D:ENDO ADDFC
D:ENDO ASKCS
D:ENDO ASKDATA
K ENAV I ENDO D I $G(ENUT) S ENDO=0 K ENUT
. S ENAV=$$AVP^ENFAAV("6915.4",ENFC("DA"))
. I 'ENAV W !,"Adjustment voucher was NOT created."
D:ENDO ASKOK
D:'ENDO DEL
D:ENDO UPDATE
D WRAPUP
Q
SETUP ;
S ENDO=1
S (ENEQ("DA"),ENFA("DA"),ENFB("DA"),ENFC("DA"),ENFC("BETRMNT"))=""
S:'$D(ENFAP("SITE")) ENFAP("SITE")=+^ENG(6915.1,1,0)
Q
ASKEQ ; ask for equipment item
D GETEQ^ENUTL I Y'>0 S ENDO=0 Q
L +^ENG(6914,+Y):5 I '$T D S ENDO=0 Q
. W !!,"Someone else is editing this Equipment Record."
. W !,"Please try again later."
S ENEQ("DA")=+Y
I '$D(^ENG(6915.2,"B",ENEQ("DA"))) D S ENDO=0 Q
. W !!,"There is no FA document on file for this asset."
. W !,"Nothing to change."
S X=$$CHKFA^ENFAUTL(ENEQ("DA")) I +X=0 D S ENDO=0 Q
. S Y=$P(X,U,3) D DD^%DT
. W !!,"An FD document for ENTRY #",ENEQ("DA")," was processed on ",Y,"."
S ENFA("DA")=$P(X,U,4)
F I=1,2,3,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
Q
ADDFC ; create entry for FC code sheet
S DIC="^ENG(6915.4,",DIC(0)="L",DLAYGO=6915.4
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
. W !!,"Can't update the FC DOCUMENT LOG file. Better contact IRM."
S ENFC("DA")=+Y
L +^ENG(6915.4,+Y):0 I '$T D S ENDO=0 Q
. W !!,"The FC document that you just created is being edited by someone else."
. W !,"Please notify your ADPAC."
Q
ASKCS ; ask for code sheet to change
W !
S DIE="^ENG(6915.4,",DA=ENFC("DA"),DR="[ENFA CHANGE EN]"
D ^DIE I $D(DTOUT) W !!,"Timeout" S ENDO=0 Q
S ENFC("BETRMNT")=$P($G(^ENG(6915.4,ENFC("DA"),3)),U,8)
I ENFC("BETRMNT")="" D S ENDO=0 Q
. W !!,"Document being changed (BETTERMENT NUMBER) must be specified."
Q
ASKDATA ; ask data for FC Document
S DIE="^ENG(6915.4,",DIE("NO^")="BACKOUTOK",DA=ENFC("DA")
S DR="[ENFA CHANGE "_$S(ENFC("BETRMNT")="00":"FA]",1:"FB]")
W ! D ^DIE K DIE("NO^") I $D(DTOUT) W !!,"Timeout" S ENDO=0 Q
;
S ENFAP(100)=$G(^ENG(6915.4,ENFC("DA"),100))
S X=$P(ENFAP(100),U,6) I X]"" S X1=$G(^ENG(6915.4,ENFC("DA"),3)),$P(X1,U,12)=$E(X,1,3)+1700,$P(X1,U,13)=$E(X,4,5),$P(X1,U,14)=$E(X,6,7),^(3)=X1
S X=$P(ENFAP(100),U,7) I X]"" S X1=$G(^ENG(6915.4,ENFC("DA"),4)),$P(X1,U,14)=$E(X,1,3)+1700,$P(X1,U,15)=$E(X,4,5),$P(X1,U,16)=$E(X,6,7),^(4)=X1
I $P(ENFAP(100),U)]"" S ENFAP("CSN")=$$GET1^DIQ(6915.4,ENFC("DA"),100),$P(^ENG(6915.4,ENFC("DA"),3),U,9)=$$GROUP^ENFAVAL(ENFAP("CSN")),$P(^ENG(6915.4,ENFC("DA"),3),U,11)=ENFAP("CSN")
I $P(ENFAP(100),U,2)]"" S ENFAP("CMR")=$$GET1^DIQ(6915.4,ENFC("DA"),101),$P(^ENG(6915.4,ENFC("DA"),3),U,10)=$$LOC^ENFAVAL(ENFAP("CMR"))
F I=0,3,4,6 S ENFAP(I)=$G(^ENG(6915.4,ENFC("DA"),I))
;
S ENFAP("DOC")="FC" K ^TMP($J) D ^ENFAVAL
I $D(^TMP($J)) D LISTP^ENFAXMTM D G:Y ASKDATA S ENDO=0 Q
. S DIR(0)="Y",DIR("A")="Re-edit this change",DIR("B")="YES"
. D ^DIR K DIR
. I 'Y W !!,"Sorry, I must then delete this change!" Q
. ;Initialize derived values
. S X1=$G(^ENG(6915.4,ENFC("DA"),3)),$P(X1,U,9,14)="^^^^^",^(3)=X1
. S X1=$G(^ENG(6915.4,ENFC("DA"),4)),$P(X1,U,14,16)="^^",^(4)=X1
. S ENFAP("CSN")="",ENFAP("CMR")=""
. S Y=1
Q
ASKOK ;
S DIR(0)="Y",DIR("A")="Sure you want to process these changes"
S DIR("B")="YES" D ^DIR K DIR I 'Y!($D(DIRUT)) S ENDO=0
Q
DEL ;
I $G(ENFC("DA"))]"" D
. S DA=ENFC("DA"),DIK="^ENG(6915.4," D ^DIK K DIK
. W !,"FC Document deleted..."
W $C(7),!,"No action taken. Database unchanged."
Q
UPDATE ;
; update modified code sheet
D MCS^ENFACHG1
;update FAP Balance when value entered
I $P(ENFAP(4),U,6)]"" 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(ENFAP(4),U,6)-$P(ENFAP(100),U,4))
W !!,"Updating the Equipment File..." D EQ^ENFACHG1
W !!,"Sending FC document to FAP..." D ^ENFAXMT
I $G(ENAV) D
. S DIE="^ENG(6915.4,",DR="301///NOW",DA=ENFC("DA") D ^DIE
. W !,"Adjustment Voucher was created.",!
Q
WRAPUP ;
I $G(ENEQ("DA"))]"" L -^ENG(6914,ENEQ("DA"))
I $G(ENFC("DA"))]"" L -^ENG(6915.4,ENFC("DA"))
K DA,DIC,DIE,DR,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,X1,Y
K ENAV,ENDO,ENEQ,ENFAP,ENFA,ENFB,ENFC
Q
;ENFACHG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFACHG 4352 printed Dec 13, 2024@01:53:21 Page 2
ENFACHG ;WASHINGTON IRMFO/KLD/DH/SAB; EQUIPMENT CHANGES; 1/3/97
+1 ;;7.0;ENGINEERING;**29,39**;Aug 17, 1993
+2 ;This routine should not be modified.
+3 DO SETUP
+4 if ENDO
DO ASKEQ
+5 if ENDO
DO ADDFC
+6 if ENDO
DO ASKCS
+7 if ENDO
DO ASKDATA
+8 KILL ENAV
IF ENDO
Begin DoDot:1
+9 SET ENAV=$$AVP^ENFAAV("6915.4",ENFC("DA"))
+10 IF 'ENAV
WRITE !,"Adjustment voucher was NOT created."
End DoDot:1
IF $GET(ENUT)
SET ENDO=0
KILL ENUT
+11 if ENDO
DO ASKOK
+12 if 'ENDO
DO DEL
+13 if ENDO
DO UPDATE
+14 DO WRAPUP
+15 QUIT
SETUP ;
+1 SET ENDO=1
+2 SET (ENEQ("DA"),ENFA("DA"),ENFB("DA"),ENFC("DA"),ENFC("BETRMNT"))=""
+3 if '$DATA(ENFAP("SITE"))
SET ENFAP("SITE")=+^ENG(6915.1,1,0)
+4 QUIT
ASKEQ ; ask for equipment item
+1 DO GETEQ^ENUTL
IF Y'>0
SET ENDO=0
QUIT
+2 LOCK +^ENG(6914,+Y):5
IF '$TEST
Begin DoDot:1
+3 WRITE !!,"Someone else is editing this Equipment Record."
+4 WRITE !,"Please try again later."
End DoDot:1
SET ENDO=0
QUIT
+5 SET ENEQ("DA")=+Y
+6 IF '$DATA(^ENG(6915.2,"B",ENEQ("DA")))
Begin DoDot:1
+7 WRITE !!,"There is no FA document on file for this asset."
+8 WRITE !,"Nothing to change."
End DoDot:1
SET ENDO=0
QUIT
+9 SET X=$$CHKFA^ENFAUTL(ENEQ("DA"))
IF +X=0
Begin DoDot:1
+10 SET Y=$PIECE(X,U,3)
DO DD^%DT
+11 WRITE !!,"An FD document for ENTRY #",ENEQ("DA")," was processed on ",Y,"."
End DoDot:1
SET ENDO=0
QUIT
+12 SET ENFA("DA")=$PIECE(X,U,4)
+13 FOR I=1,2,3,8,9
SET ENEQ(I)=$GET(^ENG(6914,ENEQ("DA"),I))
+14 QUIT
ADDFC ; create entry for FC code sheet
+1 SET DIC="^ENG(6915.4,"
SET DIC(0)="L"
SET DLAYGO=6915.4
+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 WRITE !!,"Can't update the FC DOCUMENT LOG file. Better contact IRM."
End DoDot:1
SET ENDO=0
QUIT
+6 SET ENFC("DA")=+Y
+7 LOCK +^ENG(6915.4,+Y):0
IF '$TEST
Begin DoDot:1
+8 WRITE !!,"The FC document that you just created is being edited by someone else."
+9 WRITE !,"Please notify your ADPAC."
End DoDot:1
SET ENDO=0
QUIT
+10 QUIT
ASKCS ; ask for code sheet to change
+1 WRITE !
+2 SET DIE="^ENG(6915.4,"
SET DA=ENFC("DA")
SET DR="[ENFA CHANGE EN]"
+3 DO ^DIE
IF $DATA(DTOUT)
WRITE !!,"Timeout"
SET ENDO=0
QUIT
+4 SET ENFC("BETRMNT")=$PIECE($GET(^ENG(6915.4,ENFC("DA"),3)),U,8)
+5 IF ENFC("BETRMNT")=""
Begin DoDot:1
+6 WRITE !!,"Document being changed (BETTERMENT NUMBER) must be specified."
End DoDot:1
SET ENDO=0
QUIT
+7 QUIT
ASKDATA ; ask data for FC Document
+1 SET DIE="^ENG(6915.4,"
SET DIE("NO^")="BACKOUTOK"
SET DA=ENFC("DA")
+2 SET DR="[ENFA CHANGE "_$SELECT(ENFC("BETRMNT")="00":"FA]",1:"FB]")
+3 WRITE !
DO ^DIE
KILL DIE("NO^")
IF $DATA(DTOUT)
WRITE !!,"Timeout"
SET ENDO=0
QUIT
+4 ;
+5 SET ENFAP(100)=$GET(^ENG(6915.4,ENFC("DA"),100))
+6 SET X=$PIECE(ENFAP(100),U,6)
IF X]""
SET X1=$GET(^ENG(6915.4,ENFC("DA"),3))
SET $PIECE(X1,U,12)=$EXTRACT(X,1,3)+1700
SET $PIECE(X1,U,13)=$EXTRACT(X,4,5)
SET $PIECE(X1,U,14)=$EXTRACT(X,6,7)
SET ^(3)=X1
+7 SET X=$PIECE(ENFAP(100),U,7)
IF X]""
SET X1=$GET(^ENG(6915.4,ENFC("DA"),4))
SET $PIECE(X1,U,14)=$EXTRACT(X,1,3)+1700
SET $PIECE(X1,U,15)=$EXTRACT(X,4,5)
SET $PIECE(X1,U,16)=$EXTRACT(X,6,7)
SET ^(4)=X1
+8 IF $PIECE(ENFAP(100),U)]""
SET ENFAP("CSN")=$$GET1^DIQ(6915.4,ENFC("DA"),100)
SET $PIECE(^ENG(6915.4,ENFC("DA"),3),U,9)=$$GROUP^ENFAVAL(ENFAP("CSN"))
SET $PIECE(^ENG(6915.4,ENFC("DA"),3),U,11)=ENFAP("CSN")
+9 IF $PIECE(ENFAP(100),U,2)]""
SET ENFAP("CMR")=$$GET1^DIQ(6915.4,ENFC("DA"),101)
SET $PIECE(^ENG(6915.4,ENFC("DA"),3),U,10)=$$LOC^ENFAVAL(ENFAP("CMR"))
+10 FOR I=0,3,4,6
SET ENFAP(I)=$GET(^ENG(6915.4,ENFC("DA"),I))
+11 ;
+12 SET ENFAP("DOC")="FC"
KILL ^TMP($JOB)
DO ^ENFAVAL
+13 IF $DATA(^TMP($JOB))
DO LISTP^ENFAXMTM
Begin DoDot:1
+14 SET DIR(0)="Y"
SET DIR("A")="Re-edit this change"
SET DIR("B")="YES"
+15 DO ^DIR
KILL DIR
+16 IF 'Y
WRITE !!,"Sorry, I must then delete this change!"
QUIT
+17 ;Initialize derived values
+18 SET X1=$GET(^ENG(6915.4,ENFC("DA"),3))
SET $PIECE(X1,U,9,14)="^^^^^"
SET ^(3)=X1
+19 SET X1=$GET(^ENG(6915.4,ENFC("DA"),4))
SET $PIECE(X1,U,14,16)="^^"
SET ^(4)=X1
+20 SET ENFAP("CSN")=""
SET ENFAP("CMR")=""
+21 SET Y=1
End DoDot:1
if Y
GOTO ASKDATA
SET ENDO=0
QUIT
+22 QUIT
ASKOK ;
+1 SET DIR(0)="Y"
SET DIR("A")="Sure you want to process these changes"
+2 SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))
SET ENDO=0
+3 QUIT
DEL ;
+1 IF $GET(ENFC("DA"))]""
Begin DoDot:1
+2 SET DA=ENFC("DA")
SET DIK="^ENG(6915.4,"
DO ^DIK
KILL DIK
+3 WRITE !,"FC Document deleted..."
End DoDot:1
+4 WRITE $CHAR(7),!,"No action taken. Database unchanged."
+5 QUIT
UPDATE ;
+1 ; update modified code sheet
+2 DO MCS^ENFACHG1
+3 ;update FAP Balance when value entered
+4 IF $PIECE(ENFAP(4),U,6)]""
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(ENFAP(4),U,6)-$PIECE(ENFAP(100),U,4))
+5 WRITE !!,"Updating the Equipment File..."
DO EQ^ENFACHG1
+6 WRITE !!,"Sending FC document to FAP..."
DO ^ENFAXMT
+7 IF $GET(ENAV)
Begin DoDot:1
+8 SET DIE="^ENG(6915.4,"
SET DR="301///NOW"
SET DA=ENFC("DA")
DO ^DIE
+9 WRITE !,"Adjustment Voucher was created.",!
End DoDot:1
+10 QUIT
WRAPUP ;
+1 IF $GET(ENEQ("DA"))]""
LOCK -^ENG(6914,ENEQ("DA"))
+2 IF $GET(ENFC("DA"))]""
LOCK -^ENG(6915.4,ENFC("DA"))
+3 KILL DA,DIC,DIE,DR,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,X1,Y
+4 KILL ENAV,ENDO,ENEQ,ENFAP,ENFA,ENFB,ENFC
+5 QUIT
+6 ;ENFACHG
