Routine: YSASO2

YSASO2 ;692/DCL-ASI/ASF COMPOSITE SCORES FOR LITE ;5/22/97  11:10

 ;;5.01;MENTAL HEALTH;**24,30**;Dec 30, 1994

OUT3(YSASIEN,YSASOK) ;Entry Point pass IEN from file 604 FOR LITE

 Q:$G(YSASIEN)'>0

 N YSASY,YSASSR,YSASCS,YSASN,YSASAGE,X,Y,C1,C2,C3,YSASS,YSASC,YSASMSG

 S YSASIEN=YSASIEN_",",C1=24,C2=40,C3=55,YSASOK=1,YSASMSG=""

 S YSASN=$$F("NAME"),YSASAGE=$$F("NAME:AGE"),YSASNA=YSASN_"  ("_YSASAGE_")"

 W:$D(IOF) @IOF

 W !,YSASNA,?C2,"Composite"

 W !,$TR($J("",$L(YSASNA))," ","-"),?C2,"Scores"

 W !," Adm: ",$$F(1),?C2,"--------"

 S YSASC=$$F(.61)

 W !," Int: ",$$F(.05),?C1,"    MEDICAL",?C2,$S(YSASC="":"  ----",1:YSASC)

 S YSASC=$$F(.62)

 S X=$$F(.09)

 W !,"  By: ",$S(X]"":$P(X,","),1:"<INCOMPLETE>"),?C1," EMPLOYMENT",?C2,$S(YSASC="":"  ----",1:YSASC)

 S YSASC=$$F(.63)

 W !?C1,"    ALCOHOL",?C2,$S(YSASC="":"  ----",1:YSASC)

 S YSASC=$$F(.635)

 W !?C1,"       DRUG",?C2,$S(YSASC="":"  ----",1:YSASC)

 S YSASC=$$F(.64)

 W !?C1,"      LEGAL",?C2,$S(YSASC="":"  ----",1:YSASC)

 S YSASC=$$F(.65)

 W !?C1,"     FAMILY",?C2,$S(YSASC="":"  ----",1:YSASC)

 S YSASC=$$F(.66)

 W !?C1,"PSYCHIATRIC",?C2,$S(YSASC="":"  ----",1:YSASC)

F(YSASFLD) ;Pass field name - IEN is expected to be in YSASIEN

 N DIERR

 Q:$G(YSASFLD)=""

 Q $$GET1^DIQ(604,YSASIEN,YSASFLD)

CHECKALL(YSASIEN,YSFLAG) ; all reqiured fields

 ;ysflag 1= ok 0= missing 2= X OR N

 N N1,YSASCLS,X,YSASFLD,YSF

 S YSFLAG=1

 S YSASCLS=$$GET1^DIQ(604,YSASIEN_",",.04,"I")

 S YSASCLS=YSASCLS+3

 S N1=0 F  S N1=$O(^YSTX(604.66,N1)) Q:N1'>0  D:($P(^YSTX(604.66,N1,0),U,8)&($P(^YSTX(604.66,N1,0),U,YSASCLS)))  Q:YSFLAG=0

 . S YSASFLD=$P(^YSTX(604.66,N1,0),U,3)

 . S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",$P(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")

 . S X=$$GET1^DIQ(604,YSASIEN,YSASFLD,YSF)

 . S:X="" YSFLAG=0

 . S:X="X"!(X="N") YSFLAG=2

TESTIT ;

 S YSASIEN=72 D CHECKALL(YSASIEN,.YSFLAG)

  W !,"YSFLAG=",YSFLAG D:YSFLAG'=1 REPTMSG(YSASIEN)

REPTMSG(YSASIEN) ;report missing requires

 N N1,X,YSASFLD,YSASCLS,YSF

 S YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05)

 S YSASPT=$$GET1^DIQ(604,YSASIEN_",",.02)

 S YSASCLS=$$GET1^DIQ(604,YSASIEN_",",.04,"I")

 S YSASCLS=YSASCLS+3

 W @IOF,YSASPT," interviewed on ",YSASDT,!,"Required ASI Items    M=missing, X= not answered, N= not applicable",!

 S N1=0 F  S N1=$O(^YSTX(604.66,N1)) Q:N1'>0  D:($P(^YSTX(604.66,N1,0),U,8)&($P(^YSTX(604.66,N1,0),U,YSASCLS)))

 . S YSASFLD=$P(^YSTX(604.66,N1,0),U,3)

 . S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",$P(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")

 . S X=$$GET1^DIQ(604,YSASIEN,YSASFLD,YSF)

 . D:X=""!(X="N")!(X="X")

 .. W:$X>60 !

 .. W $J($P(^YSTX(604.66,N1,0),U,11)_":"_$S(X="":"M",1:X),10)

 W ! K DIR S DIR(0)="E" D ^DIR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASO2   2747     printed  Mar 13, 2025@21:18                                                                                                                                                                                                         Page 2

YSASO2    ;692/DCL-ASI/ASF COMPOSITE SCORES FOR LITE ;5/22/97  11:10

 +1       ;;5.01;MENTAL HEALTH;**24,30**;Dec 30, 1994

 +2        QUIT

