- ENFAEIL ;(WIRMFO)/SAB-EDIT CMR AND NATIONAL EIL FILES ;12/17/1998
- ;;7.0;ENGINEERING;**39,60**;AUG 17, 1993
- ;
- EIL ; Enter/Edit National EIL file - called by option ENFA EIL
- W !!,"The National EIL file should only be changed at the direction of"
- W !,"VACO. If the cost center associated with an EIL code is changed"
- W !,"then FR Documents will automatically be generated in order to"
- W !,"update the cost center value in Fixed Assets. A FR Document will"
- W !,"be sent for each equipment item that belongs to a CMR that starts"
- W !,"with the EIL code and is currently established in Fixed Assets."
- EILASK ;
- W !
- S DLAYGO=6914.9
- S DIC="^ENG(6914.9,",DIC(0)="AQELMZ"
- D ^DIC K DLAYGO G:Y'>0 EILX
- S ENEIL("DA")=+Y,ENEIL=$P(Y,U,2),ENEIL("CC",0)=$P(Y(0),U,3)
- ;
- L +^ENG(6914.9,ENEIL("DA")):5 I '$T W $C(7),!,"Another user is editing this EIL. Please try again later." G EILASK
- ;
- S DIE=DIC,DR="1;2",DA=ENEIL("DA") D ^DIE
- ;
- S ENEIL("CC")=$P($G(^ENG(6914.9,ENEIL("DA"),0)),U,3)
- I ENEIL("CC")]"",ENEIL("CC")'=ENEIL("CC",0) D
- . W !,"Since the COST CENTER was changed, FR Documents will be sent"
- . W !,"for appropriate equipment associated with the EIL."
- . ; confirm cost center change
- . S DIR(0)="Y",DIR("A")="Did you really want to change the cost center"
- . D ^DIR K DIR I 'Y D Q
- . . W !,"Restoring the EIL's cost center to it's previous value..."
- . . S DIE="^ENG(6914.9,",DA=ENEIL("DA")
- . . S DR=$S(ENEIL("CC",0)]"":"2///^S X=ENEIL(""CC"",0)",1:"2///@")
- . . D ^DIE K DIE,DR,DA
- . W !,"Generating FR Documents..."
- . K ^TMP($J)
- . S X=$$FREIL(ENEIL)
- . W X," sent."
- . I $D(^TMP($J)) D FRERR K ^TMP($J)
- L -^ENG(6914.9,ENEIL("DA"))
- ;
- G EILASK
- ;
- EILX ;
- K DA,DIC,DIE,DR,DTOUT,X,Y
- K ENEIL
- Q
- ;
- CMR ; Enter/Edit CMR file - called by option ENCMR
- CMRASK ;
- W !
- S DLAYGO=6914.1
- S DIC="^ENG(6914.1,",DIC(0)="AQELMZ"
- D ^DIC K DLAYGO G:Y'>0 CMRX
- S ENCMR("DA")=+Y,ENCMR=$P(Y,U,2)
- S ENCMR("SN",0)=$P($G(^ENG(6914.1,ENCMR("DA"),0)),U,7)
- ;
- L +^ENG(6914.1,ENCMR("DA")):5 I '$T W $C(7),!,"Another user is editing this CMR. Please try again later." G CMRASK
- ;
- S DIE=DIC,DR=".01:99",DA=ENCMR("DA") D ^DIE
- ;
- I $D(^ENG(6914.1,ENCMR("DA"),0)),$E($P(^(0),U),1,5)'=$E(ENCMR,1,5) D
- . W !!,"The first five digits of the CMR name were changed. This change"
- . W !,"affects all equipment records which point to this CMR."
- . W !,"The computer will automatically generate FR Documents for"
- . W !,"appropriate capitalized equipment on this CMR to update Fixed"
- . W !,"Assets (FAP) with the new department and cost center.",!
- . I '$D(^XUSEC("ENFACS",DUZ)) D Q
- . . W !,"Since you do not hold the security key for sending documents"
- . . W !,"to FAP ('ENFACS'), the system can't send FR Documents."
- . . W !,"Therefore, the CMR name can only be changed if none of the"
- . . W !,"equipment on the CMR is reported to FAP."
- . . W !!,"Checking equipment..."
- . . S ENCMR("FAP")=0,ENEQ("DA")=0
- . . F S ENEQ("DA")=$O(^ENG(6914,"AD",ENCMR("DA"),ENEQ("DA"))) Q:'ENEQ("DA") I +$$CHKFA^ENFAUTL(ENEQ("DA")) S ENCMR("FAP")=1 Q
- . . I ENCMR("FAP") D
- . . . W "one or more items are reported to FAP.",$C(7)
- . . . W !,"Sorry, I must restore this CMR to it's previous name."
- . . . S DIE="^ENG(6914.1,",DA=ENCMR("DA"),DR=".01///^S X=ENCMR" D ^DIE
- . . I 'ENCMR("FAP") W "none reported to FAP. Name change accepted."
- . ; confirm name change
- . S DIR(0)="Y",DIR("A")="Did you really want to change the CMR name"
- . D ^DIR K DIR I 'Y D Q
- . . W !,"Restoring CMR to previous name..."
- . . S DIE="^ENG(6914.1,",DA=ENCMR("DA"),DR=".01///^S X=ENCMR" D ^DIE
- . W !,"Generating FR Documents..."
- . K ^TMP($J)
- . S X=$$FRCMR(ENCMR("DA"))
- . W X," sent."
- . I $D(^TMP($J)) D FRERR K ^TMP($J)
- ;
- S ENCMR("SN")=$P($G(^ENG(6914.1,ENCMR("DA"),0)),U,7)
- I ENCMR("SN")]"",ENCMR("SN")'=ENCMR("SN",0) D
- . W !!,"Since a new station number was entered, the computer will"
- . W !,"attempt to update the station numbers of equipment on this CMR."
- . S DA=ENCMR("DA") D CMRSTA^ENFAUTL
- ;
- L -^ENG(6914.1,ENCMR("DA"))
- ;
- G CMRASK
- CMRX ;
- K DA,DIC,DIE,DR,DTOUT,X,Y
- K ENCMR,ENEQ
- Q
- ;
- FREIL(ENEIL) ; Batch Send FR Documents for equipment on EIL
- ; Input
- ; ENEIL - EIL code
- ; Returns number of FR Documents sent
- ; Output
- ; (optional) ^TMP($J,"BAD",equipment ien,line#)=validation problem
- N ENC,ENCMR
- S ENC=0
- ; check format of EIL
- Q:ENEIL'?2E ENC
- ; loop thru CMRs that begin with the EIL
- S ENCMR=ENEIL_$C(9) ; force non-numeric
- F S ENCMR=$O(^ENG(6914.1,"B1",ENCMR)) Q:$E(ENCMR,1,2)'=ENEIL D
- . S ENCMR("DA")=0
- . F S ENCMR("DA")=$O(^ENG(6914.1,"B1",ENCMR,ENCMR("DA"))) Q:'ENCMR("DA") S ENC=ENC+$$FRCMR(ENCMR("DA"))
- Q ENC
- ;
- FRCMR(ENCMRI) ; Batch Send FR Documents for equipment on CMR
- ; This code is used to generate FR Documents without user interaction.
- ; It is called when a batch of FR Documents are being sent due to
- ; a change of CMR name or EIL cost center.
- ; Input
- ; ENCMRI - ien of CMR
- ; Returns number of FR Documents sent
- ; Output
- ; (optional) ^TMP($J,"BAD",equipment ien,line#)=validation problem
- ;
- N ENBAT,ENC,ENDO,ENEQ,ENFA,ENFAP,ENFR,ENX
- ;W !,?5,"CMR: ",$P($G(^ENG(6914.1,ENCMRI,0)),U)
- S ENC=0,ENBAT("SILENT")=1
- ; loop thru equipment on cmr
- S ENEQ("DA")=0
- F S ENEQ("DA")=$O(^ENG(6914,"AD",ENCMRI,ENEQ("DA"))) Q:'ENEQ("DA") D
- . S ENX=$$CHKFA^ENFAUTL(ENEQ("DA"))
- . Q:+ENX=0 ; don't send FR when equipment not reported to FAP
- . ;W !,?10,"ENTRY #: ",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 and send a FR document
- . 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)=$P(ENEQ(9),U,7) ; 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
- . I ENDO D ^ENFAXMT S ENC=ENC+1
- . I $G(ENFR("DA"))]"" L -^ENG(6915.6,ENFR("DA"))
- Q ENC
- ;
- FRERR ; List equipment whose FR failed validation
- ; Input
- ; ^TMP($J,"BAD",equipment ien,line#)=validation problem
- Q:'$D(^TMP($J,"BAD"))
- N ENDA,ENI
- W !!,"FR Documents could not be created for some equipment items."
- S ENDA=0 F S ENDA=$O(^TMP($J,"BAD",ENDA)) Q:'ENDA D
- . W !!,?2,"Equipment Entry #",ENDA,"'s FR Document invalid because"
- . F ENI=1:1 Q:'$D(^TMP($J,"BAD",ENDA,ENI)) W !,?4,^(ENI)
- Q
- ;
- ;ENFAEIL
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAEIL 6839 printed Jan 18, 2025@02:54:44 Page 2
- ENFAEIL ;(WIRMFO)/SAB-EDIT CMR AND NATIONAL EIL FILES ;12/17/1998
- +1 ;;7.0;ENGINEERING;**39,60**;AUG 17, 1993
- +2 ;
- EIL ; Enter/Edit National EIL file - called by option ENFA EIL
- +1 WRITE !!,"The National EIL file should only be changed at the direction of"
- +2 WRITE !,"VACO. If the cost center associated with an EIL code is changed"
- +3 WRITE !,"then FR Documents will automatically be generated in order to"
- +4 WRITE !,"update the cost center value in Fixed Assets. A FR Document will"
- +5 WRITE !,"be sent for each equipment item that belongs to a CMR that starts"
- +6 WRITE !,"with the EIL code and is currently established in Fixed Assets."
- EILASK ;
- +1 WRITE !
- +2 SET DLAYGO=6914.9
- +3 SET DIC="^ENG(6914.9,"
- SET DIC(0)="AQELMZ"
- +4 DO ^DIC
- KILL DLAYGO
- if Y'>0
- GOTO EILX
- +5 SET ENEIL("DA")=+Y
- SET ENEIL=$PIECE(Y,U,2)
- SET ENEIL("CC",0)=$PIECE(Y(0),U,3)
- +6 ;
- +7 LOCK +^ENG(6914.9,ENEIL("DA")):5
- IF '$TEST
- WRITE $CHAR(7),!,"Another user is editing this EIL. Please try again later."
- GOTO EILASK
- +8 ;
- +9 SET DIE=DIC
- SET DR="1;2"
- SET DA=ENEIL("DA")
- DO ^DIE
- +10 ;
- +11 SET ENEIL("CC")=$PIECE($GET(^ENG(6914.9,ENEIL("DA"),0)),U,3)
- +12 IF ENEIL("CC")]""
- IF ENEIL("CC")'=ENEIL("CC",0)
- Begin DoDot:1
- +13 WRITE !,"Since the COST CENTER was changed, FR Documents will be sent"
- +14 WRITE !,"for appropriate equipment associated with the EIL."
- +15 ; confirm cost center change
- +16 SET DIR(0)="Y"
- SET DIR("A")="Did you really want to change the cost center"
- +17 DO ^DIR
- KILL DIR
- IF 'Y
- Begin DoDot:2
- +18 WRITE !,"Restoring the EIL's cost center to it's previous value..."
- +19 SET DIE="^ENG(6914.9,"
- SET DA=ENEIL("DA")
- +20 SET DR=$SELECT(ENEIL("CC",0)]"":"2///^S X=ENEIL(""CC"",0)",1:"2///@")
- +21 DO ^DIE
- KILL DIE,DR,DA
- End DoDot:2
- QUIT
- +22 WRITE !,"Generating FR Documents..."
- +23 KILL ^TMP($JOB)
- +24 SET X=$$FREIL(ENEIL)
- +25 WRITE X," sent."
- +26 IF $DATA(^TMP($JOB))
- DO FRERR
- KILL ^TMP($JOB)
- End DoDot:1
- +27 LOCK -^ENG(6914.9,ENEIL("DA"))
- +28 ;
- +29 GOTO EILASK
- +30 ;
- EILX ;
- +1 KILL DA,DIC,DIE,DR,DTOUT,X,Y
- +2 KILL ENEIL
- +3 QUIT
- +4 ;
- CMR ; Enter/Edit CMR file - called by option ENCMR
- CMRASK ;
- +1 WRITE !
- +2 SET DLAYGO=6914.1
- +3 SET DIC="^ENG(6914.1,"
- SET DIC(0)="AQELMZ"
- +4 DO ^DIC
- KILL DLAYGO
- if Y'>0
- GOTO CMRX
- +5 SET ENCMR("DA")=+Y
- SET ENCMR=$PIECE(Y,U,2)
- +6 SET ENCMR("SN",0)=$PIECE($GET(^ENG(6914.1,ENCMR("DA"),0)),U,7)
- +7 ;
- +8 LOCK +^ENG(6914.1,ENCMR("DA")):5
- IF '$TEST
- WRITE $CHAR(7),!,"Another user is editing this CMR. Please try again later."
- GOTO CMRASK
- +9 ;
- +10 SET DIE=DIC
- SET DR=".01:99"
- SET DA=ENCMR("DA")
- DO ^DIE
- +11 ;
- +12 IF $DATA(^ENG(6914.1,ENCMR("DA"),0))
- IF $EXTRACT($PIECE(^(0),U),1,5)'=$EXTRACT(ENCMR,1,5)
- Begin DoDot:1
- +13 WRITE !!,"The first five digits of the CMR name were changed. This change"
- +14 WRITE !,"affects all equipment records which point to this CMR."
- +15 WRITE !,"The computer will automatically generate FR Documents for"
- +16 WRITE !,"appropriate capitalized equipment on this CMR to update Fixed"
- +17 WRITE !,"Assets (FAP) with the new department and cost center.",!
- +18 IF '$DATA(^XUSEC("ENFACS",DUZ))
- Begin DoDot:2
- +19 WRITE !,"Since you do not hold the security key for sending documents"
- +20 WRITE !,"to FAP ('ENFACS'), the system can't send FR Documents."
- +21 WRITE !,"Therefore, the CMR name can only be changed if none of the"
- +22 WRITE !,"equipment on the CMR is reported to FAP."
- +23 WRITE !!,"Checking equipment..."
- +24 SET ENCMR("FAP")=0
- SET ENEQ("DA")=0
- +25 FOR
- SET ENEQ("DA")=$ORDER(^ENG(6914,"AD",ENCMR("DA"),ENEQ("DA")))
- if 'ENEQ("DA")
- QUIT
- IF +$$CHKFA^ENFAUTL(ENEQ("DA"))
- SET ENCMR("FAP")=1
- QUIT
- +26 IF ENCMR("FAP")
- Begin DoDot:3
- +27 WRITE "one or more items are reported to FAP.",$CHAR(7)
- +28 WRITE !,"Sorry, I must restore this CMR to it's previous name."
- +29 SET DIE="^ENG(6914.1,"
- SET DA=ENCMR("DA")
- SET DR=".01///^S X=ENCMR"
- DO ^DIE
- End DoDot:3
- +30 IF 'ENCMR("FAP")
- WRITE "none reported to FAP. Name change accepted."
- End DoDot:2
- QUIT
- +31 ; confirm name change
- +32 SET DIR(0)="Y"
- SET DIR("A")="Did you really want to change the CMR name"
- +33 DO ^DIR
- KILL DIR
- IF 'Y
- Begin DoDot:2
- +34 WRITE !,"Restoring CMR to previous name..."
- +35 SET DIE="^ENG(6914.1,"
- SET DA=ENCMR("DA")
- SET DR=".01///^S X=ENCMR"
- DO ^DIE
- End DoDot:2
- QUIT
- +36 WRITE !,"Generating FR Documents..."
- +37 KILL ^TMP($JOB)
- +38 SET X=$$FRCMR(ENCMR("DA"))
- +39 WRITE X," sent."
- +40 IF $DATA(^TMP($JOB))
- DO FRERR
- KILL ^TMP($JOB)
- End DoDot:1
- +41 ;
- +42 SET ENCMR("SN")=$PIECE($GET(^ENG(6914.1,ENCMR("DA"),0)),U,7)
- +43 IF ENCMR("SN")]""
- IF ENCMR("SN")'=ENCMR("SN",0)
- Begin DoDot:1
- +44 WRITE !!,"Since a new station number was entered, the computer will"
- +45 WRITE !,"attempt to update the station numbers of equipment on this CMR."
- +46 SET DA=ENCMR("DA")
- DO CMRSTA^ENFAUTL
- End DoDot:1
- +47 ;
- +48 LOCK -^ENG(6914.1,ENCMR("DA"))
- +49 ;
- +50 GOTO CMRASK
- CMRX ;
- +1 KILL DA,DIC,DIE,DR,DTOUT,X,Y
- +2 KILL ENCMR,ENEQ
- +3 QUIT
- +4 ;
- FREIL(ENEIL) ; Batch Send FR Documents for equipment on EIL
- +1 ; Input
- +2 ; ENEIL - EIL code
- +3 ; Returns number of FR Documents sent
- +4 ; Output
- +5 ; (optional) ^TMP($J,"BAD",equipment ien,line#)=validation problem
- +6 NEW ENC,ENCMR
- +7 SET ENC=0
- +8 ; check format of EIL
- +9 if ENEIL'?2E
- QUIT ENC
- +10 ; loop thru CMRs that begin with the EIL
- +11 ; force non-numeric
- SET ENCMR=ENEIL_$CHAR(9)
- +12 FOR
- SET ENCMR=$ORDER(^ENG(6914.1,"B1",ENCMR))
- if $EXTRACT(ENCMR,1,2)'=ENEIL
- QUIT
- Begin DoDot:1
- +13 SET ENCMR("DA")=0
- +14 FOR
- SET ENCMR("DA")=$ORDER(^ENG(6914.1,"B1",ENCMR,ENCMR("DA")))
- if 'ENCMR("DA")
- QUIT
- SET ENC=ENC+$$FRCMR(ENCMR("DA"))
- End DoDot:1
- +15 QUIT ENC
- +16 ;
- FRCMR(ENCMRI) ; Batch Send FR Documents for equipment on CMR
- +1 ; This code is used to generate FR Documents without user interaction.
- +2 ; It is called when a batch of FR Documents are being sent due to
- +3 ; a change of CMR name or EIL cost center.
- +4 ; Input
- +5 ; ENCMRI - ien of CMR
- +6 ; Returns number of FR Documents sent
- +7 ; Output
- +8 ; (optional) ^TMP($J,"BAD",equipment ien,line#)=validation problem
- +9 ;
- +10 NEW ENBAT,ENC,ENDO,ENEQ,ENFA,ENFAP,ENFR,ENX
- +11 ;W !,?5,"CMR: ",$P($G(^ENG(6914.1,ENCMRI,0)),U)
- +12 SET ENC=0
- SET ENBAT("SILENT")=1
- +13 ; loop thru equipment on cmr
- +14 SET ENEQ("DA")=0
- +15 FOR
- SET ENEQ("DA")=$ORDER(^ENG(6914,"AD",ENCMRI,ENEQ("DA")))
- if 'ENEQ("DA")
- QUIT
- Begin DoDot:1
- +16 SET ENX=$$CHKFA^ENFAUTL(ENEQ("DA"))
- +17 ; don't send FR when equipment not reported to FAP
- if +ENX=0
- QUIT
- +18 ;W !,?10,"ENTRY #: ",ENEQ("DA")
- +19 SET ENFA("DA")=$PIECE(ENX,U,4)
- +20 FOR I=1,2,3,8,9
- SET ENEQ(I)=$GET(^ENG(6914,ENEQ("DA"),I))
- +21 ; create and send a FR document
- +22 SET ENDO=1
- SET ENFR("DA")=""
- +23 DO ADDFR^ENFAXFR
- +24 if ENDO
- Begin DoDot:2
- +25 ; populate FR Document
- +26 SET ENFAP(100)=$GET(^ENG(6915.6,ENFR("DA"),100))
- +27 ; fund (required)
- SET $PIECE(ENFAP(100),U,2)=$PIECE(ENEQ(9),U,7)
- +28 ; a/o (required)
- SET $PIECE(ENFAP(100),U,3)=$PIECE(ENEQ(9),U,8)
- +29 ; boc (deleted when blank sent)
- SET $PIECE(ENFAP(100),U,5)=$PIECE(ENEQ(9),U,6)
- +30 ; cmr (determines cost ctr)
- SET $PIECE(ENFAP(100),U,6)=$PIECE(ENEQ(2),U,9)
- +31 SET ^ENG(6915.6,ENFR("DA"),100)=ENFAP(100)
- End DoDot:2
- +32 if ENDO
- DO CVTDATA^ENFAXFR
- +33 if ENDO
- Begin DoDot:2
- +34 SET ENFAP("DOC")="FR"
- DO ^ENFAVAL
- +35 IF $DATA(^TMP($JOB,"BAD",ENEQ("DA")))
- SET ENDO=0
- End DoDot:2
- +36 IF 'ENDO
- IF $GET(ENFR("DA"))]""
- Begin DoDot:2
- +37 SET DA=ENFR("DA")
- SET DIK="^ENG(6915.6,"
- DO ^DIK
- KILL DIK
- End DoDot:2
- +38 IF ENDO
- DO ^ENFAXMT
- SET ENC=ENC+1
- +39 IF $GET(ENFR("DA"))]""
- LOCK -^ENG(6915.6,ENFR("DA"))
- End DoDot:1
- +40 QUIT ENC
- +41 ;
- FRERR ; List equipment whose FR failed validation
- +1 ; Input
- +2 ; ^TMP($J,"BAD",equipment ien,line#)=validation problem
- +3 if '$DATA(^TMP($JOB,"BAD"))
- QUIT
- +4 NEW ENDA,ENI
- +5 WRITE !!,"FR Documents could not be created for some equipment items."
- +6 SET ENDA=0
- FOR
- SET ENDA=$ORDER(^TMP($JOB,"BAD",ENDA))
- if 'ENDA
- QUIT
- Begin DoDot:1
- +7 WRITE !!,?2,"Equipment Entry #",ENDA,"'s FR Document invalid because"
- +8 FOR ENI=1:1
- if '$DATA(^TMP($JOB,"BAD",ENDA,ENI))
- QUIT
- WRITE !,?4,^(ENI)
- End DoDot:1
- +9 QUIT
- +10 ;
- +11 ;ENFAEIL