- 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 Feb 18, 2025@23:20:18 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