source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASO2.m@ 1801

Last change on this file since 1801 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1YSASO2 ;692/DCL-ASI/ASF COMPOSITE SCORES FOR LITE ;5/22/97 11:10
2 ;;5.01;MENTAL HEALTH;**24,30**;Dec 30, 1994
3 Q
4OUT3(YSASIEN,YSASOK) ;Entry Point pass IEN from file 604 FOR LITE
5 Q:$G(YSASIEN)'>0
6 N YSASY,YSASSR,YSASCS,YSASN,YSASAGE,X,Y,C1,C2,C3,YSASS,YSASC,YSASMSG
7 S YSASIEN=YSASIEN_",",C1=24,C2=40,C3=55,YSASOK=1,YSASMSG=""
8 S YSASN=$$F("NAME"),YSASAGE=$$F("NAME:AGE"),YSASNA=YSASN_" ("_YSASAGE_")"
9 W:$D(IOF) @IOF
10 W !,YSASNA,?C2,"Composite"
11 W !,$TR($J("",$L(YSASNA))," ","-"),?C2,"Scores"
12 W !," Adm: ",$$F(1),?C2,"--------"
13 S YSASC=$$F(.61)
14 W !," Int: ",$$F(.05),?C1," MEDICAL",?C2,$S(YSASC="":" ----",1:YSASC)
15 S YSASC=$$F(.62)
16 S X=$$F(.09)
17 W !," By: ",$S(X]"":$P(X,","),1:"<INCOMPLETE>"),?C1," EMPLOYMENT",?C2,$S(YSASC="":" ----",1:YSASC)
18 S YSASC=$$F(.63)
19 W !?C1," ALCOHOL",?C2,$S(YSASC="":" ----",1:YSASC)
20 S YSASC=$$F(.635)
21 W !?C1," DRUG",?C2,$S(YSASC="":" ----",1:YSASC)
22 S YSASC=$$F(.64)
23 W !?C1," LEGAL",?C2,$S(YSASC="":" ----",1:YSASC)
24 S YSASC=$$F(.65)
25 W !?C1," FAMILY",?C2,$S(YSASC="":" ----",1:YSASC)
26 S YSASC=$$F(.66)
27 W !?C1,"PSYCHIATRIC",?C2,$S(YSASC="":" ----",1:YSASC)
28 Q
29 ;
30F(YSASFLD) ;Pass field name - IEN is expected to be in YSASIEN
31 N DIERR
32 Q:$G(YSASFLD)=""
33 Q $$GET1^DIQ(604,YSASIEN,YSASFLD)
34 ;
35CHECKALL(YSASIEN,YSFLAG) ; all reqiured fields
36 ;ysflag 1= ok 0= missing 2= X OR N
37 N N1,YSASCLS,X,YSASFLD,YSF
38 S YSFLAG=1
39 S YSASCLS=$$GET1^DIQ(604,YSASIEN_",",.04,"I")
40 S YSASCLS=YSASCLS+3
41 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
42 . S YSASFLD=$P(^YSTX(604.66,N1,0),U,3)
43 . S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",$P(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")
44 . S X=$$GET1^DIQ(604,YSASIEN,YSASFLD,YSF)
45 . S:X="" YSFLAG=0
46 . S:X="X"!(X="N") YSFLAG=2
47 ;
48 Q
49TESTIT ;
50 S YSASIEN=72 D CHECKALL(YSASIEN,.YSFLAG)
51 W !,"YSFLAG=",YSFLAG D:YSFLAG'=1 REPTMSG(YSASIEN)
52 Q
53 Q
54REPTMSG(YSASIEN) ;report missing requires
55 N N1,X,YSASFLD,YSASCLS,YSF
56 S YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05)
57 S YSASPT=$$GET1^DIQ(604,YSASIEN_",",.02)
58 S YSASCLS=$$GET1^DIQ(604,YSASIEN_",",.04,"I")
59 S YSASCLS=YSASCLS+3
60 W @IOF,YSASPT," interviewed on ",YSASDT,!,"Required ASI Items M=missing, X= not answered, N= not applicable",!
61 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)))
62 . S YSASFLD=$P(^YSTX(604.66,N1,0),U,3)
63 . S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",$P(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")
64 . S X=$$GET1^DIQ(604,YSASIEN,YSASFLD,YSF)
65 . D:X=""!(X="N")!(X="X")
66 .. W:$X>60 !
67 .. W $J($P(^YSTX(604.66,N1,0),U,11)_":"_$S(X="":"M",1:X),10)
68 ;
69 W ! K DIR S DIR(0)="E" D ^DIR
70 Q
Note: See TracBrowser for help on using the repository browser.