source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXAPRO1.m@ 701

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1ECXAPRO1 ;ALB/JAP - PRO Extract Audit Report (cont) ; Nov 16, 1998
2 ;;3.0;DSS EXTRACTS;**9,21**;Dec 22, 1997
3 ;
4DISP ;entry point
5 N DIC,DA,DR,DIRUT,DTOUT,DUOUT,JJ,SS,LN,PG,QFLG,STN,TYPE
6 N A1,A2,A3,CA,CB,CC,GCA,GCB,GCC,GRP,GRPHEAD,LINE,LINEP
7 U IO
8 S (QFLG,PG)=0,$P(LN,"-",80)=""
9 F TYPE="N","R" S STN="",STN=$O(^TMP($J,TYPE,STN)) D Q:QFLG
10 .D HEADER
11 .D CDATA Q:QFLG
12 I $E(IOST)'="C" D
13 .W @IOF S PG=PG+1
14 .W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
15 .W !,"DSS Extract Log #: "_ECXEXT
16 .W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
17 .W !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
18 .W !!,LN,!!
19 .S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ
20 .W @IOF
21 I $D(IO(0)) I IO(0)'=IO D ^%ZISC
22 D HOME^%ZIS
23 Q
24 ;
25CDATA ;accummulate data within each nppd group
26 S (LINE,LINEP)=""
27 S (GCA,GCB,GCC)=0
28 S (CA,CB,CC)=0
29 I '$D(^TMP($J,TYPE)) D Q
30 .W !,?26,"No data available.",!
31 .I $E(IOST)="C",'QFLG D
32 ..S SS=22-$Y F JJ=1:1:SS W !
33 ..S DIR(0)="E" D ^DIR K DIR
34 F S LINE=$O(^TMP($J,TYPE,STN,LINE)) Q:LINE="" D Q:QFLG
35 .S GRP=$E(LINE,1,3) D Q:QFLG
36 ..I TYPE="R",GRP["R9" S GRP="R90"
37 ..S GRPHEAD=^TMP($J,"RMPRCODE",GRP)
38 ..I LINEP="" D
39 ...D:($Y+5>IOSL) HEADER Q:QFLG
40 ...W !,GRPHEAD
41 .I $E(LINE,0,3)'=$E(LINEP,0,3),LINEP'="" D Q:QFLG
42 ..D:($Y+5>IOSL) HEADER Q:QFLG
43 ..W !,LN,!
44 ..W ?26,$J(CA,5,0),?34,$J(CB,5,0),?42,$J((CA+CB),5,0),?51,$J(CC,7,0),!
45 ..S (CA,CB,CC)=0
46 ..D:($Y+5>IOSL) HEADER Q:QFLG
47 ..W:LINE'["R99" !,GRPHEAD
48 .D:($Y+3>IOSL) HEADER Q:QFLG
49 .W !,LINE,?6,$E($P(^TMP($J,TYPE,STN,LINE),U,15),1,15)
50 .S A1=+$P(^TMP($J,TYPE,STN,LINE),U,1),A2=+$P(^(LINE),U,2),A3=+$P(^(LINE),U,3)
51 .W ?26,$J(A1,5,0) S CA=CA+A1,GCA=GCA+A1
52 .W ?34,$J(A2,5,0) S CB=CB+A2,GCB=GCB+A2
53 .W ?42,$J(A1+A2,5,0)
54 .W ?51,$J(A3,7,0) S CC=CC+A3,GCC=GCC+A3
55 .W:A2>0 ?61,$J(A3/A2,6,0)
56 .S LINEP=LINE
57 Q:QFLG
58 D SUM
59 Q
60 ;
61SUM ;print summary for type
62 D:($Y+7>IOSL) HEADER Q:QFLG
63 W:TYPE="N" !!!,"STATION SUMMARY (NEW)"
64 W:TYPE="R" !!!,"STATION SUMMARY (REPAIR)"
65 W !,?28,"VA",?36,"Com",?44,"Total",?54,"Cost ($)"
66 W !,LN
67 W !,?26,$J(GCA,5,0),?34,$J(GCB,5,0),?42,$J((GCA+GCB),5,0),?51,$J(GCC,7,0)
68 W !,LN
69 Q
70 ;
71HEADER ;header and page control
72 I $E(IOST)="C" D
73 .S SS=20-$Y F JJ=1:1:SS W !
74 .I PG>0 S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1
75 Q:QFLG
76 W:$Y!($E(IOST)="C") @IOF S PG=PG+1
77 W ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report",?64,"Page "_PG
78 W !,"DSS Extract Log #: "_ECXEXT
79 W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
80 W !,"Station (#): "_$P(ECXDIV,U,2)_" ("_$P(ECXDIV,U,3)_")"
81 W !,"Report Run Date/Time: "_ECXRUN
82 W:TYPE="N" !!,"REPORT OF NEW PROSTHETICS ACTIVITIES"
83 W:TYPE="R" !!,"REPORT OF REPAIR PROSTHETICS ACTIVITIES"
84 W !,"Line",?6,"Item",?28,"VA",?36,"Com",?44,"Total",?54,"Cost ($)",?64,"Ave Com ($)"
85 W !,LN,!
86 Q
87 ;
88CODE ;setup nppd codes
89 ;intended to duplicate code^rmprn63
90 N NULINE
91 F I=1:1 S NULINE=$P($T(TEXT+I^ECXAPRO3),";;",2) Q:NULINE["QUIT" D
92 .I $L($P(NULINE,";",1))>3,STN]"" D
93 ..I $E(NULINE,0,1)'="R" S:$D(^TMP($J,"N",STN,$P(NULINE,";",1))) $P(^TMP($J,"N",STN,$P(NULINE,";",1)),U,15)=$P(NULINE,";",2)
94 ..I $E(NULINE,0,1)="R" S:$D(^TMP($J,"R",STN,$P(NULINE,";",1))) $P(^TMP($J,"R",STN,$P(NULINE,";",1)),U,15)=$P(NULINE,";",2)
95 .S ^TMP($J,"RMPRCODE",$P(NULINE,";",1))=$P(NULINE,";",2)
96 Q
Note: See TracBrowser for help on using the repository browser.