source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNUTL0.m@ 1407

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1SPNUTL0 ;HISC/DAD-GENERIC FILE ENTRY SELECTOR ;12/8/95 09:40
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;
4 ;*** SELECTS A GROUP OF RECORDS FROM A FILE ***
5 ;
6 ;REQUIRES:
7 ; SPNDIC = FILE NUMBER OR GLOBAL ROOT
8 ; SPNDIC(0) = DIC(0) STRING
9 ; SPNUTIL = NODE TO STORE DATA UNDER IN ^TMP($J,SPNUTIL,
10 ;OPTIONAL:
11 ; SPNDIC("A") = DIC("A") STRING
12 ; SPNDIC("B") = DIC("B") STRING
13 ; SPNDIC("S") = DIC("S") STRING
14 ; SPNDIC("W") = DIC("W") STRING
15 ;RETURNS:
16 ; SPNQUIT = $S(UP_ARROW_OUT:1 , NOTHING_SELECTED:1 , 1:0)
17 ; ^TMP($J,SPNUTIL,EXTERNAL_.01_FIELD_DATA,IEN) = ""
18EN1 ;
19 S SPNQUIT=0
20 I ($D(SPNDIC)[0)!($D(SPNDIC(0))[0)!($D(SPNUTIL)[0) S SPNQUIT=1 G EXIT
21 I (SPNDIC="")!(SPNDIC(0)="")!(SPNUTIL="") S SPNQUIT=1 G EXIT
22 D K S DIC=SPNDIC
23 I DIC D G:SPNQUIT EXIT
24 . S (SPNDIC,DIC)=$$GET1^DID(DIC,"","","GLOBAL NAME")
25 . I DIC="" S SPNQUIT=1
26 . Q
27 S DIC(0)=SPNDIC(0),DIC(0)=$TR(DIC(0),"AL")
28 S:DIC(0)'["Z" DIC(0)=DIC(0)_"Z" S SPNDIC(0)=DIC(0)
29 D DO^DIC1 S SPNFNUM=+DO(2),SPNFNAME=$P(DO,"^")
30 S SPNFLD01=$$GET1^DID(SPNFNUM,.01,"","LABEL")
31 S SPNFSCR=$S($D(DO("SCR"))#2:DO("SCR"),1:"") K DO
32 S SPNFLD01("S")=SPNFLD01_$S($E(SPNFLD01,$L(SPNFLD01))?1L:"s",1:"S")
33 F X="A","B","S","W" S SPNDIC(X)=$S($D(SPNDIC(X))#2:SPNDIC(X),1:"")
34 S:SPNDIC("A")="" SPNDIC("A")="Select "_SPNFNAME_" "_SPNFLD01_": "
35 S SPNALL=0,SPNNUM=1 K TMP($J,SPNUTIL) D HOME^%ZIS
361 D SETDIC
37 W !!,$S(SPNNUM>1:"Another one: ",1:DIC("A"))
38 W $S((SPNNUM=1)&(SPNDIC("B")]""):SPNDIC("B")_"// ",1:"")
39 R X:DTIME S:('$T)!($E(X)="^") SPNQUIT=1
40 G:SPNQUIT EXIT S:(SPNNUM=1)&(X="")&(SPNDIC("B")]"") X=SPNDIC("B")
41 G:X="" EXIT S SPNDSEL=$S(X?1"-"1.E:1,1:0) S:SPNDSEL X=$E(X,2,$L(X))
42 I $L(X),$L(X)<4,"Aa"[$E(X),"Ll"[$E(X,2),"Ll"[$E(X,3) D ALL G EXIT:SPNQUIT,1:SPNALL
43 D HELP:$E(X)="?",^DIC K DIC G:+Y'>0 1
44 I $$CHKFLD(SPNFNUM)["D" D
45 . N %DT,X
46 . S SPND0=Y,X=Y(0,0),%DT="ST" D ^%DT S Y(0,0)=Y,Y=SPND0
47 . Q
48 I 'SPNDSEL,'$D(^TMP($J,SPNUTIL,$E(Y(0,0),1,63),+Y)) D
49 . S ^TMP($J,SPNUTIL,$E(Y(0,0),1,63),+Y)=""
50 . S SPNNUM=SPNNUM+1
51 . Q
52 I SPNDSEL,$D(^TMP($J,SPNUTIL,$E(Y(0,0),1,63),+Y)) D
53 . K ^TMP($J,SPNUTIL,$E(Y(0,0),1,63),+Y)
54 . S SPNNUM=SPNNUM-$S(SPNNUM>0:1,1:0)
55 . Q
56 G 1
57EXIT ;
58 S SPNQUIT=$S(SPNQUIT:1,$O(^TMP($J,SPNUTIL,""))="":1,1:0)
59 K SPNDIC,SPNUTIL
60K K %,C,D0,DA,DIC,DIK,DIR,DO,SPN,SPNALL,SPND0,SPNDSEL,SPNDT,SPNFLD01
61 K SPNFNAME,SPNFNUM,SPNFSCR,SPNLINE,SPNNUM,X,Y
62 Q
63ALL ;
64 S SPN="By '"_X_"' do you mean all "_$S($G(SPNFSCR)]"":"",$G(SPNDIC("S"))]"":"",1:$P(@(SPNDIC_"0)"),"^",4)_" ")_SPNFNAME_" "_SPNFLD01("S")
65 D WRAP(SPN)
66 S %=1 D YN^DICN S SPNALL=$S(%=1:1,1:0) S:%=-1 SPNQUIT=1
67 I '% D G ALL
68 . W !?7,"Answer Y(es) if you want all of the ",SPNFLD01("S"),","
69 . W !?7,"otherwise answer N(o)"
70 . Q
71 I SPNQUIT!'SPNALL W:'SPNQUIT !!,X Q
72 N X F SPND0=0:0 S SPND0=$O(@(SPNDIC_"SPND0)")) Q:SPND0'>0 D AL
73 W:SPNNUM=1 " ??",*7
74 Q
75AL I SPNFSCR]"" D SETDIC I $D(@(SPNDIC_"SPND0,0)"))#2 S (D0,DA,Y)=SPND0 X SPNFSCR Q:'$T
76 I SPNDIC("S")]"" D SETDIC I $D(@(SPNDIC_"SPND0,0)"))#2 S (D0,DA,Y)=SPND0 X DIC("S") Q:'$T
77 S Y=$P($G(@(SPNDIC_"SPND0,0)")),"^"),C=$P(^DD(SPNFNUM,.01,0),"^",2) Q:Y=""
78 D Y^DIQ
79 I $$CHKFLD(SPNFNUM)["D" D
80 . N %DT,X
81 . S X=Y,%DT="ST" D ^%DT
82 . Q
83 S ^TMP($J,SPNUTIL,$E(Y,1,63),SPND0)="",SPNNUM=SPNNUM+1
84 Q
85HELP ;
86 N X S SPN="Select a "_SPNFNAME_" "_SPNFLD01_" from the displayed list."
87 D WRAP(SPN)
88 W !?5,"To deselect an ",SPNFLD01," type a minus sign (-)"
89 W !?5,"in front of it, e.g. -",SPNFLD01,"."
90 W !?5,"To get all ",SPNFLD01," type ALL."
91 G:$O(^TMP($J,SPNUTIL,""))="" HLP
92SHOW S SPNLINE=$Y,SPN="" W !!,"You have already selected:"
93 F S SPN=$O(^TMP($J,SPNUTIL,SPN)) Q:SPN=""!SPNQUIT D
94 . F SPND0=0:0 S SPND0=$O(^TMP($J,SPNUTIL,SPN,SPND0)) Q:SPND0'>0!SPNQUIT D
95 .. S SPN(0)=SPN
96 .. I $$CHKFLD(SPNFNUM)["D" D
97 ... N Y
98 ... S Y=SPN(0) X ^DD("DD") S SPN(0)=Y
99 ... Q
100 .. I SPNDIC(0)["N" W !?3,SPND0,?15,SPN(0)
101 .. E W !?3,SPN(0)
102 .. D SETDIC
103 .. I $D(DIC("W"))#2,DIC("W")]"",$D(@(SPNDIC_"SPND0,0)"))#2 D
104 ... S (D0,DA,Y)=SPND0 X DIC("W")
105 ... Q
106 .. I $Y>(IOSL+SPNLINE-3) D PAUSE S SPNLINE=$Y
107 .. Q
108 . Q
109HLP W ! S SPNQUIT=0
110 Q
111WRAP(X) ;
112 W ! F D Q:X=""
113 . S Y=$L($E(X,1,IOM-20)," ")
114 . W !?5,$P(X," ",1,Y)
115 . S X=$P(X," ",Y+1,999)
116 . Q
117 Q
118PAUSE ;
119 K DIR S DIR(0)="E" D ^DIR K DIR S SPNQUIT=$S(Y:0,1:1)
120 Q
121SETDIC ;
122 K DIC,DO S DIC=SPNDIC
123 F X="0","A","B","S" I SPNDIC(X)]"" S DIC(X)=SPNDIC(X)
124 I $D(SPNDIC("W")) S DIC("W")=SPNDIC("W")
125 D DO^DIC1
126 Q
127CHKFLD(X) ;
128 N A S A=$$GET1^DID(X,.01,"","SPECIFIER")
129 I A["P" F S A=$$CHKFLD($TR(A,$TR(A,".0123456789"))) Q:A'["P"
130 Q A
Note: See TracBrowser for help on using the repository browser.