source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASU.m@ 1166

Last change on this file since 1166 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1YSASU ;ASF/ALB-ASI MANAGEMENT REPORTS ;2/4/98 10:27
2 ;;5.01;MENTAL HEALTH;**38**;Dec 30, 1994
3MAIN ;
4 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
5 W @IOF,!?10,"Addiction Severity Index",!?15,"Site Report by Date"
6 D DTRANGE Q:YSASBDT=""!(YSASEDT="")
7 W !!,"Results returned via Mailman. Please queue this report for after hours."
8QUEUE ;
9 ;S YSASITE=$P(^DIC(4,+^YSTX(604.8,1,0),0),U)
10 S YSASITE=$$SITE^YSASCF
11 K IOP,ZTIO,ZTSAVE
12 S ZTIO="",ZTSAVE("YSAS*")="",ZTRTN="ENQ^YSASU",ZTDESC="YSAS ASI SITE REPORT" D ^%ZTLOAD
13 I '$D(ZTSK) Q
14 W !!,"Your Task Number is "_ZTSK D ^%ZISC
15 Q
16ENQ ;queue entry
17 S:$D(ZTQUEUED) ZTREQ="@"
18 D FINDIT
19 D BUILDIT
20 D PTLST^YSASU1
21 D MAIL2^YSASU1
22 Q
23ZZ S N=0 F S N=$O(^TMP("YSASU",$J,"M",N)) Q:N'>0 W !,^(N)
24 Q
25DTRANGE ;date range
26 W ! S (YSASBDT,YSASEDT)="",%DT("A")="Beginning Date for ASI Range: ",%DT="AEX" D ^%DT
27 Q:Y'>0
28 S YSASBDT=+Y
29 W ! S %DT("A")="Ending Date for ASI Range: " D ^%DT
30 Q:Y'>0
31 S YSASEDT=+Y
32 I (YSASEDT>0)&(YSASEDT<YSASBDT) W !,?7,"Ending Date must be closer to today th an Beginning Date",! H 2 W $C(7) G DTRANGE
33 Q
34FINDIT ; loop thru 604 by date
35 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
36 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
37 . S G0=$G(^YSTX(604,YSIFN,0)),GP5=$G(^YSTX(604,YSIFN,.5)),G5=$G(^YSTX(604,YSIFN,5))
38 . ;1=date interview 2=dfn 3=class 4=special 5=interviewer 6=e signed 7=e sig 8= awaiting trans 9= trans date
39 . IF $P(G0,U,2)>0 S YSNAME=$P(^DPT($P(G0,U,2),0),U)
40 . IF $P(G0,U,2)="" S YSNAME="unknown "_YSIFN
41 . S ^TMP("YSASU",$J,"A",YSNAME,YSIFN)=""
42 . 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)
43 . S YSTOT=$G(YSTOT)+1
44 . S G=$P(G0,U,4) S:G="" G=-1 S YSCLASS(G)=$G(YSCLASS(G))+1
45 . S G=$P(G0,U,11) S:G="" G=-1 S YSSPEC(G)=$G(YSSPEC(G))+1
46 . S G=$P($G(GP5),U,1) S:G="" G=0 S YSSIGND(G)=$G(YSSIGND(G))+1
47 . S G=$P($G(G5),U,3) S:G="" G=0 S YSAWAIT(G)=$G(YSAWAIT(G))+1
48 . S G=$P($G(G5),U,4),G=$S(G="":0,1:1),YSTRANS(G)=$G(YSTRANS(G))+1
49 Q
50BUILDIT ;build output tmp
51 K ^TMP("YSASU",$J,"M") S YSASN=0,YSASS="",$P(YSASS," ",79)=""
52 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=$E(YSASS,1,15)_"Addiction Severity Index Status Report"
53 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=" Facility: "_YSASITE
54 S Y=YSASBDT X ^DD("DD") S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)="Begining Date: "_Y
55 S Y=YSASEDT X ^DD("DD") S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=" Ending Date: "_Y
56 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=" "
57 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)="During this time period there were:"
58 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSTOT_" total entries"
59 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSCLASS(1)_" Full, "_YSCLASS(2)_" Lite, "_YSCLASS(3)_" Follow-up and "_YSCLASS(-1)_" Unspecified"
60 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"
61 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSSIGND(1)_" were signed and "_YSSIGND(0)_" remain unsigned"
62 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSTRANS(1)_" were transmitted to the central database and "_YSTRANS(0)_" were not transmitted"
63 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=YSAWAIT(1)_" are in the queue for the next transmission"
64 S YSASN=YSASN+1,^TMP("YSASU",$J,"M",YSASN)=" "
65 Q
Note: See TracBrowser for help on using the repository browser.