- 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 Jan 18, 2025@02:54:34 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