121 lines
4.9 KiB
Mathematica
121 lines
4.9 KiB
Mathematica
SPNAHOC0 ;HISC/DAD-AD HOC REPORTS: MAIN REPORT DRIVER ;9/11/96 14:58
|
|
;;2.0;Spinal Cord Dysfunction;**11,14,19**;01/02/1997
|
|
;
|
|
;Required / Optional Variables
|
|
;
|
|
; SPNDIC = File NUMBER of the file to print from.
|
|
; SPNMRTN = Entry point to setup the SPNMENU array (Format TAG^ROUTINE)
|
|
; SPNORTN = Entry point to set up other FileMan EN1^DIP variables (opt)
|
|
; SPNMHDR = Text to be used as the sort/print menu screen header.
|
|
; Header appears as === SPNMHDR Ad Hoc Report Generator ===
|
|
; Set SPNMHDR = @ to suppress the header. (Maximum 45 chars)
|
|
;
|
|
;Menu Array Format (Set up by D @SPNMRTN)
|
|
;
|
|
; SPNMENU() = Sort ^ Menu text ^ ~Field # ^ DIR(0)
|
|
; Sort = Allow sorting: 1 - Yes, 0 - No.
|
|
; Menu text = Menu text as it will appear to the user (Max 30 char).
|
|
; ~Field # = Any valid EN1^DIP BY/FLDS string. The ~ is replaced by
|
|
; the sort/print prefixes entered by the user or null.
|
|
; Any ;"TEXT" appended to the BY/FLDS string should be
|
|
; in the last ';' piece.
|
|
; DIR(0) = The DIR(0) string used when the user is prompted for a
|
|
; from/to range on the sort. DIR(0) should have a third
|
|
; '^' piece (input transform) that always returns the
|
|
; external form of the data or -1 in the variable Y.
|
|
; DIR("S") = A DIR("S") screen. This is the second '|' piece of
|
|
; the line.
|
|
;
|
|
G:$$GET1^DID(+$G(SPNDIC),"","","NAME")="" EXIT
|
|
G:$S($G(SPNMRTN)="":1,$D(SPNORTN)#2:SPNORTN="",1:0) EXIT
|
|
D SETUP^SPNAHOC5 G:(SPNMMAX'>0)!(SPNSORT'>0) EXIT
|
|
;
|
|
F SPNTYPE="S","P" D G:SPNQUIT EXIT
|
|
. I SPNTYPE="S" S SPNTYPE(0)="sort",SPNTYPE(1)="Sort"
|
|
. I SPNTYPE="P" S SPNTYPE(0)="print",SPNTYPE(1)="Print"
|
|
. S (SPNMLOAD,SPNMOUTP,SPNMSAVE)=0 K SPNCHOSN
|
|
. F SPNSEQ=1:1 D ENASK^SPNAHOC1 Q:SPNNEXT
|
|
. S SPNNUMOP(SPNTYPE)=SPNSEQ-1 Q:SPNQUIT
|
|
. I 'SPNMLOAD,SPNMSAVE D SAVE^SPNAHOC3
|
|
. I SPNMOUTP D EN2^SPNAHOC4
|
|
. Q
|
|
OTHER ; *** Execute OTHER entry point in the Ad Hoc interface routine
|
|
K DCOPIES,DHD,DHIT,DIASKHD,DIOBEG,DIOEND,DIS,DISTOP,DQTIME,IOP,PG
|
|
I $D(SPNORTN)#2 S SPNQUIT=0 D @SPNORTN G:SPNQUIT EXIT
|
|
DHD ; *** Prompt for report header
|
|
I $D(DIASKHD)=0,$E($G(DHD),1,2)'="W " D G:SPNQUIT EXIT
|
|
. K DIR S DIR(0)="FAO^0:60^D DHDCHK^SPNAHOC0"
|
|
. S DIR("A",1)=" Enter special report header, if desired (maximum of 60 characters)."
|
|
. S DIR("A")="Header: ",DIR("?")="^D EN^SPNAHOCH(""H5"")"
|
|
. S X=$P($$DHD^SPNAHOC4($G(SPNMACRO("P"))),U) S:X="" X=$G(DHD)
|
|
. I X]"" S DIR("B")=X
|
|
. W ! D ^DIR K DHD S:Y]"" DHD=Y
|
|
. I $D(DIROUT)!$D(DTOUT)!$D(DUOUT) S SPNQUIT=1 Q
|
|
. I $G(DHD)]"" D SAVDHD^SPNAHOC5($G(SPNMACRO("P")),DHD)
|
|
. Q
|
|
DIPCRIT ; *** Sort criteria in report header
|
|
F D Q:%
|
|
. W !!?3,"Include the sort criteria in the header"
|
|
. S %=$P($$DIPCRIT^SPNAHOC4($G(SPNMACRO("S"))),U)
|
|
. I '% S %=$S($D(DIPCRIT):1,1:2)
|
|
. D YN^DICN I '% D EN^SPNAHOCH("H11")
|
|
. Q
|
|
I %=-1 S SPNQUIT=1 G EXIT
|
|
K DIPCRIT I %=1 S DIPCRIT=1
|
|
D SAVDIPCR^SPNAHOC5($G(SPNMACRO("S")),$S(%=1:1,1:0))
|
|
BYFLDS ; *** Process BY & FLDS strings
|
|
K SPNCHOSN
|
|
F SP=1:1:SPNNUMOP("P") S SPI=$O(SPNOPTN("P",SP,"")) Q:SPI="" D
|
|
. S @$S(SP=1:"FLDS",1:"FLDS("_(SP-1)_")")=SPNOPTN("P",SP,SPI)
|
|
. S SPNCHOSN(SPI)=""
|
|
. Q
|
|
F SP=1:1:SPNNUMOP("S") S SPI=$O(SPNOPTN("S",SP,"")) Q:SPI="" D
|
|
. S X=SPNOPTN("S",SP,SPI),SPNSHD=$P(X,";",$L(X,";")),Y=$L(SPNSHD)
|
|
. I SPNSHD["""" D
|
|
.. S X=$P(X,";",1,$L(X,";")-1)
|
|
.. S SPNSHD=";"_$E(SPNSHD,1,Y-1)_$S($L(SPNSHD)>2:": """,1:"""")
|
|
.. S X=X_$S($D(SPNCHOSN(SPI))[0:SPNSHD,X[":,":"",X[":":SPNSHD,1:"")
|
|
.. Q
|
|
. I $L(BY)+$L(X)+1>255 D Q
|
|
.. W !!?3,"Sort too big !!"
|
|
.. W !?3,"Skipping sort field number ",SPI,", "
|
|
.. W $P(SPNMENU(SPI),U,2),"."
|
|
.. Q
|
|
. S BY=BY_X_","
|
|
. Q
|
|
;1 Self Report of Function
|
|
;2 FIM
|
|
;3 ASIA
|
|
;4 CHART
|
|
;5 FAM
|
|
;6 DIENER
|
|
;7 DUSOI
|
|
;8 Multiple Sclerosis
|
|
S:'$D(SPNARPT) SPNARPT=10 I SPNARPT'=10 D
|
|
.S SP=SP+1 S BY=BY_.02_","
|
|
.S X=X_SPNARPT
|
|
.S FR(SP)=SPNARPT,TO(SP)=SPNARPT
|
|
F SP=$L(BY):-1 Q:$E(X,SP)'="," S BY=$E(BY,1,SP)
|
|
K DIC S DIC=SPNDIC S:$D(L)[0 L=0
|
|
W !,"Do not queue this report if you used up-front or user selectable filters." W ! D XIT,EN1^DIP
|
|
EXIT ; *** Exit the Ad Hoc Reoprt Generator
|
|
K SPNARPT,SPNDIC,DCC,DIP,I,J,TO,FR,BY,X,Y,J,I,DIC,SP,SPI
|
|
K BY,DCOPIES,DHD,DHIT,DIASKHD,DIC,DIOBEG,DIOEND,DIPCRIT,DIS,DISPAR
|
|
K DISTOP,DISUPNO,DQTIME,FLDS,FR,IOP,L,PG,TO
|
|
K SPNDIC,SPNMHDR,SPNMMAX,SPNMRTN,SPNORTN
|
|
XIT K %,%DT,%ZIS,D0,D1,DA,DIK,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,POP
|
|
K SP,SPI,SPN,SPNAGIN,SPNBEGIN,SPNBLURB,SPNCHKSM,SPNCHOSN,SPND0,SPND1
|
|
K SPNDIR,SPNDTIME,SPNEND,SPNEXIT,SPNFIELD,SPNFLDNO,SPNLIST,SPNLST
|
|
K SPNMACRO,SPNMAXOP,SPNMENU,SPNMLOAD,SPNMOUTP,SPNMSAVE,SPNNEXT,SPNNONE
|
|
K SPNNUMOP,SPNOK,SPNOPTN,SPNORDER,SPNPREFX,SPNQUIT,SPNREPLC,SPNSELOP
|
|
K SPNSEQ,SPNSHD,SPNSORT,SPNSUFFX,SPNTAB,SPNTEMP,SPNTYP,SPNTYPE,SPNUNDL
|
|
K SPNYESNO,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
|
|
Q
|
|
DHDCHK ; *** Check DHD for MUMPS code
|
|
I $S(X'?1"W ".E:1,$G(DUZ(0))["@":1,1:0) Q
|
|
N SP
|
|
F SP=1:2 Q:$S($D(X)[0:1,$P(X,"""",SP,$L(X,""""))="":1,1:0) D
|
|
. I $P($E(X,3,$L(X)),"""",SP)[" " K X
|
|
. Q
|
|
Q
|