| 1 | QAQAHOC0 ;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 | ;
|
|---|
| 41 | SORT 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
|
|---|
| 43 | PRNT 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
|
|---|
| 46 | OTHER ; *** 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
|
|---|
| 50 | DHD ; *** 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
|
|---|
| 56 | BYFLDS ; *** 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
|
|---|
| 78 | EXIT ; *** 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
|
|---|
| 80 | XIT 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
|
|---|
| 83 | COMMA(X) ; *** Remove extra commas from X
|
|---|
| 84 | F QA=$L(X):-1 Q:$E(X,QA)'=","
|
|---|
| 85 | Q $E(X,1,QA)
|
|---|
| 86 | DHDCHK ; *** 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
|
|---|
