- YSASCSC ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:41
- ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
- Q
- ;
- IF(YSASIEN,YSASFLD,YSASFLG) ;pass ien and field - return content
- Q:$G(YSASIEN)'>0 ""
- Q:$G(YSASFLD)'>0 ""
- N DIERR
- Q $$GET1^DIQ(604,YSASIEN_",",YSASFLD,$G(YSASFLG))
- ;
- C(X,Y,Z) ;return score/msg - pass data in X, Item # in Y and optional comment in Z.
- I $G(X)="" Q " Item "_Y_$J("",(4-$L(Y)))_" <missing data> "_$G(Z)
- Q " Item "_Y_$J("",(4-$L(Y)))_$J(X,6)_" ..ok "_$G(Z)
- ;
- EM(X) ;Error Message
- Q:$G(X)="" ""
- Q "No Composite Score"
- ;
- SM(X) ;Score Message
- Q:$G(X)="" ""
- Q "Composite Score: "
- ;
- EN ;Entry point continuation from YSASCSB
- D CSLS,CSFSR,CSPS
- Q
- CSLS ;Composite Score for Legal Status
- I $E(IOST)="P" W:$D(IOF) @IOF
- Q:$$FF
- D HDR
- W !!!,"Items for Legal Composite Scores"
- W !,"--------------------------------",!
- N YSASA,YSASB,YSASC,YSASD,YSASE
- S YSASA=$$IF(YSASDA,14.27,"I")
- W !,$$C(YSASA,"L24")
- S YSASB=$$IF(YSASDA,14.31)
- W !,$$C(YSASB,"L27")
- S YSASC=$$IF(YSASDA,14.32)
- W !,$$C(YSASC,"L28")
- S YSASD=$$IF(YSASDA,14.33)
- W !,$$C(YSASD,"L29")
- S YSASE=$$IF(YSASDA,9.25)
- W !,$$C(YSASE,"E17","<Item 17 from Employment Domain>")
- I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="") W !!,$$EM("Legal") Q
- S:YSASE>0 YSASE=$$LN^XLFMTH(YSASE)
- S YSASA=YSASA/5,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
- S YSASE=YSASE/46
- W !!,$$SM("Legal"),$J(YSASA+YSASB+YSASC+YSASD+YSASE,6,4)
- Q
- ;
- CSFSR ;Composite Score for Family/Social Relationships
- Q:$$FF
- D:$E(IOST)="C" HDR
- W !!!,"Items for Family/Social Composite Scores"
- W !,"----------------------------------------",!
- N YSASA,YSASB,YSASC,YSASD,YSASR
- S YSASA=$$IF(YSASDA,17.04)
- S:YSASA]"" YSASA=$S(YSASA="YES":0,YSASA="NO":2,1:1)
- W !,$$C(YSASA,"F3")
- S YSASB=$$IF(YSASDA,18.23)
- W !,$$C(YSASB,"F30")
- S YSASC=$$IF(YSASDA,18.25)
- W !,$$C(YSASC,"F32")
- S YSASD=$$IF(YSASDA,18.27)
- W !,$$C(YSASD,"F34")
- D
- .N YSASI,YSASX
- .S YSASR=0
- .S YSASF=".01,.03,.05,.07,.09,.12,.15,.17,.185"
- .S YSASI="10,11,12,13,14,15,16,17,18"
- .F YSASC=1:1:9 D
- ..S YSASX=$$IF(YSASDA,18_$P(YSASF,",",YSASC),"I")
- ..W !,$$C(YSASX,"F"_(YSASC+17))
- ..S:YSASX="" YSASR=""
- ..Q:YSASR=""
- ..S YSASR=YSASR+YSASX
- ..Q
- .Q:YSASR=""
- .S YSASR=YSASR/9
- .Q
- I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASR="") W !!,$$EM("Family/Social") Q
- S YSASA=YSASA/10,YSASB=YSASB/150,YSASC=YSASC/20,YSASD=YSASD/20
- S YSASR=YSASR/5
- W !!,$$SM("Family/Social"),$J(YSASA+YSASB+YSASC+YSASD+YSASR,6,4)
- Q
- ;
- CSPS ;Composite Score for Psychiatric Status
- Q:$$FF
- D:$E(IOST)="C" HDR
- W !!!,"Items for Psychiatric Composite Scores"
- W !,"--------------------------------------",!
- N YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK
- S YSASA=$$IF(YSASDA,19.04,"I")
- W !,$$C(YSASA,"P3")
- S YSASB=$$IF(YSASDA,19.06,"I")
- W !,$$C(YSASB,"P4")
- S YSASC=$$IF(YSASDA,19.08,"I")
- W !,$$C(YSASC,"P5")
- S YSASD=$$IF(YSASDA,19.11,"I")
- W !,$$C(YSASD,"P6")
- S YSASE=$$IF(YSASDA,19.14,"I")
- W !,$$C(YSASE,"P7")
- S YSASF=$$IF(YSASDA,19.16,"I")
- W !,$$C(YSASF,"P8")
- S YSASG=$$IF(YSASDA,19.18,"I")
- W !,$$C(YSASG,"P9")
- S YSASH=$$IF(YSASDA,19.21,"I")
- W !,$$C(YSASH,"P10")
- S YSASI=$$IF(YSASDA,19.23)
- W !,$$C(YSASI,"P11")
- S YSASJ=$$IF(YSASDA,19.24)
- W !,$$C(YSASJ,"P12")
- S YSASK=$$IF(YSASDA,19.25)
- W !,$$C(YSASK,"P13")
- I YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="") W !!,$$EM("Paychiatric") Q
- S YSASA=YSASA/11,YSASB=YSASB/11,YSASC=YSASC/11,YSASD=YSASD/11
- S YSASE=YSASE/11,YSASF=YSASF/11,YSASG=YSASG/11,YSASH=YSASH/11
- S YSASI=YSASI/330,YSASJ=YSASJ/44,YSASK=YSASK/44
- W !!,$$SM("Psychiatric"),$J(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK,6,4)
- Q
- ;
- FF() ;Form Feed
- I $E(IOST)'="C" Q 0
- I $G(YSASQUIT) Q 1
- N X
- W !!,"<press <cr> to continue>"
- R X:DTIME
- W:$D(IOF) @IOF
- I $E(X)="^" S YSASQUIT=1 Q 1
- Q 0
- ;
- HDR ;Header
- W !,$$IF(YSASDA,.02)," ASI date of interview: ",$$IF(YSASDA,.05)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASCSC 4079 printed Jan 18, 2025@03:14:10 Page 2
- YSASCSC ;692/DCL-ASI MISSING COMPOSITE SCORES ;1/23/97 11:41
- +1 ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
- +2 QUIT
- +3 ;
- IF(YSASIEN,YSASFLD,YSASFLG) ;pass ien and field - return content
- +1 if $GET(YSASIEN)'>0
- QUIT ""
- +2 if $GET(YSASFLD)'>0
- QUIT ""
- +3 NEW DIERR
- +4 QUIT $$GET1^DIQ(604,YSASIEN_",",YSASFLD,$GET(YSASFLG))
- +5 ;
- C(X,Y,Z) ;return score/msg - pass data in X, Item # in Y and optional comment in Z.
- +1 IF $GET(X)=""
- QUIT " Item "_Y_$JUSTIFY("",(4-$LENGTH(Y)))_" <missing data> "_$GET(Z)
- +2 QUIT " Item "_Y_$JUSTIFY("",(4-$LENGTH(Y)))_$JUSTIFY(X,6)_" ..ok "_$GET(Z)
- +3 ;
- EM(X) ;Error Message
- +1 if $GET(X)=""
- QUIT ""
- +2 QUIT "No Composite Score"
- +3 ;
- SM(X) ;Score Message
- +1 if $GET(X)=""
- QUIT ""
- +2 QUIT "Composite Score: "
- +3 ;
- EN ;Entry point continuation from YSASCSB
- +1 DO CSLS
- DO CSFSR
- DO CSPS
- +2 QUIT
- CSLS ;Composite Score for Legal Status
- +1 IF $EXTRACT(IOST)="P"
- if $DATA(IOF)
- WRITE @IOF
- +2 if $$FF
- QUIT
- +3 DO HDR
- +4 WRITE !!!,"Items for Legal Composite Scores"
- +5 WRITE !,"--------------------------------",!
- +6 NEW YSASA,YSASB,YSASC,YSASD,YSASE
- +7 SET YSASA=$$IF(YSASDA,14.27,"I")
- +8 WRITE !,$$C(YSASA,"L24")
- +9 SET YSASB=$$IF(YSASDA,14.31)
- +10 WRITE !,$$C(YSASB,"L27")
- +11 SET YSASC=$$IF(YSASDA,14.32)
- +12 WRITE !,$$C(YSASC,"L28")
- +13 SET YSASD=$$IF(YSASDA,14.33)
- +14 WRITE !,$$C(YSASD,"L29")
- +15 SET YSASE=$$IF(YSASDA,9.25)
- +16 WRITE !,$$C(YSASE,"E17","<Item 17 from Employment Domain>")
- +17 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")
- WRITE !!,$$EM("Legal")
- QUIT
- +18 if YSASE>0
- SET YSASE=$$LN^XLFMTH(YSASE)
- +19 SET YSASA=YSASA/5
- SET YSASB=YSASB/150
- SET YSASC=YSASC/20
- SET YSASD=YSASD/20
- +20 SET YSASE=YSASE/46
- +21 WRITE !!,$$SM("Legal"),$JUSTIFY(YSASA+YSASB+YSASC+YSASD+YSASE,6,4)
- +22 QUIT
- +23 ;
- CSFSR ;Composite Score for Family/Social Relationships
- +1 if $$FF
- QUIT
- +2 if $EXTRACT(IOST)="C"
- DO HDR
- +3 WRITE !!!,"Items for Family/Social Composite Scores"
- +4 WRITE !,"----------------------------------------",!
- +5 NEW YSASA,YSASB,YSASC,YSASD,YSASR
- +6 SET YSASA=$$IF(YSASDA,17.04)
- +7 if YSASA]""
- SET YSASA=$SELECT(YSASA="YES":0,YSASA="NO":2,1:1)
- +8 WRITE !,$$C(YSASA,"F3")
- +9 SET YSASB=$$IF(YSASDA,18.23)
- +10 WRITE !,$$C(YSASB,"F30")
- +11 SET YSASC=$$IF(YSASDA,18.25)
- +12 WRITE !,$$C(YSASC,"F32")
- +13 SET YSASD=$$IF(YSASDA,18.27)
- +14 WRITE !,$$C(YSASD,"F34")
- +15 Begin DoDot:1
- +16 NEW YSASI,YSASX
- +17 SET YSASR=0
- +18 SET YSASF=".01,.03,.05,.07,.09,.12,.15,.17,.185"
- +19 SET YSASI="10,11,12,13,14,15,16,17,18"
- +20 FOR YSASC=1:1:9
- Begin DoDot:2
- +21 SET YSASX=$$IF(YSASDA,18_$PIECE(YSASF,",",YSASC),"I")
- +22 WRITE !,$$C(YSASX,"F"_(YSASC+17))
- +23 if YSASX=""
- SET YSASR=""
- +24 if YSASR=""
- QUIT
- +25 SET YSASR=YSASR+YSASX
- +26 QUIT
- End DoDot:2
- +27 if YSASR=""
- QUIT
- +28 SET YSASR=YSASR/9
- +29 QUIT
- End DoDot:1
- +30 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASR="")
- WRITE !!,$$EM("Family/Social")
- QUIT
- +31 SET YSASA=YSASA/10
- SET YSASB=YSASB/150
- SET YSASC=YSASC/20
- SET YSASD=YSASD/20
- +32 SET YSASR=YSASR/5
- +33 WRITE !!,$$SM("Family/Social"),$JUSTIFY(YSASA+YSASB+YSASC+YSASD+YSASR,6,4)
- +34 QUIT
- +35 ;
- CSPS ;Composite Score for Psychiatric Status
- +1 if $$FF
- QUIT
- +2 if $EXTRACT(IOST)="C"
- DO HDR
- +3 WRITE !!!,"Items for Psychiatric Composite Scores"
- +4 WRITE !,"--------------------------------------",!
- +5 NEW YSASA,YSASB,YSASC,YSASD,YSASE,YSASF,YSASG,YSASH,YSASI,YSASJ,YSASK
- +6 SET YSASA=$$IF(YSASDA,19.04,"I")
- +7 WRITE !,$$C(YSASA,"P3")
- +8 SET YSASB=$$IF(YSASDA,19.06,"I")
- +9 WRITE !,$$C(YSASB,"P4")
- +10 SET YSASC=$$IF(YSASDA,19.08,"I")
- +11 WRITE !,$$C(YSASC,"P5")
- +12 SET YSASD=$$IF(YSASDA,19.11,"I")
- +13 WRITE !,$$C(YSASD,"P6")
- +14 SET YSASE=$$IF(YSASDA,19.14,"I")
- +15 WRITE !,$$C(YSASE,"P7")
- +16 SET YSASF=$$IF(YSASDA,19.16,"I")
- +17 WRITE !,$$C(YSASF,"P8")
- +18 SET YSASG=$$IF(YSASDA,19.18,"I")
- +19 WRITE !,$$C(YSASG,"P9")
- +20 SET YSASH=$$IF(YSASDA,19.21,"I")
- +21 WRITE !,$$C(YSASH,"P10")
- +22 SET YSASI=$$IF(YSASDA,19.23)
- +23 WRITE !,$$C(YSASI,"P11")
- +24 SET YSASJ=$$IF(YSASDA,19.24)
- +25 WRITE !,$$C(YSASJ,"P12")
- +26 SET YSASK=$$IF(YSASDA,19.25)
- +27 WRITE !,$$C(YSASK,"P13")
- +28 IF YSASA=""!(YSASB="")!(YSASC="")!(YSASD="")!(YSASE="")!(YSASF="")!(YSASG="")!(YSASH="")!(YSASI="")!(YSASJ="")!(YSASK="")
- WRITE !!,$$EM("Paychiatric")
- QUIT
- +29 SET YSASA=YSASA/11
- SET YSASB=YSASB/11
- SET YSASC=YSASC/11
- SET YSASD=YSASD/11
- +30 SET YSASE=YSASE/11
- SET YSASF=YSASF/11
- SET YSASG=YSASG/11
- SET YSASH=YSASH/11
- +31 SET YSASI=YSASI/330
- SET YSASJ=YSASJ/44
- SET YSASK=YSASK/44
- +32 WRITE !!,$$SM("Psychiatric"),$JUSTIFY(YSASA+YSASB+YSASC+YSASD+YSASE+YSASF+YSASG+YSASH+YSASI+YSASJ+YSASK,6,4)
- +33 QUIT
- +34 ;
- FF() ;Form Feed
- +1 IF $EXTRACT(IOST)'="C"
- QUIT 0
- +2 IF $GET(YSASQUIT)
- QUIT 1
- +3 NEW X
- +4 WRITE !!,"<press <cr> to continue>"
- +5 READ X:DTIME
- +6 if $DATA(IOF)
- WRITE @IOF
- +7 IF $EXTRACT(X)="^"
- SET YSASQUIT=1
- QUIT 1
- +8 QUIT 0
- +9 ;
- HDR ;Header
- +1 WRITE !,$$IF(YSASDA,.02)," ASI date of interview: ",$$IF(YSASDA,.05)
- +2 QUIT