source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNAHOC0.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1SPNAHOC0 ;HISC/DAD-AD HOC REPORTS: MAIN REPORT DRIVER ;9/11/96 14:58
2 ;;2.0;Spinal Cord Dysfunction;**11,14,19**;01/02/1997
3 ;
4 ;Required / Optional Variables
5 ;
6 ; SPNDIC = File NUMBER of the file to print from.
7 ; SPNMRTN = Entry point to setup the SPNMENU array (Format TAG^ROUTINE)
8 ; SPNORTN = Entry point to set up other FileMan EN1^DIP variables (opt)
9 ; SPNMHDR = Text to be used as the sort/print menu screen header.
10 ; Header appears as === SPNMHDR Ad Hoc Report Generator ===
11 ; Set SPNMHDR = @ to suppress the header. (Maximum 45 chars)
12 ;
13 ;Menu Array Format (Set up by D @SPNMRTN)
14 ;
15 ; SPNMENU() = Sort ^ Menu text ^ ~Field # ^ DIR(0)
16 ; Sort = Allow sorting: 1 - Yes, 0 - No.
17 ; Menu text = Menu text as it will appear to the user (Max 30 char).
18 ; ~Field # = Any valid EN1^DIP BY/FLDS string. The ~ is replaced by
19 ; the sort/print prefixes entered by the user or null.
20 ; Any ;"TEXT" appended to the BY/FLDS string should be
21 ; in the last ';' piece.
22 ; DIR(0) = The DIR(0) string used when the user is prompted for a
23 ; from/to range on the sort. DIR(0) should have a third
24 ; '^' piece (input transform) that always returns the
25 ; external form of the data or -1 in the variable Y.
26 ; DIR("S") = A DIR("S") screen. This is the second '|' piece of
27 ; the line.
28 ;
29 G:$$GET1^DID(+$G(SPNDIC),"","","NAME")="" EXIT
30 G:$S($G(SPNMRTN)="":1,$D(SPNORTN)#2:SPNORTN="",1:0) EXIT
31 D SETUP^SPNAHOC5 G:(SPNMMAX'>0)!(SPNSORT'>0) EXIT
32 ;
33 F SPNTYPE="S","P" D G:SPNQUIT EXIT
34 . I SPNTYPE="S" S SPNTYPE(0)="sort",SPNTYPE(1)="Sort"
35 . I SPNTYPE="P" S SPNTYPE(0)="print",SPNTYPE(1)="Print"
36 . S (SPNMLOAD,SPNMOUTP,SPNMSAVE)=0 K SPNCHOSN
37 . F SPNSEQ=1:1 D ENASK^SPNAHOC1 Q:SPNNEXT
38 . S SPNNUMOP(SPNTYPE)=SPNSEQ-1 Q:SPNQUIT
39 . I 'SPNMLOAD,SPNMSAVE D SAVE^SPNAHOC3
40 . I SPNMOUTP D EN2^SPNAHOC4
41 . Q
42OTHER ; *** Execute OTHER entry point in the Ad Hoc interface routine
43 K DCOPIES,DHD,DHIT,DIASKHD,DIOBEG,DIOEND,DIS,DISTOP,DQTIME,IOP,PG
44 I $D(SPNORTN)#2 S SPNQUIT=0 D @SPNORTN G:SPNQUIT EXIT
45DHD ; *** Prompt for report header
46 I $D(DIASKHD)=0,$E($G(DHD),1,2)'="W " D G:SPNQUIT EXIT
47 . K DIR S DIR(0)="FAO^0:60^D DHDCHK^SPNAHOC0"
48 . S DIR("A",1)=" Enter special report header, if desired (maximum of 60 characters)."
49 . S DIR("A")="Header: ",DIR("?")="^D EN^SPNAHOCH(""H5"")"
50 . S X=$P($$DHD^SPNAHOC4($G(SPNMACRO("P"))),U) S:X="" X=$G(DHD)
51 . I X]"" S DIR("B")=X
52 . W ! D ^DIR K DHD S:Y]"" DHD=Y
53 . I $D(DIROUT)!$D(DTOUT)!$D(DUOUT) S SPNQUIT=1 Q
54 . I $G(DHD)]"" D SAVDHD^SPNAHOC5($G(SPNMACRO("P")),DHD)
55 . Q
56DIPCRIT ; *** Sort criteria in report header
57 F D Q:%
58 . W !!?3,"Include the sort criteria in the header"
59 . S %=$P($$DIPCRIT^SPNAHOC4($G(SPNMACRO("S"))),U)
60 . I '% S %=$S($D(DIPCRIT):1,1:2)
61 . D YN^DICN I '% D EN^SPNAHOCH("H11")
62 . Q
63 I %=-1 S SPNQUIT=1 G EXIT
64 K DIPCRIT I %=1 S DIPCRIT=1
65 D SAVDIPCR^SPNAHOC5($G(SPNMACRO("S")),$S(%=1:1,1:0))
66BYFLDS ; *** Process BY & FLDS strings
67 K SPNCHOSN
68 F SP=1:1:SPNNUMOP("P") S SPI=$O(SPNOPTN("P",SP,"")) Q:SPI="" D
69 . S @$S(SP=1:"FLDS",1:"FLDS("_(SP-1)_")")=SPNOPTN("P",SP,SPI)
70 . S SPNCHOSN(SPI)=""
71 . Q
72 F SP=1:1:SPNNUMOP("S") S SPI=$O(SPNOPTN("S",SP,"")) Q:SPI="" D
73 . S X=SPNOPTN("S",SP,SPI),SPNSHD=$P(X,";",$L(X,";")),Y=$L(SPNSHD)
74 . I SPNSHD["""" D
75 .. S X=$P(X,";",1,$L(X,";")-1)
76 .. S SPNSHD=";"_$E(SPNSHD,1,Y-1)_$S($L(SPNSHD)>2:": """,1:"""")
77 .. S X=X_$S($D(SPNCHOSN(SPI))[0:SPNSHD,X[":,":"",X[":":SPNSHD,1:"")
78 .. Q
79 . I $L(BY)+$L(X)+1>255 D Q
80 .. W !!?3,"Sort too big !!"
81 .. W !?3,"Skipping sort field number ",SPI,", "
82 .. W $P(SPNMENU(SPI),U,2),"."
83 .. Q
84 . S BY=BY_X_","
85 . Q
86 ;1 Self Report of Function
87 ;2 FIM
88 ;3 ASIA
89 ;4 CHART
90 ;5 FAM
91 ;6 DIENER
92 ;7 DUSOI
93 ;8 Multiple Sclerosis
94 S:'$D(SPNARPT) SPNARPT=10 I SPNARPT'=10 D
95 .S SP=SP+1 S BY=BY_.02_","
96 .S X=X_SPNARPT
97 .S FR(SP)=SPNARPT,TO(SP)=SPNARPT
98 F SP=$L(BY):-1 Q:$E(X,SP)'="," S BY=$E(BY,1,SP)
99 K DIC S DIC=SPNDIC S:$D(L)[0 L=0
100 W !,"Do not queue this report if you used up-front or user selectable filters." W ! D XIT,EN1^DIP
101EXIT ; *** Exit the Ad Hoc Reoprt Generator
102 K SPNARPT,SPNDIC,DCC,DIP,I,J,TO,FR,BY,X,Y,J,I,DIC,SP,SPI
103 K BY,DCOPIES,DHD,DHIT,DIASKHD,DIC,DIOBEG,DIOEND,DIPCRIT,DIS,DISPAR
104 K DISTOP,DISUPNO,DQTIME,FLDS,FR,IOP,L,PG,TO
105 K SPNDIC,SPNMHDR,SPNMMAX,SPNMRTN,SPNORTN
106XIT K %,%DT,%ZIS,D0,D1,DA,DIK,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,POP
107 K SP,SPI,SPN,SPNAGIN,SPNBEGIN,SPNBLURB,SPNCHKSM,SPNCHOSN,SPND0,SPND1
108 K SPNDIR,SPNDTIME,SPNEND,SPNEXIT,SPNFIELD,SPNFLDNO,SPNLIST,SPNLST
109 K SPNMACRO,SPNMAXOP,SPNMENU,SPNMLOAD,SPNMOUTP,SPNMSAVE,SPNNEXT,SPNNONE
110 K SPNNUMOP,SPNOK,SPNOPTN,SPNORDER,SPNPREFX,SPNQUIT,SPNREPLC,SPNSELOP
111 K SPNSEQ,SPNSHD,SPNSORT,SPNSUFFX,SPNTAB,SPNTEMP,SPNTYP,SPNTYPE,SPNUNDL
112 K SPNYESNO,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
113 Q
114DHDCHK ; *** Check DHD for MUMPS code
115 I $S(X'?1"W ".E:1,$G(DUZ(0))["@":1,1:0) Q
116 N SP
117 F SP=1:2 Q:$S($D(X)[0:1,$P(X,"""",SP,$L(X,""""))="":1,1:0) D
118 . I $P($E(X,3,$L(X)),"""",SP)[" " K X
119 . Q
120 Q
Note: See TracBrowser for help on using the repository browser.