source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX3UC.m@ 736

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1YSDX3UC ;SLC/DJP/LJA-Continuation of Utilities for Diagnosis Entry in the MH Medical Record ;9/7/94 14:51
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4ASKQUAL ; Ask for qaulifiers.
5 ; YSQIEN -- req --> YSQCH(YSQIEN,INTERNAL CODE)=Stands For
6 ; --> YSOK,YSTOUT,YSUOUT
7 ;
8 ;Note: When this subroutine called, all choices have been displayed.
9 ;
10 S YSOK=0
11 QUIT:'$D(^DIC(627.9,+$G(YSQIEN))) ;->
12 ;
13 ; Start preparing for DIR(0)...
14 S YSQDIR0="O^" ;Use to add choices to... (L or S will be added later.)
15 S YSQDIRT="L" ;Assume it is LIST. Changed below, if not...
16 ;
17 ; If not available, build needed variables
18 S YSQNCH=0 K YSQCH
19 S YSQNO=0
20 F S YSQNO=$O(^DIC(627.9,+YSQIEN,1,YSQNO)) QUIT:'YSQNO D
21 . S YSX=$G(^DIC(627.9,+YSQIEN,1,+YSQNO,0)) QUIT:YSX']"" ;->
22 . S:$P(YSX,U,2)']"" $P(YSX,U,2)=" " ;For possible DIR call...
23 . QUIT:$P(YSX,U)']"" ;->
24 . S YSQNCH=YSQNCH+1
25 . S YSQCH(+YSQIEN,+YSQNO)=$P(YSX,U,2)
26 . S YSQDIR0=YSQDIR0_$P(YSX,U)_":"_$P(YSX,U,2)_";"
27 . I YSQNCH'=+YSX S YSQDIRT="S" ;Not 1-2-3...n LIST sequence...
28 ;
29 ; Add DIR(0) type (List or Set)
30 S YSQDIR0=YSQDIRT_YSQDIR0
31 ;
32 ; Multiple-allowed List of Numeric Choice qualifiers?
33 ; Adjust P(2)...
34 I YSQDIRT="L",$P($G(^DIC(627.9,+YSQIEN,2)),U)="Y" S $P(YSQDIR0,U,2,99)="1:"_+YSQNCH
35 I YSQDIRT="L",$P($G(^DIC(627.9,+YSQIEN,2)),U)'="Y" S YSQDIR0="S"_$E(YSQDIR0,2,999)
36 ;
37 ; Chop trailing semicolons...
38 I $E(YSQDIR0,$L(YSQDIR0))=";" S YSQDIR0=$E(YSQDIR0,1,$L(YSQDIR0)-1)
39 ;
40 ; Now, present query...
41 N DIR
42 S DIR(0)=YSQDIR0
43 S X=$E(DIR(0)),DIR("A")=$S(X="L"&(YSQNCH>1):"Select one or more modifiers",1:"Select modifier")
44 D ^DIR
45 S YSAX=X,YSAY=Y
46 ;
47 S YSUOUT=(X[U) QUIT:YSUOUT ;->
48 ;
49 ; Set OK now... Users should be allowed to "return past" any query...
50 S YSOK=1
51 ;
52 ; Note!!
53 ; FO-DIR call results are the same whether user timed out, or if
54 ; the user "returned past": DIRUT=1, $T=1, X=""
55 I YSAX']"" K YSQCH QUIT ;->
56 ;
57 ; Build User Selection array & Kill YSQCH array elements not selected...
58 K YSQUSEL
59 F YSI=1:1:$L(YSAY,",") S YSX=$P(YSAY,",",+YSI) I YSX]"" S YSQUSEL(YSX)=""
60 ;
61 ; YSQXIEN stores the response IEN
62 ; If response is non-numeric (eg., Y/N), that response's IEN must
63 ; be found. That is why the response string (YSQXRS) must be found;
64 ; to be able to match...
65 ;
66 S YSQXIEN=0
67 F S YSQXIEN=$O(YSQCH(+YSQIEN,YSQXIEN)) QUIT:YSQXIEN']"" D
68 . S YSQXRS=$P($G(^DIC(627.9,+YSQIEN,1,+YSQXIEN,0)),U) ;Resp "string"
69 . I '$D(YSQUSEL(YSQXRS)) KILL YSQCH(+YSQIEN,YSQXIEN)
70 ;
71 QUIT
72 ;
73EOR ;YSDX3UC-Continuation of Utilities for Diagnosis Entry in the MH Medical Record ;9/7/94 14:51
Note: See TracBrowser for help on using the repository browser.