source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASFUR.m@ 767

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1YSASFUR ;ASF/ASL ASI FOLLOWUP REQUIRED ;3/13/98 10:39
2 ;;5.01;MENTAL HEALTH;**38,55**;Dec 30, 1994
3MAIN ;
4 K ^TMP("YSAS",$J)
5 N DIR,DIRUT,G,G2,VA,X,X1,X2,Y,YS2G12,YSASAD1,YSASBDT,YSASCL,YSASCNT,YSASCNT2,YSASCNT3,YSASDLY,YSASDT,YSASEDT,YSASG12,YSASIN,YSASIN2,YSASITE,YSASN,YSASS,YSASTC,YSASTYP2,YSCK,YSIN1,YSIN2,YSINTER,YSLOC,YSNM,YSTOT
6 W @IOF,!?10,"Addiction Severity Index Followup Reminder",!
7 D DTRANGE Q:YSASBDT=""!(YSASEDT="") Q:(YSASDLY=0)
8 W !!,"Results returned via Mailman. Please queue this report for after hours."
9QUEUE ;
10 K IOP,ZTIO,ZTSAVE
11 S ZTIO="",ZTSAVE("YSAS*")="",ZTRTN="ENQ^YSASFUR",ZTDESC="ASI Followup Reminder" D ^%ZTLOAD W:$D(ZTSK) !!,"Your Task Number is "_ZTSK D ^%ZISC
12 K ^TMP("YSAS",$J),^TMP("YSAS",$J,"G")
13 Q
14ENQ ;queue entry
15 ;S:$D(ZTQUEUED) ZTREQ="@"
16 S YSASN=0,YSTOT=0
17 D DATELP
18 D HEAD,PTLST,BOT
19 D MAIL2 ; output
20 Q
21DTRANGE ;date range
22 W ! S (YSASBDT,YSASEDT)="",%DT("A")="Beginning Date for ASI Followup Reminder Date Range: ",%DT="AEX" D ^%DT
23 Q:Y'>0
24 S YSASBDT=+Y
25 W ! S %DT("A")="Ending Date for ASI Followup Reminder Date Range: " D ^%DT
26 Q:Y'>0
27 S YSASEDT=+Y
28 I (YSASEDT>0)&(YSASEDT<YSASBDT) W !,?7,"Ending Date must be closer to today than Beginning Date",! H 2 W $C(7) G DTRANGE
29 W ! K DIR S DIR(0)="N^31:999:0",DIR("B")=180,DIR("A")="Number of days after which a follow-up is required" D ^DIR S:$D(DIRUT) Y=0 S YSASDLY=Y K DIR
30 Q
31DATELP ;look for all ASIs in range
32 S YSASDT=YSASBDT-.0001 F S YSASDT=$O(^YSTX(604,"AD",YSASDT)) Q:YSASDT>YSASEDT!(YSASDT'>0) S YSASIN=0 F S YSASIN=$O(^YSTX(604,"AD",YSASDT,YSASIN)) Q:YSASIN'>0 D
33 . S G=^YSTX(604,YSASIN,0),DFN=$P(G,U,2),YSASG12=$P(G,U,11),YSASCL=$P(G,U,4),YSASAD1=$P(G,U,5)
34 . Q:YSASG12'="N" ; only search on completes
35 . Q:DFN=""
36 . ;Q:YSASCL=3 ;it is a followup already
37 . S YSIN2=""
38 . D NEXTCK ;look for a fu
39 . S ^TMP("YSAS",$J,"A",$P(^DPT(DFN,0),U),DFN)=YSCK_U_YSASIN_U_YSIN2
40 Q
41NEXTCK ;FU checker
42 S YSCK=0 ; DEFAULT= NEEDS FU
43 S X1=DT,X2=YSASAD1 D ^%DTC I X<YSASDLY S YSCK=-1 Q ; if first admin closer than delay
44 S YSASIN2=YSASIN F S YSASIN2=$O(^YSTX(604,"C",DFN,YSASIN2)) Q:YSASIN2'>0 D
45 . S G2=^YSTX(604,YSASIN2,0),YSASTYP2=$P(G2,U,4),YS2G12=$P(G,U,11),YSIN2=YSASIN2
46 . S YSCK=YSASTYP2
47 Q
48PTLST ; list pts
49 S YSNM="" F S YSNM=$O(^TMP("YSAS",$J,"A",YSNM)) Q:YSNM="" S DFN=0 F S DFN=$O(^TMP("YSAS",$J,"A",YSNM,DFN)) Q:DFN'>0 D
50 . S G=^TMP("YSAS",$J,"A",YSNM,DFN),YSCK=+G,YSIN1=$P(G,U,2),YSIN2=$P(G,U,3)
51 . Q:YSCK=3 ; has a fU
52 . Q:YSCK=-1 ;admin less than delay
53 . D DEM^VADPT S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=$E(YSNM_YSASS,1,20)_" "_$E(VA("BID")_YSASS,1,6)_" "
54 . S YSTOT=YSTOT+1
55 . S G=^YSTX(604,YSIN1,0),YSASCL=$P(G,U,4),Y=$P(G,U,5) X ^DD("DD")
56 . S YSINTER=$P(G,U,9) S:YSINTER?1N.N YSINTER=$P($G(^VA(200,YSINTER,0)),U)
57 . S ^TMP("YSAS",$J,"G",YSASN)=^TMP("YSAS",$J,"G",YSASN)_$S(YSASCL=1:"Full",YSASCL=2:"Lite",YSASCL=3:"F-Up",1:" ")_" "_$E(Y_" ",1,13)_$E(YSINTER_YSASS,1,15)
58 . S ^TMP("YSAS",$J,"G",YSASN)=^TMP("YSAS",$J,"G",YSASN)_" "_$S(YSCK=1:" subsequent Full",YSCK=2:" subsequent Lite",1:"")
59 Q
60HEAD ;header
61 K ^TMP("YSAS",$J,"G") S YSASS="",$P(YSASS," ",75)=""
62 ;S YSASN=0,YSASITE=$P($G(^YSTX(604.8,1,0)),U) S:YSASITE'="" YSASITE=$P($G(^DIC(4,YSASITE,0)),U)
63 S YSASN=0
64 S YSASITE=$$SITE^YSASCF
65 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=$E(YSASS,1,15)_"Addiction Severity Index Followup Reminder"
66 S Y=YSASBDT\1 X ^DD("DD") S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=" Beginning Date: "_Y
67 S Y=YSASEDT\1 X ^DD("DD") S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=" Ending Date: "_Y
68 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)="Days to Follow-up: "_YSASDLY
69 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=" Facility: "_YSASITE
70 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=" "
71 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)="The following is a list of all patients who have not received followup ASI's"
72 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)="after completed interviews between the above dates."
73 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=$E(YSASS,1,34)_"Last ASI Administration in Range"
74 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)="Name"_$E(YSASS,1,17)_"SSN Type Date Interviewer"
75 Q
76BOT ; bottom
77 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=" "
78 S YSASN=YSASN+1,^TMP("YSAS",$J,"G",YSASN)=YSTOT_" patients listed."
79 Q
80MAIL2 ; SEND MAILMAN
81 K ^TMP("YSMM",$J)
82 S YSASCNT3=0,YSASTC=(YSASN\1000)+1
83 S YSASCNT=0,YSASCNT2=0 F S YSASCNT=$O(^TMP("YSAS",$J,"G",YSASCNT)) Q:(YSASCNT'>0) D
84 .S YSASCNT2=YSASCNT2+1,^TMP("YSMM",$J,YSASCNT)=^TMP("YSAS",$J,"G",YSASCNT)
85 .I (YSASCNT2=1000)!(YSASCNT=YSASN) D
86 ..S YSASCNT3=YSASCNT3+1
87 ..S DTIME=600
88 ..S XMSUB="ASI Follow-up Reminder ("_YSASCNT3_" OF "_YSASTC_")"
89 ..S XMTEXT="^TMP(""YSMM"",$J,"
90 ..S XMY("G.ASI PERFORMANCE MEASURES")=""
91 ..S XMY(DUZ)=""
92 ..S XMDUZ="AUTOMATED MESSAGE"
93 ..D ^XMD
94 ..S YSASCNT2=0
95 ..K ^TMP("YSMM",$J)
96 ..S DTIME=$$DTIME^XUP(DUZ)
97 Q
Note: See TracBrowser for help on using the repository browser.