YSASGPH ;ALB/ASF,HIOFO/FT - ASI MULTIPLE OUTPUT ;1/30/13 11:20pm
;;5.01;MENTAL HEALTH;**24,30,37,121**;Dec 30, 1994;Build 61
;Reference to ^XUTMDEVQ supported by DBIA #1519
;Reference to ^DPT( supported by DBIA #10035
;Reference to VADPT APIs supported by DBIA #10061
;Reference to ^%ZIS supported by IA #10086
;Reference to ^XLFDT APIs supported by DBIA #10103
Q
EN ;entry point for YSAS ASI COMPOSITE SCORES option
N YSASPIEN
D PT
Q:YSASPIEN'>0
I '$D(^YSTX(604,"C",YSASPIEN)) W !,"No ASIs found for this patient.",! Q
W !
N ZTRTN,ZTDESC,ZTSAVE
S ZTRTN="ENQ^YSASGPH",ZTDESC="YSASGPH ASI COMPOSITE PRINT",ZTSAVE("YSASPIEN")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"")
D HOME^%ZIS
Q
ENQ ;queue task entry
U IO
S:$D(ZTQUEUED) ZTREQ="@"
N I,G,G1,G2,N
N YSASC,YSASCL,YSASDT,YSASIG,YSASINT
D TLD
D TLP
D GR,GR2
K ^TMP($J,"YSASI")
Q
;D ^%ZISC
Q
PT ;patient lookup
N DIC
S DIC="^DPT(",DIC(0)="AEMQ"
D ^DIC
S YSASPIEN=+Y
Q
TLD ;load ASI list
K ^TMP($J,"YSASI")
N YSASIEN
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"))
N DFN
S DFN=YSASPIEN D DEM^VADPT
W:$Y>0 @IOF
W !,VADM(1)," ","xxx-xx-"_$E($P(VADM(2),U,2),8,11),?$X+5,"ASI Composite Scores",!
D KVA^VADPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASGPH 2748 printed Sep 23, 2025@19:49:14 Page 2
YSASGPH ;ALB/ASF,HIOFO/FT - ASI MULTIPLE OUTPUT ;1/30/13 11:20pm
+1 ;;5.01;MENTAL HEALTH;**24,30,37,121**;Dec 30, 1994;Build 61
+2 ;Reference to ^XUTMDEVQ supported by DBIA #1519
+3 ;Reference to ^DPT( supported by DBIA #10035
+4 ;Reference to VADPT APIs supported by DBIA #10061
+5 ;Reference to ^%ZIS supported by IA #10086
+6 ;Reference to ^XLFDT APIs supported by DBIA #10103
+7 QUIT
EN ;entry point for YSAS ASI COMPOSITE SCORES option
+1 NEW YSASPIEN
+2 DO PT
+3 if YSASPIEN'>0
QUIT
+4 IF '$DATA(^YSTX(604,"C",YSASPIEN))
WRITE !,"No ASIs found for this patient.",!
QUIT
+5 WRITE !
+6 NEW ZTRTN,ZTDESC,ZTSAVE
+7 SET ZTRTN="ENQ^YSASGPH"
SET ZTDESC="YSASGPH ASI COMPOSITE PRINT"
SET ZTSAVE("YSASPIEN")=""
+8 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"")
+9 DO HOME^%ZIS
+10 QUIT
ENQ ;queue task entry
+1 USE IO
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 NEW I,G,G1,G2,N
+4 NEW YSASC,YSASCL,YSASDT,YSASIG,YSASINT
+5 DO TLD
+6 DO TLP
+7 DO GR
DO GR2
+8 KILL ^TMP($JOB,"YSASI")
+9 QUIT
+10 ;D ^%ZISC
+11 QUIT
PT ;patient lookup
+1 NEW DIC
+2 SET DIC="^DPT("
SET DIC(0)="AEMQ"
+3 DO ^DIC
+4 SET YSASPIEN=+Y
+5 QUIT
TLD ;load ASI list
+1 KILL ^TMP($JOB,"YSASI")
+2 NEW YSASIEN
+3 SET YSASIEN=0
SET YSASC=0
+4 FOR
SET YSASIEN=$ORDER(^YSTX(604,"C",YSASPIEN,YSASIEN))
if YSASIEN'>0
QUIT
Begin DoDot:1
+5 SET YSASC=YSASC+1
+6 if IOST?1"C".E
WRITE "."
+7 SET YSASCL=$$GET1^DIQ(604,YSASIEN_",",.04)
+8 SET YSASDT=$$GET1^DIQ(604,YSASIEN_",",.05,"I")
+9 SET YSASINT=$$GET1^DIQ(604,YSASIEN_",",.09)
+10 SET YSASIG=$$GET1^DIQ(604,YSASIEN_",",.51,"I")
+11 SET ^TMP($JOB,"YSASI",YSASC)=YSASIEN_U_YSASDT_U_YSASCL_U_YSASINT_U_YSASIG_U
+12 ;MED
SET ^TMP($JOB,"YSASI",YSASC)=^TMP($JOB,"YSASI",YSASC)_$$CSMS^YSASCSA(YSASIEN)_U
+13 ;EMP
SET ^TMP($JOB,"YSASI",YSASC)=^TMP($JOB,"YSASI",YSASC)_$$CSES^YSASCSA(YSASIEN)_U
+14 ;ALCO
SET ^TMP($JOB,"YSASI",YSASC)=^TMP($JOB,"YSASI",YSASC)_$$CSA^YSASCSA(YSASIEN)_U
+15 ;DRUG
SET ^TMP($JOB,"YSASI",YSASC)=^TMP($JOB,"YSASI",YSASC)_$$CSD^YSASCSA(YSASIEN)_U
+16 ;LEGAL
SET ^TMP($JOB,"YSASI",YSASC)=^TMP($JOB,"YSASI",YSASC)_$$CSLS^YSASCSA(YSASIEN)_U
+17 ;FAM
SET ^TMP($JOB,"YSASI",YSASC)=^TMP($JOB,"YSASI",YSASC)_$$CSFSR^YSASCSA(YSASIEN)_U
+18 ;PSY
SET ^TMP($JOB,"YSASI",YSASC)=^TMP($JOB,"YSASI",YSASC)_$$CSPS^YSASCSA(YSASIEN)_U
End DoDot:1
+19 ;
+20 QUIT
GR ;LOOP OUTPUT
+1 WRITE !,"Date Medical Emp/Sup Alcohol Drug Legal Family Psych"
+2 SET N=0
FOR
SET N=$ORDER(^TMP($JOB,"YSASI",N))
if N'>0
QUIT
DO GR1
+3 QUIT
GR1 ;output loop
+1 SET G=^TMP($JOB,"YSASI",N)
+2 WRITE !,$$FMTE^XLFDT($PIECE(G,U,2),"5ZD")
+3 FOR I=6:1:12
WRITE $SELECT($PIECE(G,U,I)?.E1N.E:$JUSTIFY($PIECE(G,U,I),9,2),1:$JUSTIFY("--",9))
+4 if $PIECE(G,U,5)'=1
WRITE " unsigned"
+5 QUIT
GR2 ;change scores
+1 if YSASC=1
QUIT
+2 WRITE !!,"Change "
+3 FOR I=6:1:12
Begin DoDot:1
+4 SET G1=$PIECE(^TMP($JOB,"YSASI",YSASC),U,I)
SET G2=$PIECE(^TMP($JOB,"YSASI",1),U,I)
+5 WRITE $SELECT(G1=""!(G2=""):$JUSTIFY("--",9),1:$JUSTIFY(G1-G2,9,2))
End DoDot:1
+6 QUIT
TLP ; print list
+1 if '$DATA(^TMP($JOB,"YSASI"))
QUIT
+2 NEW DFN
+3 SET DFN=YSASPIEN
DO DEM^VADPT
+4 if $Y>0
WRITE @IOF
+5 WRITE !,VADM(1)," ","xxx-xx-"_$EXTRACT($PIECE(VADM(2),U,2),8,11),?$X+5,"ASI Composite Scores",!
+6 DO KVA^VADPT
+7 QUIT
