ENFACHG1 ;WASHINGTON IRMFO/KLD/DH/SAB; EQUIPMENT CHANGES (cont); 7/19/96
;;7.0;ENGINEERING;**29,33**;Aug 17, 1993
Q
MCS ; modified code sheets - called from ENFACHG
; updates 'adjusted' fields on code sheet (FA or FB) being modified
I ENFC("BETRMNT")="00" D ;FC against an FA
. I $P(ENFAP(4),U,6)]"" D ; new value
. . ; get previous value (from adjusted value on FA) and save on FC
. . S $P(^ENG(6915.4,ENFC("DA"),100),U,4)=$P(^ENG(6915.2,ENFA("DA"),200),U,1)
. . ; update adjusted asset value on FA with new value
. . S $P(^ENG(6915.2,ENFA("DA"),200),U,1)=$P(ENFAP(4),U,6)
I ENFC("BETRMNT")>0 D ;FC applied to FB
. I $P(ENFAP(4),U,6)]"" D ; new value
. . ; get previous value (from adjusted value on FB) and save on FC
. . S $P(^ENG(6915.4,ENFC("DA"),100),U,4)=$P(^ENG(6915.3,$P(ENFAP(100),U,5),200),U,1)
. . ; update adjusted asset value on FB with new value
. . S $P(^ENG(6915.3,$P(ENFAP(100),U,5),200),U,1)=$P(ENFAP(4),U,6)
. ; update other 'adjusted' fields on FB
. I $P(ENFAP(3),U,11)]"" S $P(^ENG(6915.3,$P(ENFAP(100),U,5),200),U,2)=$P(ENFAP(3),U,11) ; desc
. I $P(ENFAP(100),U,6)]"" S $P(^ENG(6915.3,$P(ENFAP(100),U,5),200),U,3)=$P(ENFAP(100),U,6) ; acq date
. I $P(ENFAP(3),U,15)]"" S $P(^ENG(6915.3,$P(ENFAP(100),U,5),200),U,4)=$P(ENFAP(3),U,15) ; acq method
; update variables in case data (e.g. previous value) was modified
S ENFAP(100)=$G(^ENG(6915.4,ENFC("DA"),100))
Q
EQ ; update equipment file - called from ENFACHG
N VALUE
S DA=ENEQ("DA"),DIE="^ENG(6914,"
; compute new total asset value (current+new-old)
S:$P(ENFAP(4),U,6)]"" VALUE=$P(ENEQ(2),U,3)+$P(ENFAP(4),U,6)-$P(ENFAP(100),U,4)
FA I ENFC("BETRMNT")="00" D ;FC against an FA
. S DR=""
. I $G(ENFAP("CSN"))]"",$P(ENFAP(100),U)'=$P(ENEQ(2),U,8) S DR="18////^S X=$P(ENFAP(100),U)"
. I $G(ENFAP("CMR"))]"",$P(ENFAP(100),U,2)'=$P(ENEQ(2),U,9) S DR=DR_";19////^S X=$P(ENFAP(100),U,2)"
. S:$P(ENFAP(100),U,6)]"" DR=DR_";13////"_$P(ENFAP(100),U,6)
. S:$P(ENFAP(4),U,3)]"" DR=DR_";15////"_$P(ENFAP(4),U,3)
. S:$P(ENFAP(4),U,6)]"" DR=DR_";12////"_$$DEC^ENFAUTL(VALUE)
. S:$P(ENFAP(3),U,15)]"" DR=DR_";20.1////"_$P(ENFAP(3),U,15)
. S:$P(ENFAP(100),U,7)]"" DR=DR_";16////"_$P(ENFAP(100),U,7)
. S:$E(DR)=";" DR=$E(DR,2,200) D ^DIE
FB I ENFC("BETRMNT")>0 D ;FC applied to FB
. ; compute new total asset value
. I $P(ENFAP(4),U,6)]"" S DR="12////"_$$DEC^ENFAUTL(VALUE) D ^DIE
Q
;
SHOW ;Error in selecting BETERMENT NUMBER
; called from file #6915.3 input template ENFA CHANGE EN
; called from file #6915.3 field #27 executable help
; expects
; X - betterment nummber entered by user
; ENEQ("DA") - ien of equipment entry
; ENFA("DA") - ien of latest FA Document for equipment entry
; ENFC("DA") - ien of FC document being edited
N I,J
;Show the valid choices
W:X'="?" !!,"BETTERMENT NUMBER ",X," invalid for ENTRY #",ENEQ("DA"),"."
W !,"Valid choices are:",!,?5,"00",?10,"Original FA document."
S I="" F S I=$O(^ENG(6915.3,"ABTR",ENEQ("DA"),I)) Q:I="" D
. S J=$O(^ENG(6915.3,"ABTR",ENEQ("DA"),I,0))
. ; screen betterments prior to current FA
. Q:$P($G(^ENG(6915.3,J,0)),U,2)<$P($G(^ENG(6915.2,ENFA("DA"),0)),U,2)
. W !,?5,I,?10,"$"_$P($G(^ENG(6915.3,J,200)),U),?30,$P($G(^(3)),U,8)
; reset the betterment number field
S $P(^ENG(6915.4,ENFC("DA"),3),U,8)=""
Q
;ENFACHG1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFACHG1 3368 printed Nov 22, 2024@17:03:31 Page 2
ENFACHG1 ;WASHINGTON IRMFO/KLD/DH/SAB; EQUIPMENT CHANGES (cont); 7/19/96
+1 ;;7.0;ENGINEERING;**29,33**;Aug 17, 1993
+2 QUIT
MCS ; modified code sheets - called from ENFACHG
+1 ; updates 'adjusted' fields on code sheet (FA or FB) being modified
+2 ;FC against an FA
IF ENFC("BETRMNT")="00"
Begin DoDot:1
+3 ; new value
IF $PIECE(ENFAP(4),U,6)]""
Begin DoDot:2
+4 ; get previous value (from adjusted value on FA) and save on FC
+5 SET $PIECE(^ENG(6915.4,ENFC("DA"),100),U,4)=$PIECE(^ENG(6915.2,ENFA("DA"),200),U,1)
+6 ; update adjusted asset value on FA with new value
+7 SET $PIECE(^ENG(6915.2,ENFA("DA"),200),U,1)=$PIECE(ENFAP(4),U,6)
End DoDot:2
End DoDot:1
+8 ;FC applied to FB
IF ENFC("BETRMNT")>0
Begin DoDot:1
+9 ; new value
IF $PIECE(ENFAP(4),U,6)]""
Begin DoDot:2
+10 ; get previous value (from adjusted value on FB) and save on FC
+11 SET $PIECE(^ENG(6915.4,ENFC("DA"),100),U,4)=$PIECE(^ENG(6915.3,$PIECE(ENFAP(100),U,5),200),U,1)
+12 ; update adjusted asset value on FB with new value
+13 SET $PIECE(^ENG(6915.3,$PIECE(ENFAP(100),U,5),200),U,1)=$PIECE(ENFAP(4),U,6)
End DoDot:2
+14 ; update other 'adjusted' fields on FB
+15 ; desc
IF $PIECE(ENFAP(3),U,11)]""
SET $PIECE(^ENG(6915.3,$PIECE(ENFAP(100),U,5),200),U,2)=$PIECE(ENFAP(3),U,11)
+16 ; acq date
IF $PIECE(ENFAP(100),U,6)]""
SET $PIECE(^ENG(6915.3,$PIECE(ENFAP(100),U,5),200),U,3)=$PIECE(ENFAP(100),U,6)
+17 ; acq method
IF $PIECE(ENFAP(3),U,15)]""
SET $PIECE(^ENG(6915.3,$PIECE(ENFAP(100),U,5),200),U,4)=$PIECE(ENFAP(3),U,15)
End DoDot:1
+18 ; update variables in case data (e.g. previous value) was modified
+19 SET ENFAP(100)=$GET(^ENG(6915.4,ENFC("DA"),100))
+20 QUIT
EQ ; update equipment file - called from ENFACHG
+1 NEW VALUE
+2 SET DA=ENEQ("DA")
SET DIE="^ENG(6914,"
+3 ; compute new total asset value (current+new-old)
+4 if $PIECE(ENFAP(4),U,6)]""
SET VALUE=$PIECE(ENEQ(2),U,3)+$PIECE(ENFAP(4),U,6)-$PIECE(ENFAP(100),U,4)
FA ;FC against an FA
IF ENFC("BETRMNT")="00"
Begin DoDot:1
+1 SET DR=""
+2 IF $GET(ENFAP("CSN"))]""
IF $PIECE(ENFAP(100),U)'=$PIECE(ENEQ(2),U,8)
SET DR="18////^S X=$P(ENFAP(100),U)"
+3 IF $GET(ENFAP("CMR"))]""
IF $PIECE(ENFAP(100),U,2)'=$PIECE(ENEQ(2),U,9)
SET DR=DR_";19////^S X=$P(ENFAP(100),U,2)"
+4 if $PIECE(ENFAP(100),U,6)]""
SET DR=DR_";13////"_$PIECE(ENFAP(100),U,6)
+5 if $PIECE(ENFAP(4),U,3)]""
SET DR=DR_";15////"_$PIECE(ENFAP(4),U,3)
+6 if $PIECE(ENFAP(4),U,6)]""
SET DR=DR_";12////"_$$DEC^ENFAUTL(VALUE)
+7 if $PIECE(ENFAP(3),U,15)]""
SET DR=DR_";20.1////"_$PIECE(ENFAP(3),U,15)
+8 if $PIECE(ENFAP(100),U,7)]""
SET DR=DR_";16////"_$PIECE(ENFAP(100),U,7)
+9 if $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,200)
DO ^DIE
End DoDot:1
FB ;FC applied to FB
IF ENFC("BETRMNT")>0
Begin DoDot:1
+1 ; compute new total asset value
+2 IF $PIECE(ENFAP(4),U,6)]""
SET DR="12////"_$$DEC^ENFAUTL(VALUE)
DO ^DIE
End DoDot:1
+3 QUIT
+4 ;
SHOW ;Error in selecting BETERMENT NUMBER
+1 ; called from file #6915.3 input template ENFA CHANGE EN
+2 ; called from file #6915.3 field #27 executable help
+3 ; expects
+4 ; X - betterment nummber entered by user
+5 ; ENEQ("DA") - ien of equipment entry
+6 ; ENFA("DA") - ien of latest FA Document for equipment entry
+7 ; ENFC("DA") - ien of FC document being edited
+8 NEW I,J
+9 ;Show the valid choices
+10 if X'="?"
WRITE !!,"BETTERMENT NUMBER ",X," invalid for ENTRY #",ENEQ("DA"),"."
+11 WRITE !,"Valid choices are:",!,?5,"00",?10,"Original FA document."
+12 SET I=""
FOR
SET I=$ORDER(^ENG(6915.3,"ABTR",ENEQ("DA"),I))
if I=""
QUIT
Begin DoDot:1
+13 SET J=$ORDER(^ENG(6915.3,"ABTR",ENEQ("DA"),I,0))
+14 ; screen betterments prior to current FA
+15 if $PIECE($GET(^ENG(6915.3,J,0)),U,2)<$PIECE($GET(^ENG(6915.2,ENFA("DA"),0)),U,2)
QUIT
+16 WRITE !,?5,I,?10,"$"_$PIECE($GET(^ENG(6915.3,J,200)),U),?30,$PIECE($GET(^(3)),U,8)
End DoDot:1
+17 ; reset the betterment number field
+18 SET $PIECE(^ENG(6915.4,ENFC("DA"),3),U,8)=""
+19 QUIT
+20 ;ENFACHG1
