ENFARC1 ;WIRMFO/SAB-FIXED ASSET RPT, TRANSACTION REGISTER (CONT); 5.16.97
;;7.0;ENGINEERING;**39**;Aug 17, 1993
QEN ; queued entry
; in
; ENDTS - start date
; ENDTE - end date
; ENAV - flag, when true then print adjustment voucher data
;
U IO
;
GETDATA ; collect/sort data
; loop thru FAP document file transactions within selected date range
K ^TMP($J) F ENFILE="6915.2","6915.3","6915.4","6915.5","6915.6" D
. S ENDT=ENDTS
. F S ENDT=$O(^ENG(ENFILE,"D",ENDT)) Q:ENDT=""!($P(ENDT,".")>ENDTE) D
. . S ENDA("F?")=0
. . F S ENDA("F?")=$O(^ENG(ENFILE,"D",ENDT,ENDA("F?"))) Q:'ENDA("F?") D
. . . S ^TMP($J,ENDT,ENFILE_";"_ENDA("F?"))=""
;
PRINT ; print
; load table for converting FA Type to SGL
K ENFAPTY S ENDA=0 F S ENDA=$O(^ENG(6914.3,ENDA)) Q:'ENDA D
. S ENX=$G(^ENG(6914.3,ENDA,0))
. I $P(ENX,U,3)]"" S ENFAPTY($P(ENX,U,3))=$P(ENX,U)
;
S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDTR=Y
S ENTAG("HD")="HD^ENFARC1",ENTAG("HDC")="HDC^ENFARC1"
S ENTAG("FT")="FT^ENFARC1"
S ENL="",$P(ENL,"-",IOM)=""
D HD
I '$D(^TMP($J)) W !!,"No activity in selected period",!
; loop thru sorted data
S ENDT="" F S ENDT=$O(^TMP($J,ENDT)) Q:ENDT="" D Q:END
. S ENFAP="" F S ENFAP=$O(^TMP($J,ENDT,ENFAP)) Q:ENFAP="" D Q:END
. . S ENFILE=$P(ENFAP,";"),ENDA("F?")=$P(ENFAP,";",2)
. . S ENY0=$G(^ENG(ENFILE,ENDA("F?"),0))
. . S ENY1=$G(^ENG(ENFILE,ENDA("F?"),1))
. . S ENDA("EQ")=$P($G(^ENG(ENFILE,ENDA("F?"),0)),U)
. . S ENDA("FA")=$$AFA^ENFAR5A(ENFILE,ENDA("F?")) ; associated FA
. . S ENFAY3=$G(^ENG(6915.2,ENDA("FA"),3))
. . S ENSN=$TR($E($P(ENFAY3,U,5),1,5)," ","")
. . S:ENFILE=6915.2 ENFUND=$P(ENFAY3,U,10)
. . S:ENFILE'=6915.2 ENFUND=$$FUND^ENFAR5A(ENFILE,ENDA("F?"),ENDA("FA"))
. . S ENSGL=$S($P(ENFAY3,U,6)]"":$G(ENFAPTY($P(ENFAY3,U,6))),1:"")
. . S ENAMT=0
. . I ENFILE=6915.2 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,27)
. . I ENFILE=6915.3 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,4)
. . I ENFILE=6915.4 S ENX=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,6),ENAMT=$S(ENX="":0,1:ENX-$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,4))
. . I ENFILE=6915.5 S ENAMT="-"_$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,2)
. . I ENFILE=6915.6 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,8)
. . S:ENFILE=6915.2 ENTRC="FA 00"
. . S:ENFILE=6915.3 ENTRC="FB "_$$GET1^DIQ(ENFILE,ENDA("F?"),23)
. . S:ENFILE=6915.4 ENTRC="FC "_$$GET1^DIQ(ENFILE,ENDA("F?"),27)
. . S:ENFILE=6915.5 ENTRC="FD "_$$GET1^DIQ(ENFILE,ENDA("F?"),100,"I")
. . S:ENFILE=6915.6 ENTRC="FR"
. . I $Y+12>IOSL D FT,HD Q:END
. . W !!,?2,ENTRC,?8,$P(ENY1,U,9)
. . W ?20,$TR($$FMTE^XLFDT($P(ENY0,U,2),"2DF")," ",0)
. . W ?30,ENSN,?37,ENFUND,?45,ENSGL
. . I ENFILE=6915.6 D ; check FR doc for FUND change
. . . S ENFUNDNW=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,9)
. . . I ENFUND=ENFUNDNW S ENAMT=0 Q ; fund didn't change
. . . S ENAMT=-ENAMT ; subtract from old fund
. . W ?51,$J($FN(ENAMT,",",2),16)
. . W ?69,$E($P($$GET1^DIQ(ENFILE,ENDA("F?"),1.5),","),1,10)
. . I ENFILE=6915.6,ENFUND'=ENFUNDNW D
. . . ; show addition to new fund
. . . W !,?37,ENFUNDNW,?45,ENSGL
. . . W ?51,$J($FN(-ENAMT,",",2),16)
. . ;
. . W !,?4,"ENTRY #: ",ENDA("EQ")
. . D @("F"_$P(ENFILE,".",2)_"^ENFARC2")
. . I 'END,ENAV,$$GET1^DIQ(ENFILE,ENDA("F?"),301)]"" D
. . . ; print adjustment voucher
. . . I $Y+6>IOSL D FT,HD Q:END D HDC
. . . W !,?4,"AV REASON: ",$E($$GET1^DIQ(ENFILE,ENDA("F?"),303),1,20)
. . . W ?37,"DATE: ",$P($$GET1^DIQ(ENFILE,ENDA("F?"),301),"@")
. . . W ?57,"BY: ",$P($$GET1^DIQ(ENFILE,ENDA("F?"),302),",")
. . . K ^UTILITY($J,"W") S DIWL=5,DIWR=(IOM-5),DIWF="W|"
. . . S X="AV COMMENTS: ",ENI=0
. . . F S ENI=$O(^ENG(ENFILE,ENDA("F?"),301,ENI)) Q:'ENI S X=X_^(ENI,0) D ^DIWP S X="" I $Y+6>IOSL D FT,HD Q:END D HDC
. . . Q:END
. . . D ^DIWW
I 'END D FT I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
WRAPUP ; wrap up
D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
K DIWF,DIWL,DIWR,X,Y
K ^TMP($J),ENAMT,ENAV,END,ENDA,ENDT,ENDTE,ENDTR,ENDTS,ENFAP,ENFAPTY
K ENFAY3,ENFILE,ENFUND,ENFUNDNW,ENI,ENL,ENPG,ENSGL,ENSN,ENTAG,ENTRC
K ENX,ENY,ENY0,ENY1
Q
HD ; page header
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
I $E(IOST,1,2)="C-"!ENPG W @IOF
S ENPG=ENPG+1
S $X=0
W "TRANSACTION REGISTER"
W " FROM ",$$FMTE^XLFDT(ENDTS,"2")," TO ",$$FMTE^XLFDT(ENDTE,"2")
W ?49,ENDTR,?72,"page ",ENPG
W !!,?2,"...... TRANSACTION .......",?30,"STN",?37,"FUND"
W ?45,"SGL",?51,"NET AMOUNT",?69,"SENDER"
W !,?2,"CODE* NUMBER DATE"
W !,?2,"----- ----------- --------",?30,"-----",?37,"------"
W ?45,"----",?51,"----------------",?69,"----------"
Q
HDC ; header for continued transaction
W !,?5,"Transaction: ",$P(ENY1,U,6),"-",$P(ENY1,U,9)," (continued)"
Q
FT ; footer
W !!," * Betterment # follows FB and FC. T (Turn-In) or D (Final Disp.) follows FD."
Q
;ENFARC1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENFARC1 4954 printed Apr 09, 2024@21:01:23 Page 2
ENFARC1 ;WIRMFO/SAB-FIXED ASSET RPT, TRANSACTION REGISTER (CONT); 5.16.97
+1 ;;7.0;ENGINEERING;**39**;Aug 17, 1993
QEN ; queued entry
+1 ; in
+2 ; ENDTS - start date
+3 ; ENDTE - end date
+4 ; ENAV - flag, when true then print adjustment voucher data
+5 ;
+6 USE IO
+7 ;
GETDATA ; collect/sort data
+1 ; loop thru FAP document file transactions within selected date range
+2 KILL ^TMP($JOB)
FOR ENFILE="6915.2","6915.3","6915.4","6915.5","6915.6"
Begin DoDot:1
+3 SET ENDT=ENDTS
+4 FOR
SET ENDT=$ORDER(^ENG(ENFILE,"D",ENDT))
if ENDT=""!($PIECE(ENDT,".")>ENDTE)
QUIT
Begin DoDot:2
+5 SET ENDA("F?")=0
+6 FOR
SET ENDA("F?")=$ORDER(^ENG(ENFILE,"D",ENDT,ENDA("F?")))
if 'ENDA("F?")
QUIT
Begin DoDot:3
+7 SET ^TMP($JOB,ENDT,ENFILE_";"_ENDA("F?"))=""
End DoDot:3
End DoDot:2
End DoDot:1
+8 ;
PRINT ; print
+1 ; load table for converting FA Type to SGL
+2 KILL ENFAPTY
SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6914.3,ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+3 SET ENX=$GET(^ENG(6914.3,ENDA,0))
+4 IF $PIECE(ENX,U,3)]""
SET ENFAPTY($PIECE(ENX,U,3))=$PIECE(ENX,U)
End DoDot:1
+5 ;
+6 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDTR=Y
+7 SET ENTAG("HD")="HD^ENFARC1"
SET ENTAG("HDC")="HDC^ENFARC1"
+8 SET ENTAG("FT")="FT^ENFARC1"
+9 SET ENL=""
SET $PIECE(ENL,"-",IOM)=""
+10 DO HD
+11 IF '$DATA(^TMP($JOB))
WRITE !!,"No activity in selected period",!
+12 ; loop thru sorted data
+13 SET ENDT=""
FOR
SET ENDT=$ORDER(^TMP($JOB,ENDT))
if ENDT=""
QUIT
Begin DoDot:1
+14 SET ENFAP=""
FOR
SET ENFAP=$ORDER(^TMP($JOB,ENDT,ENFAP))
if ENFAP=""
QUIT
Begin DoDot:2
+15 SET ENFILE=$PIECE(ENFAP,";")
SET ENDA("F?")=$PIECE(ENFAP,";",2)
+16 SET ENY0=$GET(^ENG(ENFILE,ENDA("F?"),0))
+17 SET ENY1=$GET(^ENG(ENFILE,ENDA("F?"),1))
+18 SET ENDA("EQ")=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),0)),U)
+19 ; associated FA
SET ENDA("FA")=$$AFA^ENFAR5A(ENFILE,ENDA("F?"))
+20 SET ENFAY3=$GET(^ENG(6915.2,ENDA("FA"),3))
+21 SET ENSN=$TRANSLATE($EXTRACT($PIECE(ENFAY3,U,5),1,5)," ","")
+22 if ENFILE=6915.2
SET ENFUND=$PIECE(ENFAY3,U,10)
+23 if ENFILE'=6915.2
SET ENFUND=$$FUND^ENFAR5A(ENFILE,ENDA("F?"),ENDA("FA"))
+24 SET ENSGL=$SELECT($PIECE(ENFAY3,U,6)]"":$GET(ENFAPTY($PIECE(ENFAY3,U,6))),1:"")
+25 SET ENAMT=0
+26 IF ENFILE=6915.2
SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),3)),U,27)
+27 IF ENFILE=6915.3
SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),4)),U,4)
+28 IF ENFILE=6915.4
SET ENX=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),4)),U,6)
SET ENAMT=$SELECT(ENX="":0,1:ENX-$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,4))
+29 IF ENFILE=6915.5
SET ENAMT="-"_$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,2)
+30 IF ENFILE=6915.6
SET ENAMT=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),100)),U,8)
+31 if ENFILE=6915.2
SET ENTRC="FA 00"
+32 if ENFILE=6915.3
SET ENTRC="FB "_$$GET1^DIQ(ENFILE,ENDA("F?"),23)
+33 if ENFILE=6915.4
SET ENTRC="FC "_$$GET1^DIQ(ENFILE,ENDA("F?"),27)
+34 if ENFILE=6915.5
SET ENTRC="FD "_$$GET1^DIQ(ENFILE,ENDA("F?"),100,"I")
+35 if ENFILE=6915.6
SET ENTRC="FR"
+36 IF $Y+12>IOSL
DO FT
DO HD
if END
QUIT
+37 WRITE !!,?2,ENTRC,?8,$PIECE(ENY1,U,9)
+38 WRITE ?20,$TRANSLATE($$FMTE^XLFDT($PIECE(ENY0,U,2),"2DF")," ",0)
+39 WRITE ?30,ENSN,?37,ENFUND,?45,ENSGL
+40 ; check FR doc for FUND change
IF ENFILE=6915.6
Begin DoDot:3
+41 SET ENFUNDNW=$PIECE($GET(^ENG(ENFILE,ENDA("F?"),3)),U,9)
+42 ; fund didn't change
IF ENFUND=ENFUNDNW
SET ENAMT=0
QUIT
+43 ; subtract from old fund
SET ENAMT=-ENAMT
End DoDot:3
+44 WRITE ?51,$JUSTIFY($FNUMBER(ENAMT,",",2),16)
+45 WRITE ?69,$EXTRACT($PIECE($$GET1^DIQ(ENFILE,ENDA("F?"),1.5),","),1,10)
+46 IF ENFILE=6915.6
IF ENFUND'=ENFUNDNW
Begin DoDot:3
+47 ; show addition to new fund
+48 WRITE !,?37,ENFUNDNW,?45,ENSGL
+49 WRITE ?51,$JUSTIFY($FNUMBER(-ENAMT,",",2),16)
End DoDot:3
+50 ;
+51 WRITE !,?4,"ENTRY #: ",ENDA("EQ")
+52 DO @("F"_$PIECE(ENFILE,".",2)_"^ENFARC2")
+53 IF 'END
IF ENAV
IF $$GET1^DIQ(ENFILE,ENDA("F?"),301)]""
Begin DoDot:3
+54 ; print adjustment voucher
+55 IF $Y+6>IOSL
DO FT
DO HD
if END
QUIT
DO HDC
+56 WRITE !,?4,"AV REASON: ",$EXTRACT($$GET1^DIQ(ENFILE,ENDA("F?"),303),1,20)
+57 WRITE ?37,"DATE: ",$PIECE($$GET1^DIQ(ENFILE,ENDA("F?"),301),"@")
+58 WRITE ?57,"BY: ",$PIECE($$GET1^DIQ(ENFILE,ENDA("F?"),302),",")
+59 KILL ^UTILITY($JOB,"W")
SET DIWL=5
SET DIWR=(IOM-5)
SET DIWF="W|"
+60 SET X="AV COMMENTS: "
SET ENI=0
+61 FOR
SET ENI=$ORDER(^ENG(ENFILE,ENDA("F?"),301,ENI))
if 'ENI
QUIT
SET X=X_^(ENI,0)
DO ^DIWP
SET X=""
IF $Y+6>IOSL
DO FT
DO HD
if END
QUIT
DO HDC
+62 if END
QUIT
+63 DO ^DIWW
End DoDot:3
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+64 IF 'END
DO FT
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRAPUP ; wrap up
+1 DO ^%ZISC
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL DIWF,DIWL,DIWR,X,Y
+4 KILL ^TMP($JOB),ENAMT,ENAV,END,ENDA,ENDT,ENDTE,ENDTR,ENDTS,ENFAP,ENFAPTY
+5 KILL ENFAY3,ENFILE,ENFUND,ENFUNDNW,ENI,ENL,ENPG,ENSGL,ENSN,ENTAG,ENTRC
+6 KILL ENX,ENY,ENY0,ENY1
+7 QUIT
HD ; page header
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET END=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+4 SET ENPG=ENPG+1
+5 SET $X=0
+6 WRITE "TRANSACTION REGISTER"
+7 WRITE " FROM ",$$FMTE^XLFDT(ENDTS,"2")," TO ",$$FMTE^XLFDT(ENDTE,"2")
+8 WRITE ?49,ENDTR,?72,"page ",ENPG
+9 WRITE !!,?2,"...... TRANSACTION .......",?30,"STN",?37,"FUND"
+10 WRITE ?45,"SGL",?51,"NET AMOUNT",?69,"SENDER"
+11 WRITE !,?2,"CODE* NUMBER DATE"
+12 WRITE !,?2,"----- ----------- --------",?30,"-----",?37,"------"
+13 WRITE ?45,"----",?51,"----------------",?69,"----------"
+14 QUIT
HDC ; header for continued transaction
+1 WRITE !,?5,"Transaction: ",$PIECE(ENY1,U,6),"-",$PIECE(ENY1,U,9)," (continued)"
+2 QUIT
FT ; footer
+1 WRITE !!," * Betterment # follows FB and FC. T (Turn-In) or D (Final Disp.) follows FD."
+2 QUIT
+3 ;ENFARC1