OUT3(YSASIEN,YSASOK) ;Entry Point pass IEN from file 604 FOR LITE

 +1        if $GET(YSASIEN)'>0

               QUIT

 +2        NEW YSASY,YSASSR,YSASCS,YSASN,YSASAGE,X,Y,C1,C2,C3,YSASS,YSASC,YSASMSG

 +3        SET YSASIEN=YSASIEN_","

           SET C1=24

           SET C2=40

           SET C3=55

           SET YSASOK=1

           SET YSASMSG=""

 +4        SET YSASN=$$F("NAME")

           SET YSASAGE=$$F("NAME:AGE")

           SET YSASNA=YSASN_"  ("_YSASAGE_")"

 +5        if $DATA(IOF)

               WRITE @IOF

 +6        WRITE !,YSASNA,?C2,"Composite"

 +7        WRITE !,$TRANSLATE($JUSTIFY("",$LENGTH(YSASNA))," ","-"),?C2,"Scores"

 +8        WRITE !," Adm: ",$$F(1),?C2,"--------"

 +9        SET YSASC=$$F(.61)

 +10       WRITE !," Int: ",$$F(.05),?C1,"    MEDICAL",?C2,$SELECT(YSASC="":"  ----",1:YSASC)

 +11       SET YSASC=$$F(.62)

 +12       SET X=$$F(.09)

 +13       WRITE !,"  By: ",$SELECT(X]"":$PIECE(X,","),1:"<INCOMPLETE>"),?C1," EMPLOYMENT",?C2,$SELECT(YSASC="":"  ----",1:YSASC)

 +14       SET YSASC=$$F(.63)

 +15       WRITE !?C1,"    ALCOHOL",?C2,$SELECT(YSASC="":"  ----",1:YSASC)

 +16       SET YSASC=$$F(.635)

 +17       WRITE !?C1,"       DRUG",?C2,$SELECT(YSASC="":"  ----",1:YSASC)

 +18       SET YSASC=$$F(.64)

 +19       WRITE !?C1,"      LEGAL",?C2,$SELECT(YSASC="":"  ----",1:YSASC)

 +20       SET YSASC=$$F(.65)

 +21       WRITE !?C1,"     FAMILY",?C2,$SELECT(YSASC="":"  ----",1:YSASC)

 +22       SET YSASC=$$F(.66)

 +23       WRITE !?C1,"PSYCHIATRIC",?C2,$SELECT(YSASC="":"  ----",1:YSASC)

 +24       QUIT

 +25      ;

F(YSASFLD) ;Pass field name - IEN is expected to be in YSASIEN

 +1        NEW DIERR

 +2        if $GET(YSASFLD)=""

               QUIT

 +3        QUIT $$GET1^DIQ(604,YSASIEN,YSASFLD)

 +4       ;

CHECKALL(YSASIEN,YSFLAG) ; all reqiured fields

 +1       ;ysflag 1= ok 0= missing 2= X OR N

 +2        NEW N1,YSASCLS,X,YSASFLD,YSF

 +3        SET YSFLAG=1

 +4        SET YSASCLS=$$GET1^DIQ(604,YSASIEN_",",.04,"I")

 +5        SET YSASCLS=YSASCLS+3

 +6        SET N1=0

FOR

               SET N1=$ORDER(^YSTX(604.66,N1))

               if N1'>0

                   QUIT

               if ($PIECE(^YSTX(604.66,N1,0),U,8)&($PIECE(^YSTX(604.66,N1,0),U,YSASCLS)))

                   Begin DoDot:1

 +7                    SET YSASFLD=$PIECE(^YSTX(604.66,N1,0),U,3)

 +8                    SET YSF=$SELECT(YSASFLD>10.02&(YSASFLD<10.44):"I",$PIECE(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")

 +9                    SET X=$$GET1^DIQ(604,YSASIEN,YSASFLD,YSF)

 +10                   if X=""

                           SET YSFLAG=0

 +11                   if X="X"!(X="N")

                           SET YSFLAG=2

                   End DoDot:1

               if YSFLAG=0

                   QUIT

 +12      ;

 +13       QUIT

TESTIT    ;

 +1        SET YSASIEN=72

           DO CHECKALL(YSASIEN,.YSFLAG)

 +2        WRITE !,"YSFLAG=",YSFLAG

           if YSFLAG'=1

               DO REPTMSG(YSASIEN)

 +3        QUIT

 +4        QUIT

REPTMSG(YSASIEN) ;report missing requires

 +1        NEW N1,X,YSASFLD,YSASCLS,YSF

 +2        SET YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05)

 +3        SET YSASPT=$$GET1^DIQ(604,YSASIEN_",",.02)

 +4        SET YSASCLS=$$GET1^DIQ(604,YSASIEN_",",.04,"I")

 +5        SET YSASCLS=YSASCLS+3

 +6        WRITE @IOF,YSASPT," interviewed on ",YSASDT,!,"Required ASI Items    M=missing, X= not answered, N= not applicable",!

 +7        SET N1=0

FOR

               SET N1=$ORDER(^YSTX(604.66,N1))

               if N1'>0

                   QUIT

               if ($PIECE(^YSTX(604.66,N1,0),U,8)&($PIECE(^YSTX(604.66,N1,0),U,YSASCLS)))

                   Begin DoDot:1

 +8                    SET YSASFLD=$PIECE(^YSTX(604.66,N1,0),U,3)

 +9                    SET YSF=$SELECT(YSASFLD>10.02&(YSASFLD<10.44):"I",$PIECE(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")

 +10                   SET X=$$GET1^DIQ(604,YSASIEN,YSASFLD,YSF)

 +11                   if X=""!(X="N")!(X="X")

                           Begin DoDot:2

 +12                           if $X>60

                                   WRITE !

 +13                           WRITE $JUSTIFY($PIECE(^YSTX(604.66,N1,0),U,11)_":"_$SELECT(X="":"M",1:X),10)

                           End DoDot:2

                   End DoDot:1

 +14      ;

 +15       WRITE !

           KILL DIR

           SET DIR(0)="E"

           DO ^DIR

 +16       QUIT

YSASO2.m