- 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 Jan 18, 2025@03:15:31 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