- 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 Mar 13, 2025@21:18:10 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)
