source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSASCF.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 6.4 KB
Line 
1YSASCF ;ASF/ASL ASI CASE FINDER WITH DX API ;9/14/98 18:11
2 ;;5.01;MENTAL HEALTH;**38,45,55**;Dec 30, 1994
3MAIN ;
4 K ^TMP("YSAS",$J),^TMP("YSASM",$J)
5 N DFN,G,G1,P,X,Y,YSASBDT,YSASCNT,YSASCNT2,YSASEDT,YSASI,YSLOC,YSASITE
6 N YSASIX,YSASMCNT,YSASMTC,YSASN,YSASNM,YSASS,YSICD,YSLS,YSM,YSODFN
7 N YSOEDT,YSOEFN,YSPTFD,YSPTFN,YSSUB,YSTOT,YSASDNIT,YSMD
8 W @IOF,!?10,"Addiction Severity Index Case finder",!
9 D DTRANGE Q:YSASBDT=""!(YSASEDT="")
10 W !!,"Results returned via Mailman. Please queue this report for "
11 W "after hours."
12QUEUE ;
13 K IOP,ZTIO,ZTSAVE
14 S ZTIO="",ZTSAVE("YSAS*")="",ZTRTN="ENQ^YSASCF"
15 S ZTDESC="ASI Case Finder"
16 D ^%ZTLOAD W:$D(ZTSK) !!,"Your Task Number is "_ZTSK D ^%ZISC
17 K ^TMP("YSAS",$J),^TMP("YSASM",$J)
18 Q
19ENQ ;queue entry
20 S:$D(ZTQUEUED) ZTREQ="@"
21 S YSASN=0
22 D PTFLP
23 D OE
24 D HEAD,PTLST,BOT
25 D MAIL2 ; output
26 Q
27DTRANGE ;date range
28 W ! S (YSASBDT,YSASEDT)="",%DT("A")="Beginning Date for ASI Case Finder Date Range: ",%DT="AEX" D ^%DT
29 Q:Y'>0
30 S YSASBDT=+Y_".000001"
31 W ! S %DT("A")="Ending Date for ASI Case Finder Date Range: " D ^%DT
32 Q:Y'>0
33 S YSASEDT=+Y_".595959"
34 I (YSASEDT>0)&(YSASEDT<YSASBDT) W !,?7,"Ending Date must be closer to today than Beginning Date",! H 2 W $C(7) G DTRANGE
35 Q
36PTFLP ;search PTF for subs abuse primary dx
37 S YSPTFD=YSASBDT-.0001
38 F S YSPTFD=$O(^DGPT("ADS",YSPTFD)) Q:YSPTFD>(YSASEDT+.9999)!(YSPTFD'>0) S YSPTFN=0 F S YSPTFN=$O(^DGPT("ADS",YSPTFD,YSPTFN)) Q:YSPTFN'>0 D
39 . S YSM=0,YSSUB=0
40 . F S YSM=$O(^DGPT(YSPTFN,"M",YSM)) Q:YSM'>0!(YSSUB=1) D
41 .. S DFN=+^DGPT(YSPTFN,0)
42 .. Q:DFN'>0
43 .. S G=$G(^DGPT(YSPTFN,"M",YSM,0))
44 .. I G="" S ^TMP("YSAS",$J,$P(^DPT(DFN,0),U),DFN)="Missing PTF Data" Q
45 .. ;dont add NHCU or DOM pts
46 .. S YSLS=$P(G,U,2) S:YSLS YSLS=$P($G(^DIC(42.4,YSLS,0)),U)
47 .. Q:YSLS?.E1"NHCU".E!(YSLS?.E1"DOMICILIARY".E)
48 .. ;check idc9 #1= subs
49 .. S YSICD=$P(G,U,5) S:YSICD YSICD=$P($G(^ICD9(YSICD,0)),U,1)
50 .. D ICDCK(YSICD)
51 .. I YSSUB=1 S ^TMP("YSAS",$J,$P(^DPT(DFN,0),U),DFN)=$P(G,U,10)_";"_YSICD_";"_$P(G,U,2)
52 .. ;W:YSICD !,^DGPT(YSPTFN,0),!?5,YSICD,?15,YSLS
53 Q
54ICDCK(YSICD) ; CHECK IF ICD9 MEETS CRITERIA
55 S YSSUB=0
56 I ((YSICD?1"291.".E)!(YSICD?1"292.".E)!(YSICD?1"303.".E)!(YSICD?1"304.".E)!(YSICD?1"305.".E))&(YSICD'?1"305.1".E)&(YSICD'?3N1"."1N1"3") S YSSUB=1
57 Q
58OE ;loop thru OUTPATIENT ENCOUNTER file
59 S YSOEDT=YSASBDT-.0001
60 F S YSOEDT=$O(^SCE("B",YSOEDT)) Q:(YSOEDT>(YSASEDT+.9))!(YSOEDT'>0) S YSOEFN=0 F S YSOEFN=$O(^SCE("B",YSOEDT,YSOEFN)) Q:YSOEFN'>0 D
61 . S G=$G(^SCE(YSOEFN,0))
62 . I G="" Q
63 . S DFN=$P(G,U,2) Q:DFN'>0
64 . K YSDXL S YSSUB=0
65 . D GETDX^SDOE(YSOEFN,"YSDXL")
66 . S I=0 F S I=$O(YSDXL(I)) Q:I'>0!(YSSUB) D
67 .. S YSICD=$P(YSDXL(I),U) S:YSICD YSICD=$P($G(^ICD9(YSICD,0)),U,1)
68 .. I ((YSICD?1"291.".E)!(YSICD?1"292.".E)!(YSICD?1"303.".E)!(YSICD?1"304.".E)!(YSICD?1"305.".E))&(YSICD'?1"305.1".E)&(YSICD'?3N1"."1N1"3") S YSSUB=1
69 .. S:$P(YSDXL(I),U,12)="S" YSSUB=0
70 . I YSSUB=1 S $P(^TMP("YSAS",$J,$P(^DPT(DFN,0),U),DFN),U,2)=$P(G,U)_";"_YSICD_";"_$P(G,U,4)
71 Q
72HEAD ;header
73 K ^TMP("YSASM",$J) S YSASS="",$P(YSASS," ",75)=""
74 ;S YSASN=0,YSASITE=$P($G(^YSTX(604.8,1,0)),U) S:YSASITE'="" YSASITE=$P($G(^DIC(4,YSASITE,0)),U)
75 S YSASN=0
76 S YSASITE=$$SITE
77 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=$E(YSASS,1,15)_"Addiction Severity Index Case Finder"
78 S Y=YSASBDT\1 X ^DD("DD") S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)="Beginning Date: "_Y
79 S Y=YSASEDT\1 X ^DD("DD") S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=" Ending Date: "_Y
80 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=" Facility: "_YSASITE
81 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=" "
82 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)="The following is a list of all patients who received a PSUD diagnosis"
83 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)="between the above dates but do not have a signed ASI."
84 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=$E(YSASS,1,34)_"Last Primary Substance Abuse Dx"
85 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)="Name"_$E(YSASS,1,17)_"SSN Type Dx Date Location"
86 Q
87BOT ; bottom
88 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=" "
89 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=YSTOT_" patients without a signed ASI listed. ** indicates unsigned ASI"
90 I YSMD>0 D
91 .S XX=YSMD_" patient(s) with missing PTF data."
92 .S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=XX
93 .K XX
94 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=YSASDNIT_" PSUD patients had a signed ASI."
95 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=" "
96 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)="PSUD= all 291, 292, 303, 304 and 305 ICD-9 codes except:"
97 S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)="305.1 (tobacco dependency) and Remission codes (i.e. XXX.X3)"
98 Q
99PTLST ;check for previous ASI and print
100 S YSASNM="",(YSTOT,YSASDNIT,YSMD)=0
101 F S YSASNM=$O(^TMP("YSAS",$J,YSASNM)) Q:YSASNM="" S DFN=0 F S DFN=$O(^TMP("YSAS",$J,YSASNM,DFN)) Q:DFN'>0 D
102 . D ASICK(DFN) ;check previous ASI
103 . I YSASI=1 S YSASDNIT=YSASDNIT+1 Q ;out if done
104 . D DEM^VADPT S YSASN=YSASN+1,^TMP("YSASM",$J,YSASN)=$E(YSASNM_YSASS,1,20)_" "_VA("PID")_" " ;$E(VA("BID")_" ",1,6)_" "
105 . S G=^TMP("YSAS",$J,YSASNM,DFN)
106 . I G="Missing PTF Data" D Q
107 .. S YSMD=YSMD+1
108 .. S ^TMP("YSASM",$J,YSASN)=^TMP("YSASM",$J,YSASN)_"Inpt "_G
109 . S YSTOT=YSTOT+1
110 . S P=$S(+G>(+$P(G,U,2)):1,1:2) ; inpt vs outpt
111 . S G1=$P(G,U,P),Y=$E(+G1,4,5)_"/"_$E(+G1,6,7)_$S(+G1>2999999:"/20",1:"/19")_$E(+G1,2,3) ;date
112 . ; set location
113 . S X="" I P=1&($P(G1,";",3)'="") S X=$P(G1,";",3),X=$P($G(^DIC(42.4,X,0)),U)
114 . I P=2&($P(G1,";",3)'="") S X=$P(G1,";",3),X=$P($G(^SC(X,0)),U)
115 . S ^TMP("YSASM",$J,YSASN)=^TMP("YSASM",$J,YSASN)_$S(P=1:"Inpt ",1:"Outpt ")_$E($P(G1,";",2)_YSASS,1,7)_" "_Y_" "_$E(X_YSASS,1,20)_$S(YSASI=2:" **",1:"")
116 Q
117ASICK(DFN) ;check ASI already done 0=NONE 1=DONE 2=UNSIGNED
118 I '$D(^YSTX(604,"C",DFN)) S YSASI=0 Q
119 S YSASI=1,YSASIX=0 F S YSASIX=$O(^YSTX(604,"C",DFN,YSASIX)) Q:YSASIX'>0 I $P($G(^YSTX(604,YSASIX,.5)),U,1)'=1 S YSASI=2
120 Q
121MAIL2 ; SEND MAILMAN
122 K ^TMP("YSMM",$J)
123 S YSASMCNT=0,YSASMTC=(YSASN\1000)+1
124 S YSASCNT=0,YSASCNT2=0 F S YSASCNT=$O(^TMP("YSASM",$J,YSASCNT)) Q:(YSASCNT'>0) D
125 .S YSASCNT2=YSASCNT2+1,^TMP("YSMM",$J,YSASCNT)=^TMP("YSASM",$J,YSASCNT)
126 .I (YSASCNT2=1000)!(YSASCNT=YSASN) D
127 ..S YSASMCNT=YSASMCNT+1
128 ..S DTIME=600
129 ..S XMSUB="ASI Case Finder ("_YSASMCNT_" OF "_YSASMTC_")"
130 ..S XMTEXT="^TMP(""YSMM"",$J,"
131 ..S XMY("G.ASI PERFORMANCE MEASURES")=""
132 ..S XMY(DUZ)=""
133 ..S XMDUZ="AUTOMATED MESSAGE"
134 ..D ^XMD
135 ..S YSASCNT2=0
136 ..S DTIME=$$DTIME^XUP(DUZ)
137 ..K ^TMP("YSMM",$J)
138 Q
139 ;
140SITE() ;SET YSASITE EQUAL TO SITE-NAME
141 N DA,DIC,DIQ,DR
142 S YSDA=+$P($$SITE^VASITE,U)
143 QUIT $$GET1^DIQ(4,YSDA_",",.01)
Note: See TracBrowser for help on using the repository browser.