source: WorldVistAEHR/trunk/r/QUALITY_ASSURANCE_INTEGRATION-QAQ/QAQAHOC4.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.4 KB
Line 
1QAQAHOC4 ;HISC/DAD-AD HOC REPORTS: MACRO OUTPUT ;12/30/92 11:30
2 ;;1.7;QM Integration Module;**2,5**;07/25/1995
3EN1 ; *** Set the output macro flag
4 S QAQMOUTP=1 W !!?3,"You will be prompted for an output",!?3,"device when you exit the ",QAQTYPE(0)," menu. ",*7
5 R QA:QAQDTIME
6 Q
7EN2 ; *** Print the macro report
8 K %ZIS,IOP S %ZIS="QM",%ZIS("A")=" Output macro to device: " W ! D ^%ZIS G:POP EXIT I $D(IO("Q")) K IO("Q") D QVAR,^%ZTLOAD G EXIT
9ENTSK K QAQUNDL S QAQEXIT=0,$P(QAQUNDL,"_",81)=""
10 U IO W:$E(IOST)="C" @IOF
11 W !?19,"=========================================="
12 W !?19,"|| AD HOC REPORT GENERATOR MACRO REPORT ||"
13 W !?19,"=========================================="
14 W !!!,"Report name: ",$E(QAQUNDL,1,67)
15 W !!,"Sort fields:",!,"------------"
16 W !!,"Macro: ",$S($D(QAQMACRO("S"))#2:$P(QAQMACRO("S"),"^",2),1:$E(QAQUNDL,1,73))
17 F QAQORDER=1:1:QAQMAXOP("S") S QAQFIELD=$O(QAQOPTN("S",QAQORDER,"")),X=$G(QAQOPTN("S",QAQORDER,+QAQFIELD)) D PS
18 D PAUSE G:QAQEXIT EXIT
19 W !!,"Print fields:",!,"-------------"
20 W !!,"Macro: ",$S($D(QAQMACRO("P"))#2:$P(QAQMACRO("P"),"^",2),1:$E(QAQUNDL,1,73))
21 F QAQORDER=1:1:QAQMAXOP("P") S QAQFIELD=$O(QAQOPTN("P",QAQORDER,"")),X=$G(QAQOPTN("P",QAQORDER,+QAQFIELD)) D PP
22 D PAUSE G:QAQEXIT EXIT
23 W !!,"Header: ",$E(QAQUNDL,1,72)
24 W !!,"Device: ",$E(QAQUNDL,1,72)
25 W:$E(IOST)'="C" @IOF
26EXIT ; *** Exit the macro report
27 D ^%ZISC S QAQMOUTP=0
28 S:$D(ZTQUEUED) ZTREQ="@"
29 Q
30PS ; *** Print the macro sort data
31 S X(1)=$P(X,";"),X(1)=$TR(X(1),$TR(X(1),"+-!@'#"))_QAQFIELD_$S($P(X,";")]"":";"_$P(X,";",2,99),1:"")
32 S X(2)=$S($G(FR(QAQORDER))]"":FR(QAQORDER),X(1)]"":"Beginning",1:""),X(3)=$S($G(TO(QAQORDER))]"":TO(QAQORDER),X(1)]"":"Ending",1:"")
33 I $D(QAQMACRO("S")),X(1)]"" D
34 . S QAQD1=0 F QA=$L(X(1),";"):-1:1 D Q:QAQD1
35 .. S QAQD1=$O(^QA(740.1,+QAQMACRO("S"),"FLD","B",$P(X(1),";",1,QA),0))
36 .. Q
37 . I QAQD1 D
38 .. S QA=$G(^QA(740.1,+QAQMACRO("S"),"FLD",QAQD1,0)),QAQ=$G(^("FRTO"))
39 .. S X(1)=$P(QA,"^")
40 .. F QAI=1,2 S X(QAI+1)=$S($P(QA,"^",3):"Ask User",$P(QAQ,"^",QAI)]"":$E($P(QAQ,"^",QAI),1,30),QAI=1:"Beginning",1:"Ending")
41 .. Q
42 . Q
43PS1 ; *** Inquire sort macro entry point
44 S QA=$G(QAQMENU(+QAQFIELD)),QA=$S(QA'>0:"",1:$P(QA,"^",2))
45 W !!?3,QAQORDER,") Field: ",$S(QA]"":QA,QAQFIELD?1.N:"*** CORRUPTED ***",1:$E(QAQUNDL,1,30))
46 F XX=1:1:$L(X(1)) I "'!@#&+-"[$E(X(1)) S X(1)=$E(X(1),2,999)
47 W !?6,"Entry: ",$S(X(1)]"":X(1),1:$E(QAQUNDL,1,30))
48 W !?6,"From: ",$E($S(X(2)]"":X(2),1:QAQUNDL),1,30)
49 W ?46,"To: ",$E($S(X(3)]"":X(3),1:QAQUNDL),1,30)
50 Q
51PP ; *** Print the macro print data
52 S X(1)=$P(X,";"),X(1)=$TR(X(1),$TR(X(1),"&!+#"))_QAQFIELD_$S($P(X,";",2)]"":";"_$P(X,";",2,99),1:"")
53 I $D(QAQMACRO("P")),X(1)]"" D
54 . S QAQD1=0 F QA=$L(X(1),";"):-1:1 D Q:QAQD1
55 .. S QAQD1=$O(^QA(740.1,+QAQMACRO("P"),"FLD","B",$P(X(1),";",1,QA),0))
56 .. Q
57 . I QAQD1 S X(1)=$P($G(^QA(740.1,+QAQMACRO("P"),"FLD",QAQD1,0)),"^")
58 . Q
59PP1 ; *** Inquire print macro entry point
60 S QA=$P($G(QAQMENU(+QAQFIELD)),"^",2)
61 W !!?3,QAQORDER,") Field: ",$S(QA]"":QA,QAQFIELD?1.N:"*** CORRUPTED ***",1:$E(QAQUNDL,1,30))
62 F XX=1:1:$L(X(1)) I "'!@#&+-"[$E(X(1)) S X(1)=$E(X(1),2,999)
63 W !?6,"Entry: ",$S(X(1)]"":X(1),1:$E(QAQUNDL,1,30))
64 Q
65PAUSE ; *** Pause at the end of page
66 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S QAQEXIT=$S(Y'>0:1,1:0)
67 Q
68QVAR ; *** Save variables for queueing
69 S ZTRTN="ENTSK^QAQAHOC4",ZTDESC="Ad Hoc Report Generator Macro Report"
70 F QA="FR","QAQMAXOP(","QAQMENU(","QAQOPTN(","QAQTEMP","QAQMACRO(","TO" S ZTSAVE(QA)=""
71 Q
Note: See TracBrowser for help on using the repository browser.