Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: QAQAHOC0

QAQAHOC0.m

Go to the documentation of this file.
  1. QAQAHOC0 ;HISC/DAD-AD HOC REPORTS: MAIN DRIVER ;7/12/95 14:53
  1. ;;1.7;QM Integration Module;**1**;07/25/1995
  1. ;
  1. ;Required / Optional Variables
  1. ;
  1. ; QAQDIC = File NUMBER of the file to print from.
  1. ; QAQMRTN = Entry point to setup the QAQMENU array (Format TAG^ROUTINE)
  1. ; QAQORTN = Entry point to set up other FileMan EN1^DIP variables, i.e.
  1. ; DCOPIES, DHD, DHIT, DIOBEG, DIOEND, DIS(), IOP, PG optional
  1. ; QAQMHDR = Text to be used as the header at the top of the sort/print
  1. ; menu screens. Header appears as === QAQMHDR Ad Hoc Report
  1. ; Generator ===. Set QAQMHDR = @ to suppress the header.
  1. ; Maximum of 45 characters.
  1. ;
  1. ;Menu Array Format (Set up by D @QAQMRTN)
  1. ;
  1. ; QAQMENU() = Sort ^ Menu text ^ ~Field # ^ DIR(0)
  1. ; Sort = 1 - Allow sorting, 0 - Don't allow sorting.
  1. ; Menu text = Menu text as it will appear to the user (Max 30 char).
  1. ; ~Field # = Any valid EN1^DIP BY/FLDS string. The ~ is replaced by
  1. ; the sort/print prefixes entered by the user or null.
  1. ; Any ;"TEXT" appended to the BY/FLDS string should be
  1. ; in the last ';' piece of the string.
  1. ; DIR(0) = The DIR(0) string used when the user is prompted for a
  1. ; from/to range on the sort. DIR(0) should have a third
  1. ; '^' piece (input transform) that always returns the
  1. ; external form of the data or -1 in the variable Y.
  1. ;
  1. 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
  1. D XIT,HOME^%ZIS,@QAQMRTN K QAQMENU(0)
  1. S (QAQMMAX,QAQCHKSM,QAQSORT)=0 F QA=0:0 S QA=$O(QAQMENU(QA)) Q:QA'>0 D
  1. . S QAQMMAX=QAQMMAX+1,QAQCHKSM(0)=0,X=QAQMENU(QA) S:X QAQSORT=QAQSORT+1
  1. . F QAI=1:1:$L(X) S QAQCHKSM(0)=$A(X,QAI)*QAI+QAQCHKSM(0)
  1. . S QAQCHKSM=QAQCHKSM(0)*QA+QAQCHKSM
  1. . Q
  1. G:(QAQMMAX'>0)!(QAQSORT'>0) EXIT
  1. S QAQBLURB="Enter numeric 1 to "_QAQMMAX_", <RETURN> to end, ^ to exit"
  1. S QAQYESNO="Please answer Y(es) or N(o).",QAQDTIME=10,(BY,FLDS)=""
  1. S QAQMAXOP("S")=4,QAQMAXOP("P")=7,(QAQNUMOP("S"),QAQNUMOP("P"),QAQQUIT,QAQNEXT)=0
  1. ;
  1. 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
  1. S QAQNUMOP("S")=QAQSEQ-1 G EXIT:QAQQUIT,PRNT:QAQMLOAD D:QAQMSAVE SAVE^QAQAHOC3
  1. PRNT D:QAQMOUTP EN2^QAQAHOC4
  1. S QAQTYPE="P",QAQTYPE(0)="print",QAQTYPE(1)="Print",(QAQMLOAD,QAQMOUTP,QAQMSAVE)=0 K QAQCHOSN F QAQSEQ=1:1 D ENASK^QAQAHOC1 Q:QAQNEXT
  1. S QAQNUMOP("P")=QAQSEQ-1 G EXIT:QAQQUIT,OTHER:QAQMLOAD D:QAQMSAVE SAVE^QAQAHOC3
  1. OTHER ; *** Execute OTHER entry point in the Ad Hoc interface routine
  1. D:QAQMOUTP EN2^QAQAHOC4
  1. K DHD,PG,DHIT,DIOEND,DIOBEG,DCOPIES,IOP,DIS
  1. I $D(QAQORTN)#2 S QAQQUIT=0 D @QAQORTN G:QAQQUIT EXIT
  1. DHD ; *** Prompt user for report header
  1. G:$D(DHD)#2 BYFLDS
  1. K DIR S DIR(0)="FAO^0:60^D DHDCHK^QAQAHOC0"
  1. S DIR("A",1)=" Enter special report header, if desired (maximum of 60 characters).",DIR("A")=" ",DIR("?")="^D EN^QAQAHOCH(""H5"")"
  1. W ! D ^DIR G:$D(DIROUT)!$D(DTOUT)!$D(DUOUT) EXIT
  1. K DHD S:Y]"" DHD=Y
  1. BYFLDS ; *** Process the BY and FLDS strings
  1. K QAQCHOSN
  1. F QA=1:1:QAQNUMOP("P") S QAI=$O(QAQOPTN("P",QA,"")) Q:QAI="" D
  1. . S @$S(QA=1:"FLDS",1:"FLDS("_(QA-1)_")")=QAQOPTN("P",QA,QAI)
  1. . S QAQCHOSN(QAI)=""
  1. . Q
  1. F QA=1:1:QAQNUMOP("S") S QAI=$O(QAQOPTN("S",QA,"")) Q:QAI="" D
  1. . S X=QAQOPTN("S",QA,QAI),QAQSHD=$P(X,";",$L(X,";")),Y=$L(QAQSHD)
  1. . I QAQSHD["""" D
  1. .. S X=$P(X,";",1,$L(X,";")-1)
  1. .. S QAQSHD=";"_$E(QAQSHD,1,Y-1)_$S($L(QAQSHD)>2:": """,1:"""")
  1. .. S X=X_$S($D(QAQCHOSN(QAI))[0:QAQSHD,X[":,":"",X[":":QAQSHD,1:"")
  1. .. Q
  1. . I $L(BY)+$L(X)+1>255 D Q
  1. .. W !!?3,"Sort too big !!"
  1. .. W !?3,"Skipping sort field number ",QAI,", "
  1. .. W $P(QAQMENU(QAI),"^",2),"."
  1. .. Q
  1. . S BY=BY_X_","
  1. . Q
  1. K DIC S DIC=QAQDIC,L=0,BY=$$COMMA(BY)
  1. W ! D XIT,EN1^DIP
  1. EXIT ; *** Exit the Ad Hoc Reoprt Generator
  1. K BY,DCOPIES,DHD,DHIT,DIC,DIOBEG,DIOEND,DIS,FLDS,FR,IOP,L,PG,TO,QAQDIC,QAQFOUND,QAQMHDR,QAQMMAX,QAQMRTN,QAQORTN
  1. 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
  1. 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
  1. Q
  1. COMMA(X) ; *** Remove extra commas from X
  1. F QA=$L(X):-1 Q:$E(X,QA)'=","
  1. Q $E(X,1,QA)
  1. DHDCHK ; *** Check DHD for MUMPS code
  1. Q:X'?1"W ".E Q:$G(DUZ(0))["@" N QA
  1. F QA=1:2 Q:$P(X,"""",QA,999)="" I $P($E(X,3,999),"""",QA)[" " K X Q
  1. Q