source: WorldVistAEHR/trunk/r/QUALITY_ASSURANCE_INTEGRATION-QAQ/QAQAHOC0.m@ 1211

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1QAQAHOC0 ;HISC/DAD-AD HOC REPORTS: MAIN DRIVER ;7/12/95 14:53
2 ;;1.7;QM Integration Module;**1**;07/25/1995
3 ;
4 ;Required / Optional Variables
5 ;
6 ; QAQDIC = File NUMBER of the file to print from.
7 ; QAQMRTN = Entry point to setup the QAQMENU array (Format TAG^ROUTINE)
8 ; QAQORTN = Entry point to set up other FileMan EN1^DIP variables, i.e.
9 ; DCOPIES, DHD, DHIT, DIOBEG, DIOEND, DIS(), IOP, PG optional
10 ; QAQMHDR = Text to be used as the header at the top of the sort/print
11 ; menu screens. Header appears as === QAQMHDR Ad Hoc Report
12 ; Generator ===. Set QAQMHDR = @ to suppress the header.
13 ; Maximum of 45 characters.
14 ;
15 ;Menu Array Format (Set up by D @QAQMRTN)
16 ;
17 ; QAQMENU() = Sort ^ Menu text ^ ~Field # ^ DIR(0)
18 ; Sort = 1 - Allow sorting, 0 - Don't allow sorting.
19 ; Menu text = Menu text as it will appear to the user (Max 30 char).
20 ; ~Field # = Any valid EN1^DIP BY/FLDS string. The ~ is replaced by
21 ; the sort/print prefixes entered by the user or null.
22 ; Any ;"TEXT" appended to the BY/FLDS string should be
23 ; in the last ';' piece of the string.
24 ; DIR(0) = The DIR(0) string used when the user is prompted for a
25 ; from/to range on the sort. DIR(0) should have a third
26 ; '^' piece (input transform) that always returns the
27 ; external form of the data or -1 in the variable Y.
28 ;
29 G:$S($D(QAQDIC)[0:1,QAQDIC'>0:1,$D(^DIC(QAQDIC,0))[0:1,$D(QAQMRTN)[0:1,QAQMRTN="":1,1:0) EXIT I $D(QAQORTN)#2,QAQORTN="" G EXIT
30 D XIT,HOME^%ZIS,@QAQMRTN K QAQMENU(0)
31 S (QAQMMAX,QAQCHKSM,QAQSORT)=0 F QA=0:0 S QA=$O(QAQMENU(QA)) Q:QA'>0 D
32 . S QAQMMAX=QAQMMAX+1,QAQCHKSM(0)=0,X=QAQMENU(QA) S:X QAQSORT=QAQSORT+1
33 . F QAI=1:1:$L(X) S QAQCHKSM(0)=$A(X,QAI)*QAI+QAQCHKSM(0)
34 . S QAQCHKSM=QAQCHKSM(0)*QA+QAQCHKSM
35 . Q
36 G:(QAQMMAX'>0)!(QAQSORT'>0) EXIT
37 S QAQBLURB="Enter numeric 1 to "_QAQMMAX_", <RETURN> to end, ^ to exit"
38 S QAQYESNO="Please answer Y(es) or N(o).",QAQDTIME=10,(BY,FLDS)=""
39 S QAQMAXOP("S")=4,QAQMAXOP("P")=7,(QAQNUMOP("S"),QAQNUMOP("P"),QAQQUIT,QAQNEXT)=0
40 ;
41SORT S QAQTYPE="S",QAQTYPE(0)="sort",QAQTYPE(1)="Sort",(QAQMLOAD,QAQMOUTP,QAQMSAVE)=0 K QAQCHOSN F QAQSEQ=1:1 D ENASK^QAQAHOC1 Q:QAQNEXT
42 S QAQNUMOP("S")=QAQSEQ-1 G EXIT:QAQQUIT,PRNT:QAQMLOAD D:QAQMSAVE SAVE^QAQAHOC3
43PRNT D:QAQMOUTP EN2^QAQAHOC4
44 S QAQTYPE="P",QAQTYPE(0)="print",QAQTYPE(1)="Print",(QAQMLOAD,QAQMOUTP,QAQMSAVE)=0 K QAQCHOSN F QAQSEQ=1:1 D ENASK^QAQAHOC1 Q:QAQNEXT
45 S QAQNUMOP("P")=QAQSEQ-1 G EXIT:QAQQUIT,OTHER:QAQMLOAD D:QAQMSAVE SAVE^QAQAHOC3
46OTHER ; *** Execute OTHER entry point in the Ad Hoc interface routine
47 D:QAQMOUTP EN2^QAQAHOC4
48 K DHD,PG,DHIT,DIOEND,DIOBEG,DCOPIES,IOP,DIS
49 I $D(QAQORTN)#2 S QAQQUIT=0 D @QAQORTN G:QAQQUIT EXIT
50DHD ; *** Prompt user for report header
51 G:$D(DHD)#2 BYFLDS
52 K DIR S DIR(0)="FAO^0:60^D DHDCHK^QAQAHOC0"
53 S DIR("A",1)=" Enter special report header, if desired (maximum of 60 characters).",DIR("A")=" ",DIR("?")="^D EN^QAQAHOCH(""H5"")"
54 W ! D ^DIR G:$D(DIROUT)!$D(DTOUT)!$D(DUOUT) EXIT
55 K DHD S:Y]"" DHD=Y
56BYFLDS ; *** Process the BY and FLDS strings
57 K QAQCHOSN
58 F QA=1:1:QAQNUMOP("P") S QAI=$O(QAQOPTN("P",QA,"")) Q:QAI="" D
59 . S @$S(QA=1:"FLDS",1:"FLDS("_(QA-1)_")")=QAQOPTN("P",QA,QAI)
60 . S QAQCHOSN(QAI)=""
61 . Q
62 F QA=1:1:QAQNUMOP("S") S QAI=$O(QAQOPTN("S",QA,"")) Q:QAI="" D
63 . S X=QAQOPTN("S",QA,QAI),QAQSHD=$P(X,";",$L(X,";")),Y=$L(QAQSHD)
64 . I QAQSHD["""" D
65 .. S X=$P(X,";",1,$L(X,";")-1)
66 .. S QAQSHD=";"_$E(QAQSHD,1,Y-1)_$S($L(QAQSHD)>2:": """,1:"""")
67 .. S X=X_$S($D(QAQCHOSN(QAI))[0:QAQSHD,X[":,":"",X[":":QAQSHD,1:"")
68 .. Q
69 . I $L(BY)+$L(X)+1>255 D Q
70 .. W !!?3,"Sort too big !!"
71 .. W !?3,"Skipping sort field number ",QAI,", "
72 .. W $P(QAQMENU(QAI),"^",2),"."
73 .. Q
74 . S BY=BY_X_","
75 . Q
76 K DIC S DIC=QAQDIC,L=0,BY=$$COMMA(BY)
77 W ! D XIT,EN1^DIP
78EXIT ; *** Exit the Ad Hoc Reoprt Generator
79 K BY,DCOPIES,DHD,DHIT,DIC,DIOBEG,DIOEND,DIS,FLDS,FR,IOP,L,PG,TO,QAQDIC,QAQFOUND,QAQMHDR,QAQMMAX,QAQMRTN,QAQORTN
80XIT K %,%DT,%ZIS,D0,D1,DA,DIK,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,POP,QA,QAI,QAQ,QAQAGIN,QAQBEGIN,QAQBLURB,QAQCHKSM,QAQCHOSN,QAQD0,QAQD1,QAQDIR,QAQDTIME,QAQEND,QAQEXIT,QAQFIELD,QAQFLDNO,QAQLIST,QAQLST,QAQMACRO,QAQMAXOP,QAQMENU
81 K QAQMLOAD,QAQMOUTP,QAQMSAVE,QAQNEXT,QAQNONE,QAQNUMOP,QAQOK,QAQOPTN,QAQORDER,QAQPREFX,QAQQUIT,QAQREPLC,QAQSELOP,QAQSEQ,QAQSHD,QAQSORT,QAQSUFFX,QAQTAB,QAQTEMP,QAQTYPE,QAQUNDL,QAQYESNO,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
82 Q
83COMMA(X) ; *** Remove extra commas from X
84 F QA=$L(X):-1 Q:$E(X,QA)'=","
85 Q $E(X,1,QA)
86DHDCHK ; *** Check DHD for MUMPS code
87 Q:X'?1"W ".E Q:$G(DUZ(0))["@" N QA
88 F QA=1:2 Q:$P(X,"""",QA,999)="" I $P($E(X,3,999),"""",QA)[" " K X Q
89 Q
Note: See TracBrowser for help on using the repository browser.