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