YSASGPH ;ALB/ASF-ASI MULTIPLE OUTPUT ;2/25/97  14:05
 ;;5.01;MENTAL HEALTH;**24,30,37**;Dec 30, 1994
 Q
EN ;
 D PT
 Q:YSASPIEN'>0
 I '$D(^YSTX(604,"C",YSASPIEN)) W !,"No ASIs found for this patient" Q
 W !
 ;ASK DEVICE 
 N YSASQUIT,%ZIS,POP
 S %ZIS="QM"
 D ^%ZIS
 Q:$G(POP)
 I $D(IO("Q")) D  Q
 .N ZTRTN,ZTDESC,ZTSAVE
 .S ZTRTN="ENQ^YSASGPH"
 .S ZTDESC="YSASGPH ASI COMPOSITE PRINT"
 .S ZTSAVE("YSASPIEN")=""
 .D ^%ZTLOAD
 .D HOME^%ZIS
 .Q
 U IO
ENQ ;que task entry
 S:$D(ZTQUEUED) ZTREQ="@"
 N YSASC,YSASCL,YSASDT,YSASIG,YSASINT,YSASQUIT
 D TLD
 D TLP
 D GR,GR2
 D ^%ZISC
 Q
PT ;patient lookup
 S DIC="^DPT(",DIC(0)="AEMQ"
 D ^DIC
 S YSASPIEN=+Y
 Q
TLD ;load ASI list
 K ^TMP($J,"YSASI")
 S YSASIEN=0,YSASC=0
 F  S YSASIEN=$O(^YSTX(604,"C",YSASPIEN,YSASIEN)) Q:YSASIEN'>0  D
 . S YSASC=YSASC+1
 . W:IOST?1"C".E "."
 . S YSASCL=$$GET1^DIQ(604,YSASIEN_",",.04)
 . S YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05,"I")
 . S YSASINT=$$GET1^DIQ(604,YSASIEN_",",.09)
 . S YSASIG=$$GET1^DIQ(604,YSASIEN_",",.51,"I")
 . S ^TMP($J,"YSASI",YSASC)=YSASIEN_U_YSASDT_U_YSASCL_U_YSASINT_U_YSASIG_U
 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSMS^YSASCSA(YSASIEN)_U ;MED
 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSES^YSASCSA(YSASIEN)_U ;EMP
 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSA^YSASCSA(YSASIEN)_U ;ALCO
 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSD^YSASCSA(YSASIEN)_U ;DRUG
 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSLS^YSASCSA(YSASIEN)_U ;LEGAL
 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSFSR^YSASCSA(YSASIEN)_U ;FAM
 . S ^TMP($J,"YSASI",YSASC)=^TMP($J,"YSASI",YSASC)_$$CSPS^YSASCSA(YSASIEN)_U ;PSY
 ;
 Q
GR ;LOOP OUTPUT
 W !,"Date        Medical  Emp/Sup  Alcohol    Drug    Legal    Family   Psych"
 S N=0 F  S N=$O(^TMP($J,"YSASI",N)) Q:N'>0  D GR1
 Q
GR1 ;output loop
 S G=^TMP($J,"YSASI",N)
 W !,$$FMTE^XLFDT($P(G,U,2),"5ZD")
 F I=6:1:12 W $S($P(G,U,I)?.E1N.E:$J($P(G,U,I),9,2),1:$J("--",9))
 W:$P(G,U,5)'=1 " unsigned"
 Q
GR2 ;change scores
 Q:YSASC=1
 W !!,"Change   "
 F I=6:1:12 D
 . S G1=$P(^TMP($J,"YSASI",YSASC),U,I),G2=$P(^TMP($J,"YSASI",1),U,I)
 . W $S(G1=""!(G2=""):$J("--",9),1:$J(G1-G2,9,2))
 Q
TLP ; print list
 Q:'$D(^TMP($J,"YSASI"))
 S DFN=YSASPIEN D DEM^VADPT
 W @IOF
 W !,VADM(1),"   ",$P(VADM(2),U,2),?$X+5,"ASI Composite Scores",!
 Q