YSASU ;ASF/ALB,HIOFO/FT - ASI MANAGEMENT REPORTS ;2/7/13 9:50am
;;5.01;MENTAL HEALTH;**38,121**;Dec 30, 1994;Build 61
;Reference to ^DPT supported by IA #10035
;Reference to %ZTLOAD APIs supported by DBIA #10063
;Reference to %ZISC supported by IA #10089
;Reference to FILE 4 fields supported by DBIA #10090
;Reference to $$SITE^VASITE supported by IA #10112
MAIN ;entry point for YSAS MANAGEMENT REPORT option
K ^TMP("YSASU",$J) N G,G0,G5,GP5,J,N,Y,YSASBDT,YSASCNT,YSASCNT2,YSASDT,YSASEDT,YSASITE,YSASMCNT,YSASMTC,YSASN,YSASS,YSAWAIT,YSCLASS,YSFL,YSIFN,YSLOC,YSNAME,YSSIGND,YSTOT,YSSPEC,YSTRANS
W @IOF,!?10,"Addiction Severity Index",!?15,"Site Report by Date"
D DTRANGE Q:YSASBDT=""!(YSASEDT="")
W !!,"Results returned via Mailman. Please queue this report for after hours."
QUEUE ;
;S YSASITE=$P(^DIC(4,+^YSTX(604.8,1,0),0),U)
S YSASITE=$$SITE()
N IOP,ZTDESC,ZTIO,ZTRTN,ZTSAVE
S ZTIO="",ZTSAVE("YSAS*")="",ZTRTN="ENQ^YSASU",ZTDESC="YSAS ASI SITE REPORT" D ^%ZTLOAD
I '$D(ZTSK) Q
W !!,"Your Task Number is "_ZTSK D ^%ZISC
Q
ENQ ;queue entry
S:$D(ZTQUEUED) ZTREQ="@"
D FINDIT
D BUILDIT
D PTLST^YSASU1
D MAIL2^YSASU1
Q
ZZ S N=0 F S N=$O(^TMP("YSASU",$J,"M",N)) Q:N'>0 W !,^(N)
Q
DTRANGE ;date range
N %DT
W ! S (YSASBDT,YSASEDT)="",%DT("A")="Beginning Date for ASI Range: ",%DT="AEX" D ^%DT
Q:Y'>0
S YSASBDT=+Y
W ! S %DT("A")="Ending Date for ASI Range: " D ^%DT
Q:Y'>0
S YSASEDT=+Y
I (YSASEDT>0)&(YSASEDT<YSASBDT) W !,?7,"Ending Date must be closer to today than Beginning Date",! H 2 W $C(7) G DTRANGE
Q
FINDIT ; loop thru 604 by date
S (YSCLASS(-1),YSCLASS(1),YSCLASS(2),YSCLASS(3),YSTOT,YSSPEC(-1),YSSPEC(1),YSSPEC(2),YSSPEC(3),YSSPEC("N"),YSSIGND(0),YSSIGND(1),YSAWAIT(0),YSAWAIT(1),YSTRANS(0),YSTRANS(1))=0
S YSASDT=YSASBDT-.001 F S YSASDT=$O(^YSTX(604,"AD",YSASDT)) Q:YSASDT'>0!(YSASDT>YSASEDT) S YSIFN=0 F S YSIFN=$O(^YSTX(604,"AD",YSASDT,YSIFN)) Q:YSIFN'>0 D
. S G0=$G(^YSTX(604,YSIFN,0)),GP5=$G(^YSTX(604,YSIFN,.5)),G5=$G(^YSTX(604,YSIFN,5))
. ;1=date interview 2=dfn 3=class 4=special 5=interviewer 6=e signed 7=e sig 8= awaiting trans 9= trans date
. IF $P(G0,U,2)>0 S YSNAME=$P(^DPT($P(G0,U,2),0),U)
. IF $P(G0,U,2)="" S YSNAME="unknown "_YSIFN
. S ^TMP("YSASU",$J,"A",YSNAME,YSIFN)=""
. S ^TMP("YSASU",$J,YSIFN)=YSASDT_U_$P(G0,U,2)_U_$P(G0,U,4)_U_$P(G0,U,11)_U_$P(G0,U,9)_U_$P(GP5,U,1)_U_$P(GP5,U,2)_U_$P(G5,U,3)_U_$P(G5,U,4)
. S YSTOT=$G(YSTOT)+1
. S G=$P(G0,U,4) S:G="" G=-1 S YSCLASS(G)=$G(YSCLASS(G))+1
. S G=$P(G0,U,11) S:G="" G=-1 S YSSPEC(G)=$G(YSSPEC(G))+1
. S G=$P($G(GP5),U,1) S:G="" G=0 S YSSIGND(G)=$G(YSSIGND(G))+1
. S G=$P($G(G5),U,3) S:G="" G=0 S YSAWAIT(G)=$G(YSAWAIT(G))+1
. S G=$P($G(G5),U,4),G=$S(G="":0,1:1),YSTRANS(G)=$G(YSTRANS(G))+1
Q
BUILDIT ;build output tmp
K ^TMP("YSASU",$J,"M") S YSASN=0,YSASS="",$P(YSASS," ",79)=""
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=$E(YSASS,1,15)_"Addiction Severity Index Status Report"
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=" Facility: "_YSASITE
S Y=YSASBDT X ^DD("DD") S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)="Begining Date: "_Y
S Y=YSASEDT X ^DD("DD") S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=" Ending Date: "_Y
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=" "
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)="During this time period there were:"
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSTOT_" total entries"
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSCLASS(1)_" Full, "_YSCLASS(2)_" Lite, "_YSCLASS(3)_" Follow-up and "_YSCLASS(-1)_" Unspecified"
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSSPEC("N")_" Completed, "_YSSPEC(1)_" Terminated, "_YSSPEC(2)_" Refused, "_YSSPEC(3)_" Unable and "_YSSPEC(-1)_" Unspecified"
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSSIGND(1)_" were signed and "_YSSIGND(0)_" remain unsigned"
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSTRANS(1)_" were transmitted to the central database and "_YSTRANS(0)_" were not transmitted"
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSAWAIT(1)_" are in the queue for the next transmission"
S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=" "
Q
SITE() ;get site name
N YSDA
S YSDA=+$P($$SITE^VASITE,U)
Q $$GET1^DIQ(4,YSDA_",",.01)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASU 4233 printed Apr 09, 2024@21:21:07 Page 2
YSASU ;ASF/ALB,HIOFO/FT - ASI MANAGEMENT REPORTS ;2/7/13 9:50am
+1 ;;5.01;MENTAL HEALTH;**38,121**;Dec 30, 1994;Build 61
+2 ;Reference to ^DPT supported by IA #10035
+3 ;Reference to %ZTLOAD APIs supported by DBIA #10063
+4 ;Reference to %ZISC supported by IA #10089
+5 ;Reference to FILE 4 fields supported by DBIA #10090
+6 ;Reference to $$SITE^VASITE supported by IA #10112
MAIN ;entry point for YSAS MANAGEMENT REPORT option
+1 KILL ^TMP("YSASU",$JOB)
NEW G,G0,G5,GP5,J,N,Y,YSASBDT,YSASCNT,YSASCNT2,YSASDT,YSASEDT,YSASITE,YSASMCNT,YSASMTC,YSASN,YSASS,YSAWAIT,YSCLASS,YSFL,YSIFN,YSLOC,YSNAME,YSSIGND,YSTOT,YSSPEC,YSTRANS
+2 WRITE @IOF,!?10,"Addiction Severity Index",!?15,"Site Report by Date"
+3 DO DTRANGE
if YSASBDT=""!(YSASEDT="")
QUIT
+4 WRITE !!,"Results returned via Mailman. Please queue this report for after hours."
QUEUE ;
+1 ;S YSASITE=$P(^DIC(4,+^YSTX(604.8,1,0),0),U)
+2 SET YSASITE=$$SITE()
+3 NEW IOP,ZTDESC,ZTIO,ZTRTN,ZTSAVE
+4 SET ZTIO=""
SET ZTSAVE("YSAS*")=""
SET ZTRTN="ENQ^YSASU"
SET ZTDESC="YSAS ASI SITE REPORT"
DO ^%ZTLOAD
+5 IF '$DATA(ZTSK)
QUIT
+6 WRITE !!,"Your Task Number is "_ZTSK
DO ^%ZISC
+7 QUIT
ENQ ;queue entry
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO FINDIT
+3 DO BUILDIT
+4 DO PTLST^YSASU1
+5 DO MAIL2^YSASU1
+6 QUIT
ZZ SET N=0
FOR
SET N=$ORDER(^TMP("YSASU",$JOB,"M",N))
if N'>0
QUIT
WRITE !,^(N)
+1 QUIT
DTRANGE ;date range
+1 NEW %DT
+2 WRITE !
SET (YSASBDT,YSASEDT)=""
SET %DT("A")="Beginning Date for ASI Range: "
SET %DT="AEX"
DO ^%DT
+3 if Y'>0
QUIT
+4 SET YSASBDT=+Y
+5 WRITE !
SET %DT("A")="Ending Date for ASI Range: "
DO ^%DT
+6 if Y'>0
QUIT
+7 SET YSASEDT=+Y
+8 IF (YSASEDT>0)&(YSASEDT<YSASBDT)
WRITE !,?7,"Ending Date must be closer to today than Beginning Date",!
HANG 2
WRITE $CHAR(7)
GOTO DTRANGE
+9 QUIT
FINDIT ; loop thru 604 by date
+1 SET (YSCLASS(-1),YSCLASS(1),YSCLASS(2),YSCLASS(3),YSTOT,YSSPEC(-1),YSSPEC(1),YSSPEC(2),YSSPEC(3),YSSPEC("N"),YSSIGND(0),YSSIGND(1),YSAWAIT(0),YSAWAIT(1),YSTRANS(0),YSTRANS(1))=0
+2 SET YSASDT=YSASBDT-.001
FOR
SET YSASDT=$ORDER(^YSTX(604,"AD",YSASDT))
if YSASDT'>0!(YSASDT>YSASEDT)
QUIT
SET YSIFN=0
FOR
SET YSIFN=$ORDER(^YSTX(604,"AD",YSASDT,YSIFN))
if YSIFN'>0
QUIT
Begin DoDot:1
+3 SET G0=$GET(^YSTX(604,YSIFN,0))
SET GP5=$GET(^YSTX(604,YSIFN,.5))
SET G5=$GET(^YSTX(604,YSIFN,5))
+4 ;1=date interview 2=dfn 3=class 4=special 5=interviewer 6=e signed 7=e sig 8= awaiting trans 9= trans date
+5 IF $PIECE(G0,U,2)>0
SET YSNAME=$PIECE(^DPT($PIECE(G0,U,2),0),U)
+6 IF $PIECE(G0,U,2)=""
SET YSNAME="unknown "_YSIFN
+7 SET ^TMP("YSASU",$JOB,"A",YSNAME,YSIFN)=""
+8 SET ^TMP("YSASU",$JOB,YSIFN)=YSASDT_U_$PIECE(G0,U,2)_U_$PIECE(G0,U,4)_U_$PIECE(G0,U,11)_U_$PIECE(G0,U,9)_U_$PIECE(GP5,U,1)_U_$PIECE(GP5,U,2)_U_$PIECE(G5,U,3)_U_$PIECE(G5,U,4)
+9 SET YSTOT=$GET(YSTOT)+1
+10 SET G=$PIECE(G0,U,4)
if G=""
SET G=-1
SET YSCLASS(G)=$GET(YSCLASS(G))+1
+11 SET G=$PIECE(G0,U,11)
if G=""
SET G=-1
SET YSSPEC(G)=$GET(YSSPEC(G))+1
+12 SET G=$PIECE($GET(GP5),U,1)
if G=""
SET G=0
SET YSSIGND(G)=$GET(YSSIGND(G))+1
+13 SET G=$PIECE($GET(G5),U,3)
if G=""
SET G=0
SET YSAWAIT(G)=$GET(YSAWAIT(G))+1
+14 SET G=$PIECE($GET(G5),U,4)
SET G=$SELECT(G="":0,1:1)
SET YSTRANS(G)=$GET(YSTRANS(G))+1
End DoDot:1
+15 QUIT
BUILDIT ;build output tmp
+1 KILL ^TMP("YSASU",$JOB,"M")
SET YSASN=0
SET YSASS=""
SET $PIECE(YSASS," ",79)=""
+2 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=$EXTRACT(YSASS,1,15)_"Addiction Severity Index Status Report"
+3 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=" Facility: "_YSASITE
+4 SET Y=YSASBDT
XECUTE ^DD("DD")
SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)="Begining Date: "_Y
+5 SET Y=YSASEDT
XECUTE ^DD("DD")
SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=" Ending Date: "_Y
+6 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=" "
+7 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)="During this time period there were:"
+8 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=YSTOT_" total entries"
+9 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=YSCLASS(1)_" Full, "_YSCLASS(2)_" Lite, "_YSCLASS(3)_" Follow-up and "_YSCLASS(-1)_" Unspecified"
+10 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=YSSPEC("N")_" Completed, "_YSSPEC(1)_" Terminated, "_YSSPEC(2)_" Refused, "_YSSPEC(3)_" Unable and "_YSSPEC(-1)_" Unspecified"
+11 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=YSSIGND(1)_" were signed and "_YSSIGND(0)_" remain unsigned"
+12 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=YSTRANS(1)_" were transmitted to the central database and "_YSTRANS(0)_" were not transmitted"
+13 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=YSAWAIT(1)_" are in the queue for the next transmission"
+14 SET YSASN=YSASN+1
SET ^TMP("YSASU",$JOB,"M",YSASN)=" "
+15 QUIT
SITE() ;get site name
+1 NEW YSDA
+2 SET YSDA=+$PIECE($$SITE^VASITE,U)
+3 QUIT $$GET1^DIQ(4,YSDA_",",.01)
