source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFARA1.m@ 1078

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

initial load of WorldVistAEHR
File size: 6.3 KB
RevLine 
[613]1ENFARA1 ;WIRMFO/SAB-FIXED ASSET RPT, ADJUSTMENT VOUCHER (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 ; ENSRT("U") - true if sort by user
8 ; if ENSRT("U") true
9 ; ENSRT("U",0) - DUZ of selected user or * for all
10 ; ENSRT("U",0,"E") - external value for ENSRT("U",0)
11 U IO
12GETDATA ; collect/sort data
13 S ENUSR="*"
14 ; loop thru FAP document file transactions within selected date range
15 K ^TMP($J) F ENFILE="6915.2","6915.3","6915.4","6915.5","6915.6" D
16 . S ENDT=ENDTS
17 . ;***F S ENDT=$O(^ENG(ENFILE,"AV",ENDT)) Q:ENDT=""!(ENDT>ENDTE) D
18 . F S ENDT=$O(^ENG(ENFILE,"AV",ENDT)) Q:ENDT=""!($P(ENDT,".")>ENDTE) D
19 . . S ENDA("F?")=0
20 . . F S ENDA("F?")=$O(^ENG(ENFILE,"AV",ENDT,ENDA("F?"))) Q:'ENDA("F?") D
21 . . . I ENSRT("U") S ENUSR=$$GET1^DIQ(ENFILE,ENDA("F?"),302,"I")
22 . . . I ENSRT("U"),ENSRT("U",0)'="*",ENUSR'=ENSRT("U",0) Q
23 . . . S ^TMP($J,ENUSR,ENDT,ENFILE_";"_ENDA("F?"))=""
24PRINT ; print
25 ; load table for converting FA Type to SGL
26 K ENFAPTY S ENDA=0 F S ENDA=$O(^ENG(6914.3,ENDA)) Q:'ENDA D
27 . S ENY0=$G(^ENG(6914.3,ENDA,0))
28 . I $P(ENY0,U,3)]"" S ENFAPTY($P(ENY0,U,3))=$P(ENY0,U)
29 ;
30 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDTR=Y
31 S ENL="",$P(ENL,"-",IOM)=""
32 I '$D(^TMP($J)) D HD W !!,"No activity in selected period",!
33 S ENUSR="" F S ENUSR=$O(^TMP($J,ENUSR)) Q:ENUSR="" D Q:END
34 . S ENUSR("E")=$S('ENSRT("U"):"",1:$$GET1^DIQ(200,ENUSR,.01))
35 . K ENT
36 . D HD Q:END
37 . S ENDT="" F S ENDT=$O(^TMP($J,ENUSR,ENDT)) Q:ENDT="" D Q:END
38 . . S ENY="" F S ENY=$O(^TMP($J,ENUSR,ENDT,ENY)) Q:ENY="" D Q:END
39 . . . S ENFILE=$P(ENY,";"),ENDA("F?")=$P(ENY,";",2)
40 . . . S ENY0=$G(^ENG(ENFILE,ENDA("F?"),0))
41 . . . S ENY1=$G(^ENG(ENFILE,ENDA("F?"),1))
42 . . . S ENDA=$P($G(^ENG(ENFILE,ENDA("F?"),0)),U)
43 . . . S ENDA("FA")=$$AFA^ENFAR5A(ENFILE,ENDA("F?")) ; associated FA
44 . . . S ENFAY3=$G(^ENG(6915.2,ENDA("FA"),3))
45 . . . S ENSN=$TR($E($P(ENFAY3,U,5),1,5)," ","")
46 . . . S:ENFILE=6915.2 ENFUND=$P(ENFAY3,U,10)
47 . . . S:ENFILE'=6915.2 ENFUND=$$FUND^ENFAR5A(ENFILE,ENDA("F?"),ENDA("FA"))
48 . . . S ENSGL=$S($P(ENFAY3,U,6)]"":$G(ENFAPTY($P(ENFAY3,U,6))),1:"")
49 . . . S ENAMT=0
50 . . . I ENFILE=6915.2 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),3)),U,27)
51 . . . I ENFILE=6915.3 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),4)),U,4)
52 . . . 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))
53 . . . I ENFILE=6915.5 S ENAMT="-"_$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,2)
54 . . . I ENFILE=6915.6 S ENAMT=$P($G(^ENG(ENFILE,ENDA("F?"),100)),U,8)
55 . . . I $Y+8>IOSL D HD Q:END
56 . . . W !,$E($TR($$FMTE^XLFDT(ENDT,"2F")," ",0),1,14)
57 . . . W ?16,$P(ENY1,U,6),?22,$P(ENY1,U,9)
58 . . . W ?34,$TR($$FMTE^XLFDT($P(ENY0,U,2),"2DF")," ",0)
59 . . . W ?44,ENSN,?51,ENFUND,?58,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 ?63,$J($FN(ENAMT,",",2),16)
65 . . . S ENT(ENSN,ENFUND,ENSGL)=$G(ENT(ENSN,ENFUND,ENSGL))+ENAMT
66 . . . I ENFILE=6915.6,ENFUND'=ENFUNDNW D
67 . . . . ; show addition to new fund
68 . . . . W !,?44,ENSN,?51,ENFUNDNW,?58,ENSGL
69 . . . . W ?63,$J($FN(-ENAMT,",",2),16)
70 . . . . S ENT(ENSN,ENFUNDNW,ENSGL)=$G(ENT(ENSN,ENFUNDNW,ENSGL))-ENAMT
71 . . . ;
72 . . . W !,?4,"EQUIP #: ",ENDA,?26,$$GET1^DIQ(6914,ENDA,3)
73 . . . W !,?4,"P.O. #: ",$P($G(^ENG(6914,ENDA,2)),U,2)
74 . . . W ?26,"A.V. REASON: ",$$GET1^DIQ(ENFILE,ENDA("F?"),303)
75 . . . K ^UTILITY($J,"W") S DIWL=5,DIWR=(IOM-5),DIWF="W|"
76 . . . S X="COMMENTS: ",ENI=0
77 . . . 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 HD Q:END D HDAV
78 . . . Q:END
79 . . . D ^DIWW
80 . Q:END
81 . I $Y+10>IOSL D HD Q:END
82 . W !,?30,"TOTALS:"
83 . S ENTU=0 ; initialize user/grand total
84 . S ENSN="" F S ENSN=$O(ENT(ENSN)) Q:ENSN="" D Q:END
85 . . S ENTS="0" ; initialize station totals
86 . . S ENFUND="" F S ENFUND=$O(ENT(ENSN,ENFUND)) Q:ENFUND="" D Q:END
87 . . . S ENTF="0" ; initialize fund totals
88 . . . S ENSGL=""
89 . . . F S ENSGL=$O(ENT(ENSN,ENFUND,ENSGL)) Q:ENSGL="" D Q:END
90 . . . . I $Y+6>IOSL D HD Q:END W !,?30,"TOTALS: (continued)"
91 . . . . W !,?44,ENSN,?51,ENFUND,?58,ENSGL
92 . . . . W ?63,$J($FN($P(ENT(ENSN,ENFUND,ENSGL),U),",",2),16)
93 . . . . S $P(ENTF,U)=$P(ENTF,U)+$P(ENT(ENSN,ENFUND,ENSGL),U)
94 . . . Q:END
95 . . . S $P(ENTS,U)=$P(ENTS,U)+$P(ENTF,U)
96 . . . I $Y+6>IOSL D HD Q:END W !,?30,"TOTALS: (continued)"
97 . . . W !,?63,"----------------"
98 . . . W !,?44,ENSN,?51,ENFUND,?58,"TOTAL",?63,$J($FN($P(ENTF,U),",",2),16),!
99 . . Q:END
100 . . S $P(ENTU,U)=$P(ENTU,U)+$P(ENTS,U)
101 . . I $Y+6>IOSL D HD Q:END W !,?30,"TOTALS: (continued)"
102 . . W !,?63,"----------------"
103 . . W !,?44,ENSN,?50,"TOTAL",?63,$J($FN($P(ENTS,U),",",2),16),!
104 . Q:END
105 . I $Y+6>IOSL D HD Q:END W !,?30,"TOTALS: (continued)"
106 . W !,?63,"================"
107 . W !,?44,$S(ENSRT("U"):"USER",1:"GRAND")," TOTAL"
108 . W ?63,$J($FN($P(ENTU,U),",",2),16),!
109 . D FT
110 I 'END,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
111WRAPUP ; wrap up
112 D ^%ZISC
113 I $D(ZTQUEUED) S ZTREQ="@"
114 K DIWF,DIWL,DIWR,X,Y
115 K ^TMP($J),ENAMT,END,ENDA,ENDT,ENDTE,ENDTR,ENDTS,ENFAPTY,ENFAY3
116 K ENFILE,ENFUND,ENFUNDNW,ENI,ENIEN,ENL,ENPG,ENSGL,ENSN,ENSRT,ENUSR
117 K ENT,ENTS,ENTF,ENTU,ENX,ENY,ENY0,ENY1
118 Q
119HD ; page header
120 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,END=1 Q
121 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
122 I $E(IOST,1,2)="C-"!ENPG W @IOF
123 S ENPG=ENPG+1
124 S $X=0
125 W "ADJUSTMENT VOUCHERS",?49,ENDTR,?72,"page ",ENPG
126 W !,?2,"FROM ",$$FMTE^XLFDT(ENDTS,"2")," TO ",$$FMTE^XLFDT(ENDTE,"2")
127 I ENSRT("U") D
128 . W " (SORT BY USER FOR ",ENSRT("U",0,"E"),")"
129 . I ENSRT("U",0)="*",$G(ENUSR("E"))]"" W !,"A.V.s By: ",ENUSR("E")
130 W !!,"ADJ. VOUCHER",?16,"...... TRANSACTION .......",?44,"STN"
131 W ?51,"FUND",?58,"SGL",?63,"NET AMOUNT"
132 W !,"DATE/TIME",?16,"CODE NUMBER DATE"
133 W !,"--------------",?16,"----- ----------- --------",?44,"-----"
134 W ?51,"------",?58,"----",?63,"----------------"
135 Q
136HDAV ; header for continued adjustment voucher
137 W !,?4,"Transaction: ",$P(ENY1,U,6),"-",$P(ENY1,U,9),"(continued)"
138 Q
139FT ; report footer when hardcopy
140 Q:$E(IOST,1,2)="C-"!'ENPG
141 W !!!,?4,"-------------------- --------"
142 W ?44,"-------------------- --------"
143 W !,?4,"ACCOUNTABLE OFFICER DATE"
144 W ?44,"APPROVING OFFICIAL DATE"
145 Q
146 ;ENFARA1
Note: See TracBrowser for help on using the repository browser.