ENFAXFR ;WCIOFO/KLD,SAB; EQUIPMENT TRANSFERS ;11/29/2000
;;7.0;ENGINEERING;**29,33,39,57,60,66**;Aug 17, 1993
;This routine should not be modified.
ST ;
D SETUP
D:ENDO ASKEQ
D:ENDO ADDFR
EDIT D:ENDO ASKDATA
D:ENDO CVTDATA
D:ENDO VALFR I $D(ENREEDIT) K ENREEDIT G EDIT
K ENAV I ENDO D I $G(ENUT) S ENDO=0 K ENUT
. S ENAV=$$AVP^ENFAAV("6915.6",ENFR("DA"))
. I 'ENAV W !,"Adjustment voucher was NOT created."
D:ENDO ASKOK
D:'ENDO DEL
D:ENDO UPDATE
D:ENDO PSEQED
D WRAPUP
Q
SETUP ;
S ENDO=1
S (ENEQ("DA"),ENFA("DA"),ENFR("DA"))=""
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,"."
. W !,"No action taken."
S ENFA("DA")=$P(X,U,4)
F I=1,2,3,8,9 S ENEQ(I)=$G(^ENG(6914,ENEQ("DA"),I))
Q
ADDFR ; create entry for FR code sheet
S DIC="^ENG(6915.6,",DIC(0)="L",DLAYGO=6915.6
S X=ENEQ("DA"),DIC("DR")="1///NOW;1.5////^S X=DUZ"
K DD,DO D FILE^DICN K DIC,DLAYGO
I Y'>0 D S ENDO=0 Q
. I $D(ENBAT("SILENT")) D BAD("Can't add to FR DOCUMENT LOG") Q
. W !!,"Can't update FR document log. Better contact IRM."
S ENFR("DA")=+Y
L +^ENG(6915.6,+Y):0 I '$T D S ENDO=0 Q
. I $D(ENBAT("SILENT")) D BAD("Can't lock FR Document") Q
. W !!,"The FR document that you just created is being edited"
. W !,"by someone else. Please notify IRM."
; populate non-editable fields from FA
S X=$G(^ENG(6915.2,ENFA("DA"),3))
S $P(^ENG(6915.6,ENFR("DA"),3),U,11)=$P(X,U,12) ; owning station
S $P(^ENG(6915.6,ENFR("DA"),3),U,17)=$P(X,U,30) ; satellite station
K X
; save current asset value on FR
S $P(^ENG(6915.6,ENFR("DA"),100),U,8)=$$GET1^DIQ(6914,ENEQ("DA"),12)
Q
ASKDATA ;ask data for FR document
S DIE="^ENG(6915.6,",DA=ENFR("DA"),DR="[ENFA XFR]"
S DIE("NO^")="BACKOUTOK"
W ! D ^DIE K DIE("NO^")
I $D(DTOUT) W !!,"Timeout" S ENDO=0 Q
Q
CVTDATA ; convert user-entered pseudo field data into exported data
S ENFAP(100)=$G(^ENG(6915.6,ENFR("DA"),100))
;
; populate required fields (send even when not changed)
K DR S DR=""
I $P(ENFAP(100),U,2)]"" D
. S DR=";28///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),101)"
I $P(ENFAP(100),U,3)]"" D
. S DR=DR_";29///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),102)"
S:$E(DR)=";" DR=$E(DR,2,200)
I DR]"" S DIE="^ENG(6915.6,",DA=ENFR("DA") D ^DIE
;
S ENFAP("BUDFY")="" ; default budget fiscal year
S X=$P(ENFAP(100),U,2) I X]"" D
. I $$GET1^DIQ(6914.6,X,.01)="4539" S ENFAP("BUDFY")=2000 Q ; EN*7*66
. I $$GET1^DIQ(6914.6,X,2,"I") S ENFAP("BUDFY")=1994 Q ; rev. funds
. I $E($$GET1^DIQ(6914.6,X,.01),1,4)="AMAF" S ENFAP("BUDFY")=1995 Q
. S ENFAP("BUDFY")=$E(DT,1,3)+1700+$E(DT,4)
. ;S ENFAP("BUDFY")=$E($P(ENEQ(2),U,4),1,3)+1700+$E($P(ENEQ(2),U,4),4)
S $P(^ENG(6915.6,ENFR("DA"),3),U,8)=$E(ENFAP("BUDFY"),3,4)
;
S ENACC="000000000" ; default xprogram
;I $P(ENFAP(100),U,4)]"" D ;Get ACC - don't send per Bob Landrum
;. N ENDOCFY,ENY
;. S X="PRC0C" X ^%ZOSF("TEST") D:$T
;. . S ENFAP("STATION")=$P(^ENG(6915.2,ENFA("DA"),3),U,12)
;. . S ENY=$G(^ENG(6915.2,ENFA("DA"),3))
;. . S ENDOCFY=$E($P(ENY,U,16)+$E($P(ENY,U,17)),3,4)
;. . S X=$$ACC^PRC0C(ENFAP("STATION"),$P(ENFAP(100),U,4)_U_ENDOCFY_U_ENFAP("BUDFY"))
;. . I $P(X,U,3)?9AN S ENACC=$P(X,U,3)
S $P(^ENG(6915.6,ENFR("DA"),3),U,12)=ENACC
K ENACC
;
; populate optional fields (recompute cost center when CMR specified)
K DR S DR=""
I $P(ENFAP(100),U,5)]"" S DR=";32///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),104)"
I $P(ENFAP(100),U,6)]"" D
. S ENFAP("CMR")=$E($$GET1^DIQ(6915.6,ENFR("DA"),105),1,5)
. S DR=DR_";37///^S X=ENFAP(""CMR"")"
. S DR=DR_";33///^S X=$$LOC^ENFAVAL(ENFAP(""CMR""))"
. S ENFAP("CC")=$$GET1^DIQ(6914.1,$P(ENFAP(100),U,6),10)
. I ENFAP("CC")]"" S DR=DR_";34///^S X=ENFAP(""CC"")"
S:$E(DR)=";" DR=$E(DR,2,200)
I DR]"" S DIE="^ENG(6915.6,",DA=ENFR("DA") D ^DIE
K DR
;
F I=0,3,100 S ENFAP(I)=^ENG(6915.6,ENFR("DA"),I)
Q
VALFR ; validate FR document
K ENREEDIT
S ENFAP("DOC")="FR" K ^TMP($J) D ^ENFAVAL
I $D(^TMP($J)) D LISTP^ENFAXMTM D
. S DIR(0)="Y",DIR("A")="Re-edit this transaction",DIR("B")="YES"
. D ^DIR K DIR
. I 'Y W !!,"Sorry, I must then delete this FR document!" S ENDO=0 Q
. S ENREEDIT=1
. ; initialize derived values
. S $P(ENFAP(3),U,7,10)="^^^",$P(ENFAP(3),U,12,15)="^^^"
. S $P(ENFAP(3),U,18)=""
. S ^ENG(6915.6,ENFR("DA"),3)=ENFAP(3)
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(ENFR("DA"))]"" D
. S DA=ENFR("DA"),DIK="^ENG(6915.6," D ^DIK K DIK
. W !,"FR Document deleted."
W $C(7),!,"No action taken. Database unchanged."
Q
UPDATE ; update
;update FAP Balance if fund changed
I $P(ENFAP(100),U,2)]"",$P(ENFAP(100),U,2)'=$P(ENEQ(9),U,7) D
. 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)) ; remove from old
. D ADJBAL^ENFABAL($P(ENEQ(9),U,5),$P(ENFAP(100),U,2),$P(ENEQ(8),U,6),$P($P(ENFAP(0),U,2),"."),$P(ENEQ(2),U,3)) ; add to new
W:'$D(ENBAT("SILENT")) !!,"Updating the AEMS/MERS Equipment File."
S ENEQ("XCMR")="" ; initialize CMR changed flag
S DIE="^ENG(6914,",DA=ENEQ("DA"),DR=""
I $P(ENFAP(100),U,2)]"",$P(ENFAP(100),U,2)'=$P(ENEQ(9),U,7) S DR=DR_";62////^S X=$P(ENFAP(100),U,2)"
I $P(ENFAP(100),U,3)]"",$P(ENFAP(100),U,3)'=$P(ENEQ(9),U,8) S DR=DR_";63////^S X=$P(ENFAP(100),U,3)"
I $P(ENFAP(100),U,4)]"",$P(ENFAP(100),U,4)'=$P(ENEQ(8),U,3) S DR=DR_";35////^S X=$P(ENFAP(100),U,4)"
I $P(ENFAP(100),U,5)]"",$P(ENFAP(100),U,5)'=$P(ENEQ(9),U,6) S DR=DR_";61////^S X=$P(ENFAP(100),U,5)"
I $P(ENFAP(100),U,6)]"",$P(ENFAP(100),U,6)'=$P(ENEQ(2),U,9) S DR=DR_";19////^S X=$P(ENFAP(100),U,6)",ENEQ("XCMR")=1
I $E(DR)=";" S DR=$E(DR,2,200)
D ^DIE
; transmit document
W:'$D(ENBAT("SILENT")) !!,"Sending FR document to FAP."
D ^ENFAXMT
; save adjustment voucher
I $G(ENAV) D
. S DIE="^ENG(6915.6,",DR="301///NOW",DA=ENFR("DA") D ^DIE
. W !,"Adjustment Voucher was created.",!
Q
;
PSEQED ; Post FR Equipment Edit (selected fields)
N ENX
S DIE="^ENG(6914,",DA=ENEQ("DA"),DR=""
; edit Service when CMR changes and new CMR's service is different
I $G(ENEQ("XCMR"))]"" D
. S ENX=$$GET1^DIQ(6914,ENEQ("DA"),"19:.5") ; get CMR's service
. Q:ENX="" ; CMR's service not specified
. Q:ENX=$$GET1^DIQ(6914,ENEQ("DA"),21) ; already equals using svc
. ; include in user edit
. S DR=";21USING SERVICE"
. W !!,"This FR Document changed the equipment's CMR value."
. W !,"The service accountable for the new CMR is ",ENX,"."
. W !,"You can update the equipment's Using Service if appropriate."
. W !,"Just press <ENTER> to leave it unchanged."
S:$E(DR)=";" DR=$E(DR,2,999)
I DR]"" W !!,"Editing Equipment ENTRY # ",DA D ^DIE
Q
;
WRAPUP ;
I $G(ENEQ("DA"))]"" L -^ENG(6914,ENEQ("DA"))
I $G(ENFR("DA"))]"" L -^ENG(6915.6,ENFR("DA"))
K DA,DIC,DIE,DR,DIR,I,X,Y
K ENAV,ENDO,ENEQ,ENFAP,ENFA,ENFR
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
;ENFAXFR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAXFR 7584 printed Dec 13, 2024@01:53:51 Page 2
ENFAXFR ;WCIOFO/KLD,SAB; EQUIPMENT TRANSFERS ;11/29/2000
+1 ;;7.0;ENGINEERING;**29,33,39,57,60,66**;Aug 17, 1993
+2 ;This routine should not be modified.
ST ;
+1 DO SETUP
+2 if ENDO
DO ASKEQ
+3 if ENDO
DO ADDFR
EDIT if ENDO
DO ASKDATA
+1 if ENDO
DO CVTDATA
+2 if ENDO
DO VALFR
IF $DATA(ENREEDIT)
KILL ENREEDIT
GOTO EDIT
+3 KILL ENAV
IF ENDO
Begin DoDot:1
+4 SET ENAV=$$AVP^ENFAAV("6915.6",ENFR("DA"))
+5 IF 'ENAV
WRITE !,"Adjustment voucher was NOT created."
End DoDot:1
IF $GET(ENUT)
SET ENDO=0
KILL ENUT
+6 if ENDO
DO ASKOK
+7 if 'ENDO
DO DEL
+8 if ENDO
DO UPDATE
+9 if ENDO
DO PSEQED
+10 DO WRAPUP
+11 QUIT
SETUP ;
+1 SET ENDO=1
+2 SET (ENEQ("DA"),ENFA("DA"),ENFR("DA"))=""
+3 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,"."
+12 WRITE !,"No action taken."
End DoDot:1
SET ENDO=0
QUIT
+13 SET ENFA("DA")=$PIECE(X,U,4)
+14 FOR I=1,2,3,8,9
SET ENEQ(I)=$GET(^ENG(6914,ENEQ("DA"),I))
+15 QUIT
ADDFR ; create entry for FR code sheet
+1 SET DIC="^ENG(6915.6,"
SET DIC(0)="L"
SET DLAYGO=6915.6
+2 SET X=ENEQ("DA")
SET DIC("DR")="1///NOW;1.5////^S X=DUZ"
+3 KILL DD,DO
DO FILE^DICN
KILL DIC,DLAYGO
+4 IF Y'>0
Begin DoDot:1
+5 IF $DATA(ENBAT("SILENT"))
DO BAD("Can't add to FR DOCUMENT LOG")
QUIT
+6 WRITE !!,"Can't update FR document log. Better contact IRM."
End DoDot:1
SET ENDO=0
QUIT
+7 SET ENFR("DA")=+Y
+8 LOCK +^ENG(6915.6,+Y):0
IF '$TEST
Begin DoDot:1
+9 IF $DATA(ENBAT("SILENT"))
DO BAD("Can't lock FR Document")
QUIT
+10 WRITE !!,"The FR document that you just created is being edited"
+11 WRITE !,"by someone else. Please notify IRM."
End DoDot:1
SET ENDO=0
QUIT
+12 ; populate non-editable fields from FA
+13 SET X=$GET(^ENG(6915.2,ENFA("DA"),3))
+14 ; owning station
SET $PIECE(^ENG(6915.6,ENFR("DA"),3),U,11)=$PIECE(X,U,12)
+15 ; satellite station
SET $PIECE(^ENG(6915.6,ENFR("DA"),3),U,17)=$PIECE(X,U,30)
+16 KILL X
+17 ; save current asset value on FR
+18 SET $PIECE(^ENG(6915.6,ENFR("DA"),100),U,8)=$$GET1^DIQ(6914,ENEQ("DA"),12)
+19 QUIT
ASKDATA ;ask data for FR document
+1 SET DIE="^ENG(6915.6,"
SET DA=ENFR("DA")
SET DR="[ENFA XFR]"
+2 SET DIE("NO^")="BACKOUTOK"
+3 WRITE !
DO ^DIE
KILL DIE("NO^")
+4 IF $DATA(DTOUT)
WRITE !!,"Timeout"
SET ENDO=0
QUIT
+5 QUIT
CVTDATA ; convert user-entered pseudo field data into exported data
+1 SET ENFAP(100)=$GET(^ENG(6915.6,ENFR("DA"),100))
+2 ;
+3 ; populate required fields (send even when not changed)
+4 KILL DR
SET DR=""
+5 IF $PIECE(ENFAP(100),U,2)]""
Begin DoDot:1
+6 SET DR=";28///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),101)"
End DoDot:1
+7 IF $PIECE(ENFAP(100),U,3)]""
Begin DoDot:1
+8 SET DR=DR_";29///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),102)"
End DoDot:1
+9 if $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,200)
+10 IF DR]""
SET DIE="^ENG(6915.6,"
SET DA=ENFR("DA")
DO ^DIE
+11 ;
+12 ; default budget fiscal year
SET ENFAP("BUDFY")=""
+13 SET X=$PIECE(ENFAP(100),U,2)
IF X]""
Begin DoDot:1
+14 ; EN*7*66
IF $$GET1^DIQ(6914.6,X,.01)="4539"
SET ENFAP("BUDFY")=2000
QUIT
+15 ; rev. funds
IF $$GET1^DIQ(6914.6,X,2,"I")
SET ENFAP("BUDFY")=1994
QUIT
+16 IF $EXTRACT($$GET1^DIQ(6914.6,X,.01),1,4)="AMAF"
SET ENFAP("BUDFY")=1995
QUIT
+17 SET ENFAP("BUDFY")=$EXTRACT(DT,1,3)+1700+$EXTRACT(DT,4)
+18 ;S ENFAP("BUDFY")=$E($P(ENEQ(2),U,4),1,3)+1700+$E($P(ENEQ(2),U,4),4)
End DoDot:1
+19 SET $PIECE(^ENG(6915.6,ENFR("DA"),3),U,8)=$EXTRACT(ENFAP("BUDFY"),3,4)
+20 ;
+21 ; default xprogram
SET ENACC="000000000"
+22 ;I $P(ENFAP(100),U,4)]"" D ;Get ACC - don't send per Bob Landrum
+23 ;. N ENDOCFY,ENY
+24 ;. S X="PRC0C" X ^%ZOSF("TEST") D:$T
+25 ;. . S ENFAP("STATION")=$P(^ENG(6915.2,ENFA("DA"),3),U,12)
+26 ;. . S ENY=$G(^ENG(6915.2,ENFA("DA"),3))
+27 ;. . S ENDOCFY=$E($P(ENY,U,16)+$E($P(ENY,U,17)),3,4)
+28 ;. . S X=$$ACC^PRC0C(ENFAP("STATION"),$P(ENFAP(100),U,4)_U_ENDOCFY_U_ENFAP("BUDFY"))
+29 ;. . I $P(X,U,3)?9AN S ENACC=$P(X,U,3)
+30 SET $PIECE(^ENG(6915.6,ENFR("DA"),3),U,12)=ENACC
+31 KILL ENACC
+32 ;
+33 ; populate optional fields (recompute cost center when CMR specified)
+34 KILL DR
SET DR=""
+35 IF $PIECE(ENFAP(100),U,5)]""
SET DR=";32///^S X=$$GET1^DIQ(6915.6,ENFR(""DA""),104)"
+36 IF $PIECE(ENFAP(100),U,6)]""
Begin DoDot:1
+37 SET ENFAP("CMR")=$EXTRACT($$GET1^DIQ(6915.6,ENFR("DA"),105),1,5)
+38 SET DR=DR_";37///^S X=ENFAP(""CMR"")"
+39 SET DR=DR_";33///^S X=$$LOC^ENFAVAL(ENFAP(""CMR""))"
+40 SET ENFAP("CC")=$$GET1^DIQ(6914.1,$PIECE(ENFAP(100),U,6),10)
+41 IF ENFAP("CC")]""
SET DR=DR_";34///^S X=ENFAP(""CC"")"
End DoDot:1
+42 if $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,200)
+43 IF DR]""
SET DIE="^ENG(6915.6,"
SET DA=ENFR("DA")
DO ^DIE
+44 KILL DR
+45 ;
+46 FOR I=0,3,100
SET ENFAP(I)=^ENG(6915.6,ENFR("DA"),I)
+47 QUIT
VALFR ; validate FR document
+1 KILL ENREEDIT
+2 SET ENFAP("DOC")="FR"
KILL ^TMP($JOB)
DO ^ENFAVAL
+3 IF $DATA(^TMP($JOB))
DO LISTP^ENFAXMTM
Begin DoDot:1
+4 SET DIR(0)="Y"
SET DIR("A")="Re-edit this transaction"
SET DIR("B")="YES"
+5 DO ^DIR
KILL DIR
+6 IF 'Y
WRITE !!,"Sorry, I must then delete this FR document!"
SET ENDO=0
QUIT
+7 SET ENREEDIT=1
+8 ; initialize derived values
+9 SET $PIECE(ENFAP(3),U,7,10)="^^^"
SET $PIECE(ENFAP(3),U,12,15)="^^^"
+10 SET $PIECE(ENFAP(3),U,18)=""
+11 SET ^ENG(6915.6,ENFR("DA"),3)=ENFAP(3)
End DoDot:1
+12 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
+4 ;
DEL ;
+1 IF $GET(ENFR("DA"))]""
Begin DoDot:1
+2 SET DA=ENFR("DA")
SET DIK="^ENG(6915.6,"
DO ^DIK
KILL DIK
+3 WRITE !,"FR Document deleted."
End DoDot:1
+4 WRITE $CHAR(7),!,"No action taken. Database unchanged."
+5 QUIT
UPDATE ; update
+1 ;update FAP Balance if fund changed
+2 IF $PIECE(ENFAP(100),U,2)]""
IF $PIECE(ENFAP(100),U,2)'=$PIECE(ENEQ(9),U,7)
Begin DoDot:1
+3 ; remove from old
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))
+4 ; add to new
DO ADJBAL^ENFABAL($PIECE(ENEQ(9),U,5),$PIECE(ENFAP(100),U,2),$PIECE(ENEQ(8),U,6),$PIECE($PIECE(ENFAP(0),U,2),"."),$PIECE(ENEQ(2),U,3))
End DoDot:1
+5 if '$DATA(ENBAT("SILENT"))
WRITE !!,"Updating the AEMS/MERS Equipment File."
+6 ; initialize CMR changed flag
SET ENEQ("XCMR")=""
+7 SET DIE="^ENG(6914,"
SET DA=ENEQ("DA")
SET DR=""
+8 IF $PIECE(ENFAP(100),U,2)]""
IF $PIECE(ENFAP(100),U,2)'=$PIECE(ENEQ(9),U,7)
SET DR=DR_";62////^S X=$P(ENFAP(100),U,2)"
+9 IF $PIECE(ENFAP(100),U,3)]""
IF $PIECE(ENFAP(100),U,3)'=$PIECE(ENEQ(9),U,8)
SET DR=DR_";63////^S X=$P(ENFAP(100),U,3)"
+10 IF $PIECE(ENFAP(100),U,4)]""
IF $PIECE(ENFAP(100),U,4)'=$PIECE(ENEQ(8),U,3)
SET DR=DR_";35////^S X=$P(ENFAP(100),U,4)"
+11 IF $PIECE(ENFAP(100),U,5)]""
IF $PIECE(ENFAP(100),U,5)'=$PIECE(ENEQ(9),U,6)
SET DR=DR_";61////^S X=$P(ENFAP(100),U,5)"
+12 IF $PIECE(ENFAP(100),U,6)]""
IF $PIECE(ENFAP(100),U,6)'=$PIECE(ENEQ(2),U,9)
SET DR=DR_";19////^S X=$P(ENFAP(100),U,6)"
SET ENEQ("XCMR")=1
+13 IF $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,200)
+14 DO ^DIE
+15 ; transmit document
+16 if '$DATA(ENBAT("SILENT"))
WRITE !!,"Sending FR document to FAP."
+17 DO ^ENFAXMT
+18 ; save adjustment voucher
+19 IF $GET(ENAV)
Begin DoDot:1
+20 SET DIE="^ENG(6915.6,"
SET DR="301///NOW"
SET DA=ENFR("DA")
DO ^DIE
+21 WRITE !,"Adjustment Voucher was created.",!
End DoDot:1
+22 QUIT
+23 ;
PSEQED ; Post FR Equipment Edit (selected fields)
+1 NEW ENX
+2 SET DIE="^ENG(6914,"
SET DA=ENEQ("DA")
SET DR=""
+3 ; edit Service when CMR changes and new CMR's service is different
+4 IF $GET(ENEQ("XCMR"))]""
Begin DoDot:1
+5 ; get CMR's service
SET ENX=$$GET1^DIQ(6914,ENEQ("DA"),"19:.5")
+6 ; CMR's service not specified
if ENX=""
QUIT
+7 ; already equals using svc
if ENX=$$GET1^DIQ(6914,ENEQ("DA"),21)
QUIT
+8 ; include in user edit
+9 SET DR=";21USING SERVICE"
+10 WRITE !!,"This FR Document changed the equipment's CMR value."
+11 WRITE !,"The service accountable for the new CMR is ",ENX,"."
+12 WRITE !,"You can update the equipment's Using Service if appropriate."
+13 WRITE !,"Just press <ENTER> to leave it unchanged."
End DoDot:1
+14 if $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,999)
+15 IF DR]""
WRITE !!,"Editing Equipment ENTRY # ",DA
DO ^DIE
+16 QUIT
+17 ;
WRAPUP ;
+1 IF $GET(ENEQ("DA"))]""
LOCK -^ENG(6914,ENEQ("DA"))
+2 IF $GET(ENFR("DA"))]""
LOCK -^ENG(6915.6,ENFR("DA"))
+3 KILL DA,DIC,DIE,DR,DIR,I,X,Y
+4 KILL ENAV,ENDO,ENEQ,ENFAP,ENFA,ENFR
+5 QUIT
+6 ;
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 ;ENFAXFR
