79 lines
2.3 KiB
Mathematica
79 lines
2.3 KiB
Mathematica
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
|