Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YSDX3UC

YSDX3UC.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ASKQUAL ; Ask for qaulifiers.
  1. ; YSQIEN -- req --> YSQCH(YSQIEN,INTERNAL CODE)=Stands For
  1. ; --> YSOK,YSTOUT,YSUOUT
  1. ;
  1. ;Note: When this subroutine called, all choices have been displayed.
  1. ;
  1. S YSOK=0
  1. QUIT:'$D(^DIC(627.9,+$G(YSQIEN))) ;->
  1. ;
  1. ; Start preparing for DIR(0)...
  1. S YSQDIR0="O^" ;Use to add choices to... (L or S will be added later.)
  1. S YSQDIRT="L" ;Assume it is LIST. Changed below, if not...
  1. ;
  1. ; If not available, build needed variables
  1. S YSQNCH=0 K YSQCH
  1. S YSQNO=0
  1. F S YSQNO=$O(^DIC(627.9,+YSQIEN,1,YSQNO)) QUIT:'YSQNO D
  1. . S YSX=$G(^DIC(627.9,+YSQIEN,1,+YSQNO,0)) QUIT:YSX']"" ;->
  1. . S:$P(YSX,U,2)']"" $P(YSX,U,2)=" " ;For possible DIR call...
  1. . QUIT:$P(YSX,U)']"" ;->
  1. . S YSQNCH=YSQNCH+1
  1. . S YSQCH(+YSQIEN,+YSQNO)=$P(YSX,U,2)
  1. . S YSQDIR0=YSQDIR0_$P(YSX,U)_":"_$P(YSX,U,2)_";"
  1. . I YSQNCH'=+YSX S YSQDIRT="S" ;Not 1-2-3...n LIST sequence...
  1. ;
  1. ; Add DIR(0) type (List or Set)
  1. S YSQDIR0=YSQDIRT_YSQDIR0
  1. ;
  1. ; Multiple-allowed List of Numeric Choice qualifiers?
  1. ; Adjust P(2)...
  1. I YSQDIRT="L",$P($G(^DIC(627.9,+YSQIEN,2)),U)="Y" S $P(YSQDIR0,U,2,99)="1:"_+YSQNCH
  1. I YSQDIRT="L",$P($G(^DIC(627.9,+YSQIEN,2)),U)'="Y" S YSQDIR0="S"_$E(YSQDIR0,2,999)
  1. ;
  1. ; Chop trailing semicolons...
  1. I $E(YSQDIR0,$L(YSQDIR0))=";" S YSQDIR0=$E(YSQDIR0,1,$L(YSQDIR0)-1)
  1. ;
  1. ; Now, present query...
  1. N DIR
  1. S DIR(0)=YSQDIR0
  1. S X=$E(DIR(0)),DIR("A")=$S(X="L"&(YSQNCH>1):"Select one or more modifiers",1:"Select modifier")
  1. D ^DIR
  1. S YSAX=X,YSAY=Y
  1. ;
  1. S YSUOUT=(X[U) QUIT:YSUOUT ;->
  1. ;
  1. ; Set OK now... Users should be allowed to "return past" any query...
  1. S YSOK=1
  1. ;
  1. ; Note!!
  1. ; FO-DIR call results are the same whether user timed out, or if
  1. ; the user "returned past": DIRUT=1, $T=1, X=""
  1. I YSAX']"" K YSQCH QUIT ;->
  1. ;
  1. ; Build User Selection array & Kill YSQCH array elements not selected...
  1. K YSQUSEL
  1. F YSI=1:1:$L(YSAY,",") S YSX=$P(YSAY,",",+YSI) I YSX]"" S YSQUSEL(YSX)=""
  1. ;
  1. ; YSQXIEN stores the response IEN
  1. ; If response is non-numeric (eg., Y/N), that response's IEN must
  1. ; be found. That is why the response string (YSQXRS) must be found;
  1. ; to be able to match...
  1. ;
  1. S YSQXIEN=0
  1. F S YSQXIEN=$O(YSQCH(+YSQIEN,YSQXIEN)) QUIT:YSQXIEN']"" D
  1. . S YSQXRS=$P($G(^DIC(627.9,+YSQIEN,1,+YSQXIEN,0)),U) ;Resp "string"
  1. . I '$D(YSQUSEL(YSQXRS)) KILL YSQCH(+YSQIEN,YSQXIEN)
  1. ;
  1. QUIT
  1. ;
  1. EOR ;YSDX3UC-Continuation of Utilities for Diagnosis Entry in the MH Medical Record ;9/7/94 14:51