source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASGPH.m@ 699

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1YSASGPH ;ALB/ASF-ASI MULTIPLE OUTPUT ;2/25/97 14:05
2 ;;5.01;MENTAL HEALTH;**24,30,37**;Dec 30, 1994
3 Q
4EN ;
5 D PT
6 Q:YSASPIEN'>0
7 I '$D(^YSTX(604,"C",YSASPIEN)) W !,"No ASIs found for this patient" Q
8 W !
9 ;ASK DEVICE
10 N YSASQUIT,%ZIS,POP
11 S %ZIS="QM"
12 D ^%ZIS
13 Q:$G(POP)
14 I $D(IO("Q")) D Q
15 .N ZTRTN,ZTDESC,ZTSAVE
16 .S ZTRTN="ENQ^YSASGPH"
17 .S ZTDESC="YSASGPH ASI COMPOSITE PRINT"
18 .S ZTSAVE("YSASPIEN")=""
19 .D ^%ZTLOAD
20 .D HOME^%ZIS
21 .Q
22 U IO
23ENQ ;que task entry
24 S:$D(ZTQUEUED) ZTREQ="@"
25 N YSASC,YSASCL,YSASDT,YSASIG,YSASINT,YSASQUIT
26 D TLD
27 D TLP
28 D GR,GR2
29 D ^%ZISC
30 Q
31PT ;patient lookup
32 S DIC="^DPT(",DIC(0)="AEMQ"
33 D ^DIC
34 S YSASPIEN=+Y
35 Q
36TLD ;load ASI list
37 K ^TMP($J,"YSASI")
38 S YSASIEN=0,YSASC=0
39 F S YSASIEN=$O(^YSTX(604,"C",YSASPIEN,YSASIEN)) Q:YSASIEN'>0 D
40 . S YSASC=YSASC+1
41 . W:IOST?1"C".E "."
42 . S YSASCL=$$GET1^DIQ(604,YSASIEN_",",.04)
43 . S YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05,"I")
44 . S YSASINT=$$GET1^DIQ(604,YSASIEN_",",.09)
45 . S YSASIG=$$GET1^DIQ(604,YSASIEN_",",.51,"I")
46 . S ^TMP($J,"YSASI",YSASC)=YSASIEN_U_YSASDT_U_YSASCL_U_YSASINT_U_YSASIG_U
47 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSMS^YSASCSA(YSASIEN)_U ;MED
48 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSES^YSASCSA(YSASIEN)_U ;EMP
49 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSA^YSASCSA(YSASIEN)_U ;ALCO
50 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSD^YSASCSA(YSASIEN)_U ;DRUG
51 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSLS^YSASCSA(YSASIEN)_U ;LEGAL
52 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSFSR^YSASCSA(YSASIEN)_U ;FAM
53 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSPS^YSASCSA(YSASIEN)_U ;PSY
54 ;
55 Q
56GR ;LOOP OUTPUT
57 W !,"Date Medical Emp/Sup Alcohol Drug Legal Family Psych"
58 S N=0 F S N=$O(^TMP($J,"YSASI",N)) Q:N'>0 D GR1
59 Q
60GR1 ;output loop
61 S G=^TMP($J,"YSASI",N)
62 W !,$$FMTE^XLFDT($P(G,U,2),"5ZD")
63 F I=6:1:12 W $S($P(G,U,I)?.E1N.E:$J($P(G,U,I),9,2),1:$J("--",9))
64 W:$P(G,U,5)'=1 " unsigned"
65 Q
66GR2 ;change scores
67 Q:YSASC=1
68 W !!,"Change "
69 F I=6:1:12 D
70 . S G1=$P(^TMP($J,"YSASI",YSASC),U,I),G2=$P(^TMP($J,"YSASI",1),U,I)
71 . W $S(G1=""!(G2=""):$J("--",9),1:$J(G1-G2,9,2))
72 Q
73TLP ; print list
74 Q:'$D(^TMP($J,"YSASI"))
75 S DFN=YSASPIEN D DEM^VADPT
76 W @IOF
77 W !,VADM(1)," ",$P(VADM(2),U,2),?$X+5,"ASI Composite Scores",!
78 Q
Note: See TracBrowser for help on using the repository browser.