source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFARC1.m@ 702

Last change on this file since 702 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1ENFARC1 ;WIRMFO/SAB-FIXED ASSET RPT, TRANSACTION REGISTER (CONT); 5.16.97
2 ;;7.0;ENGINEERING;**39**;Aug 17, 1993
3QEN ; queued entry
4 ; in
5 ; ENDTS - start date
6 ; ENDTE - end date
7 ; ENAV - flag, when true then print adjustment voucher data
8 ;
9 U IO
10 ;
11GETDATA ; collect/sort data
12 ; loop thru FAP document file transactions within selected date range
13 K ^TMP($J) F ENFILE="6915.2","6915.3","6915.4","6915.5","6915.6" D
14 . S ENDT=ENDTS
15 . F S ENDT=$O(^ENG(ENFILE,"D",ENDT)) Q:ENDT=""!($P(ENDT,".")>ENDTE) D
16 . . S ENDA("F?")=0
17 . . F S ENDA("F?")=$O(^ENG(ENFILE,"D",ENDT,ENDA("F?"))) Q:'ENDA("F?") D
18 . . . S ^TMP($J,ENDT,ENFILE_";"_ENDA("F?"))=""
19 ;
20PRINT ; print
21 ; load table for converting FA Type to SGL
22 K ENFAPTY S ENDA=0 F S ENDA=$O(^ENG(6914.3,ENDA)) Q:'ENDA D
23 . S ENX=$G(^ENG(6914.3,ENDA,0))
24 . I $P(ENX,U,3)]"" S ENFAPTY($P(ENX,U,3))=$P(ENX,U)
25 ;
26 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDTR=Y
27 S ENTAG("HD")="HD^ENFARC1",ENTAG("HDC")="HDC^ENFARC1"
28 S ENTAG("FT")="FT^ENFARC1"
29 S ENL="",$P(ENL,"-",IOM)=""
30 D HD
31 I '$D(^TMP($J)) W !!,"No activity in selected period",!
32 ; loop thru sorted data
33 S ENDT="" F S ENDT=$O(^TMP($J,ENDT)) Q:ENDT="" D Q:END
34 . S ENFAP="" F S ENFAP=$O(^TMP($J,ENDT,ENFAP)) Q:ENFAP="" D Q:END
35 . . S ENFILE=$P(ENFAP,";"),ENDA("F?")=$P(ENFAP,";",2)
36 . . S ENY0=$G(^ENG(ENFILE,ENDA("F?"),0))
37 . . S ENY1=$G(^ENG(ENFILE,ENDA("F?"),1))
38 . . S ENDA("EQ")=$P($G(^ENG(ENFILE,ENDA("F?"),0)),U)
39 . . S ENDA("FA")=$$AFA^ENFAR5A(ENFILE,ENDA("F?")) ; associated FA
40 . . S ENFAY3=$G(^ENG(6915.2,ENDA("FA"),3))
41 . . S ENSN=$TR($E($P(ENFAY3,U,5),1,5)," ","")
42 . . S:ENFILE=6915.2 ENFUND=$P(ENFAY3,U,10)
43 . . S:ENFILE'=6915.2 ENFUND=$$FUND^ENFAR5A(ENFILE,ENDA("F?"),ENDA("FA"))
44 . . S ENSGL=$S($P(ENFAY3,U,6)]"":$G(ENFAPTY($P(ENFAY3,U,6))),1:"")
45 . . S ENAMT=0
46 . . I ENFILE=6915.2 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,27)
47 . . I ENFILE=6915.3 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,4)
48 . . 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))
49 . . I ENFILE=6915.5 S ENAMT="-"_$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,2)
50 . . I ENFILE=6915.6 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,8)
51 . . S:ENFILE=6915.2 ENTRC="FA 00"
52 . . S:ENFILE=6915.3 ENTRC="FB "_$$GET1^DIQ(ENFILE,ENDA("F?"),23)
53 . . S:ENFILE=6915.4 ENTRC="FC "_$$GET1^DIQ(ENFILE,ENDA("F?"),27)
54 . . S:ENFILE=6915.5 ENTRC="FD "_$$GET1^DIQ(ENFILE,ENDA("F?"),100,"I")
55 . . S:ENFILE=6915.6 ENTRC="FR"
56 . . I $Y+12>IOSL D FT,HD Q:END
57 . . W !!,?2,ENTRC,?8,$P(ENY1,U,9)
58 . . W ?20,$TR($$FMTE^XLFDT($P(ENY0,U,2),"2DF")," ",0)
59 . . W ?30,ENSN,?37,ENFUND,?45,ENSGL
60 . . I ENFILE=6915.6 D ; check FR doc for FUND change
61 . . . S ENFUNDNW=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,9)
62 . . . I ENFUND=ENFUNDNW S ENAMT=0 Q ; fund didn't change
63 . . . S ENAMT=-ENAMT ; subtract from old fund
64 . . W ?51,$J($FN(ENAMT,",",2),16)
65 . . W ?69,$E($P($$GET1^DIQ(ENFILE,ENDA("F?"),1.5),","),1,10)
66 . . I ENFILE=6915.6,ENFUND'=ENFUNDNW D
67 . . . ; show addition to new fund
68 . . . W !,?37,ENFUNDNW,?45,ENSGL
69 . . . W ?51,$J($FN(-ENAMT,",",2),16)
70 . . ;
71 . . W !,?4,"ENTRY #: ",ENDA("EQ")
72 . . D @("F"_$P(ENFILE,".",2)_"^ENFARC2")
73 . . I 'END,ENAV,$$GET1^DIQ(ENFILE,ENDA("F?"),301)]"" D
74 . . . ; print adjustment voucher
75 . . . I $Y+6>IOSL D FT,HD Q:END D HDC
76 . . . W !,?4,"AV REASON: ",$E($$GET1^DIQ(ENFILE,ENDA("F?"),303),1,20)
77 . . . W ?37,"DATE: ",$P($$GET1^DIQ(ENFILE,ENDA("F?"),301),"@")
78 . . . W ?57,"BY: ",$P($$GET1^DIQ(ENFILE,ENDA("F?"),302),",")
79 . . . K ^UTILITY($J,"W") S DIWL=5,DIWR=(IOM-5),DIWF="W|"
80 . . . S X="AV COMMENTS: ",ENI=0
81 . . . 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
82 . . . Q:END
83 . . . D ^DIWW
84 I 'END D FT I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
85WRAPUP ; wrap up
86 D ^%ZISC
87 I $D(ZTQUEUED) S ZTREQ="@"
88 K DIWF,DIWL,DIWR,X,Y
89 K ^TMP($J),ENAMT,ENAV,END,ENDA,ENDT,ENDTE,ENDTR,ENDTS,ENFAP,ENFAPTY
90 K ENFAY3,ENFILE,ENFUND,ENFUNDNW,ENI,ENL,ENPG,ENSGL,ENSN,ENTAG,ENTRC
91 K ENX,ENY,ENY0,ENY1
92 Q
93HD ; page header
94 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
95 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
96 I $E(IOST,1,2)="C-"!ENPG W @IOF
97 S ENPG=ENPG+1
98 S $X=0
99 W "TRANSACTION REGISTER"
100 W " FROM ",$$FMTE^XLFDT(ENDTS,"2")," TO ",$$FMTE^XLFDT(ENDTE,"2")
101 W ?49,ENDTR,?72,"page ",ENPG
102 W !!,?2,"...... TRANSACTION .......",?30,"STN",?37,"FUND"
103 W ?45,"SGL",?51,"NET AMOUNT",?69,"SENDER"
104 W !,?2,"CODE* NUMBER DATE"
105 W !,?2,"----- ----------- --------",?30,"-----",?37,"------"
106 W ?45,"----",?51,"----------------",?69,"----------"
107 Q
108HDC ; header for continued transaction
109 W !,?5,"Transaction: ",$P(ENY1,U,6),"-",$P(ENY1,U,9)," (continued)"
110 Q
111FT ; footer
112 W !!," * Betterment # follows FB and FC. T (Turn-In) or D (Final Disp.) follows FD."
113 Q
114 ;ENFARC1
Note: See TracBrowser for help on using the repository browser.