ENFAXMT3 ;WCIOFO/KLD/DH; TRANSMIT FAP RECORDS ;11/13/2000
;;7.0;ENGINEERING;**29,39,57,66**;Aug 17, 1993
;This routine should not be modified.
;
CSN S X(1)=X(1)_U,ENFA("CSN")=$P(ENFADAT(2),U,8) Q:'ENFA("CSN")
S ENFA("CSN")=$P(^ENCSN(6917,ENFA("CSN"),0),U)
I $E(ENFA("CSN"),1,2)'=70 S X(1)=X(1)_$E(ENFA("CSN"),1,2)_"00" Q
I +ENFA("CSN")'=7020,+ENFA("CSN")'=7021,+ENFA("CSN")'=7025,+ENFA("CSN")'=7035,+ENFA("CSN")'=7040,+ENFA("CSN")'=7050 S X(1)=X(1)_$E(ENFA("CSN"),1,4)
E S X(1)=X(1)_7000
Q
;
FANUM(N) N STATION S STATION=$S(ENFAP("STATION")]"":ENFAP("STATION"),1:ENFAP("SITE")) S STATION=STATION_" ",STATION=$E(STATION,1,5)
S X(N)=X(N)_U_STATION_ENEQ("DA") ;FA Number
I $P(ENEQ(8),U,6),ENFAP("DOC")'="FD" S ENFAP("TY")=$P(^ENG(6914.3,$P(ENEQ(8),U,6),0),U,3)
E S ENFA("DA")=$P($$CHKFA^ENFAUTL(ENEQ("DA")),U,4),ENFAP("TY")=$P(^ENG(6915.2,ENFA("DA"),3),U,6)
S X(N)=X(N)_U_ENFAP("TY") ; FA Type
Q
;
BUDFY(FUND) ;
N ENY
S ENY=$G(^ENG(6914.6,FUND,0))
I $P(ENY,U)="4539" S ENFAP("BUDFY")="2000" G BUDFYX ; franchise EN*7*66
I $P(ENY,U,3) S ENFAP("BUDFY")="1994" G BUDFYX ; revolving fund
I $E($P(ENY,U),1,4)="AMAF" S ENFAP("BUDFY")="1995" G BUDFYX ; amafxx
;S ENFAP("BUDFY")=$E($P(ENEQ(2),U,4),1,3)+1700+$E($P(ENEQ(2),U,4),4)
S ENFAP("BUDFY")=$E(DT,1,3)+1700+$E(DT,4)
BUDFYX ;
S X(1)=X(1)_U_$E(ENFAP("BUDFY"),3,4)
Q
;
XPROG ; append ACC Code to X(1)
; input
; ENFAP("STATION") - station number
; ENFAP("SITE") - station number
; $P(ENEQ(8),U,3) - FCP
; $P(ENEQ(2),U,4) - acquisition date
; ENFAP("BUDFY") - 4 digit beginning budget fiscal year
; output
; X(1)
N ENACC
S ENACC="000000000" ; default value - always send per Bob Landrum
;S X="PRC0C" X ^%ZOSF("TEST") D:$T
;. N ENSN,ENFCP,ENDOCFY,ENX
;. S ENSN=$S(ENFAP("STATION")]"":ENFAP("STATION"),1:ENFAP("SITE"))
;. S ENFCP=$P(ENEQ(8),U,3)
;. S ENDOCFY=$E($E($P(ENEQ(2),U,4),1,3)+$E($P(ENEQ(2),U,4),4),2,3)
;. Q:ENSN=""!(ENFCP="")!(ENDOCFY="")!(ENFAP("BUDFY")="")
;. S ENX=$$ACC^PRC0C(ENSN,ENFCP_U_ENDOCFY_U_ENFAP("BUDFY"))
;. I $P(ENX,U,3)?9AN S ENACC=$P(ENX,U,3)
S X(1)=X(1)_U_ENACC ;Xprog
Q
;
;ENFAXMT3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFAXMT3 2175 printed Oct 16, 2024@17:54:43 Page 2
ENFAXMT3 ;WCIOFO/KLD/DH; TRANSMIT FAP RECORDS ;11/13/2000
+1 ;;7.0;ENGINEERING;**29,39,57,66**;Aug 17, 1993
+2 ;This routine should not be modified.
+3 ;
CSN SET X(1)=X(1)_U
SET ENFA("CSN")=$PIECE(ENFADAT(2),U,8)
if 'ENFA("CSN")
QUIT
+1 SET ENFA("CSN")=$PIECE(^ENCSN(6917,ENFA("CSN"),0),U)
+2 IF $EXTRACT(ENFA("CSN"),1,2)'=70
SET X(1)=X(1)_$EXTRACT(ENFA("CSN"),1,2)_"00"
QUIT
+3 IF +ENFA("CSN")'=7020
IF +ENFA("CSN")'=7021
IF +ENFA("CSN")'=7025
IF +ENFA("CSN")'=7035
IF +ENFA("CSN")'=7040
IF +ENFA("CSN")'=7050
SET X(1)=X(1)_$EXTRACT(ENFA("CSN"),1,4)
+4 IF '$TEST
SET X(1)=X(1)_7000
+5 QUIT
+6 ;
FANUM(N) NEW STATION
SET STATION=$SELECT(ENFAP("STATION")]"":ENFAP("STATION"),1:ENFAP("SITE"))
SET STATION=STATION_" "
SET STATION=$EXTRACT(STATION,1,5)
+1 ;FA Number
SET X(N)=X(N)_U_STATION_ENEQ("DA")
+2 IF $PIECE(ENEQ(8),U,6)
IF ENFAP("DOC")'="FD"
SET ENFAP("TY")=$PIECE(^ENG(6914.3,$PIECE(ENEQ(8),U,6),0),U,3)
+3 IF '$TEST
SET ENFA("DA")=$PIECE($$CHKFA^ENFAUTL(ENEQ("DA")),U,4)
SET ENFAP("TY")=$PIECE(^ENG(6915.2,ENFA("DA"),3),U,6)
+4 ; FA Type
SET X(N)=X(N)_U_ENFAP("TY")
+5 QUIT
+6 ;
BUDFY(FUND) ;
+1 NEW ENY
+2 SET ENY=$GET(^ENG(6914.6,FUND,0))
+3 ; franchise EN*7*66
IF $PIECE(ENY,U)="4539"
SET ENFAP("BUDFY")="2000"
GOTO BUDFYX
+4 ; revolving fund
IF $PIECE(ENY,U,3)
SET ENFAP("BUDFY")="1994"
GOTO BUDFYX
+5 ; amafxx
IF $EXTRACT($PIECE(ENY,U),1,4)="AMAF"
SET ENFAP("BUDFY")="1995"
GOTO BUDFYX
+6 ;S ENFAP("BUDFY")=$E($P(ENEQ(2),U,4),1,3)+1700+$E($P(ENEQ(2),U,4),4)
+7 SET ENFAP("BUDFY")=$EXTRACT(DT,1,3)+1700+$EXTRACT(DT,4)
BUDFYX ;
+1 SET X(1)=X(1)_U_$EXTRACT(ENFAP("BUDFY"),3,4)
+2 QUIT
+3 ;
XPROG ; append ACC Code to X(1)
+1 ; input
+2 ; ENFAP("STATION") - station number
+3 ; ENFAP("SITE") - station number
+4 ; $P(ENEQ(8),U,3) - FCP
+5 ; $P(ENEQ(2),U,4) - acquisition date
+6 ; ENFAP("BUDFY") - 4 digit beginning budget fiscal year
+7 ; output
+8 ; X(1)
+9 NEW ENACC
+10 ; default value - always send per Bob Landrum
SET ENACC="000000000"
+11 ;S X="PRC0C" X ^%ZOSF("TEST") D:$T
+12 ;. N ENSN,ENFCP,ENDOCFY,ENX
+13 ;. S ENSN=$S(ENFAP("STATION")]"":ENFAP("STATION"),1:ENFAP("SITE"))
+14 ;. S ENFCP=$P(ENEQ(8),U,3)
+15 ;. S ENDOCFY=$E($E($P(ENEQ(2),U,4),1,3)+$E($P(ENEQ(2),U,4),4),2,3)
+16 ;. Q:ENSN=""!(ENFCP="")!(ENDOCFY="")!(ENFAP("BUDFY")="")
+17 ;. S ENX=$$ACC^PRC0C(ENSN,ENFCP_U_ENDOCFY_U_ENFAP("BUDFY"))
+18 ;. I $P(ENX,U,3)?9AN S ENACC=$P(ENX,U,3)
+19 ;Xprog
SET X(1)=X(1)_U_ENACC
+20 QUIT
+21 ;
+22 ;ENFAXMT3
