source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSGAF3.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: 5.8 KB
Line 
1YSGAF3 ;ASF/ALB- GAF CASE FINDER ;10/30/98 13:50
2 ;;5.01;MENTAL HEALTH;**48,49**;Dec 30, 1994
3MAIN ;
4 K ^TMP("YSGF",$J),^TMP("YSGFM",$J)
5 W @IOF,!?10,"Global Assessment of Functioning Case finder",!
6 D DTRANGE Q:YSGFBDT=""!(YSGFEDT="")
7 W !
8 D SORT Q:Y="^"!(Y="")
9 S YSGFSRT=$S(Y=2:1,1:0) ; 0 for PATIENT sort, 1 for PROVIDER sort
10 W !!,"Results returned via Mailman. Please queue this report for after hours."
11QUEUE ;
12 K IOP,ZTIO,ZTSAVE
13 S ZTIO="",ZTSAVE("YSGF*")="",ZTRTN="ENQ^YSGAF3",ZTDESC="GAF Case Finder" D ^%ZTLOAD W:$D(ZTSK) !!,"Your Task Number is "_ZTSK D ^%ZISC
14 K ^TMP("YSGF",$J),^TMP("YSGFM",$J)
15 K G,G1,P,VA,X,X1,X2,XMSUB,XMTEXT,XTMP,XMY,Y,YSDA,YSGAFDL,YSGFBDT,YSGFCNT
16 K YSGFCNT2,YSGFDNIT,YSGFEDT,YSGFI,YSGFITE,YSGFMCNT,YSGFMTC,YSGFN
17 K YSGFNM,YSGFS,YSIN,YSLOC,YSOEDT,YSOEFN,YSPTFGAF,YSSCFN,YSSCN,YSTOT
18 K YSPRV,YSDTA,YSPARSE,YSGFSRT,YSX2
19 Q
20ENQ ;queue entry
21 S:$D(ZTQUEUED) ZTREQ="@"
22 S YSGFN=0
23 D OE
24 D HEAD,PTLST,BOT
25 D MAIL2 ; output
26 Q
27DTRANGE ;date range
28 W ! S (YSGFBDT,YSGFEDT)="",%DT("A")="Beginning Date for GAF Case Finder Date Range: ",%DT="AEX" D ^%DT
29 Q:Y'>0
30 S YSGFBDT=+Y_".000001"
31 W ! S %DT("A")="Ending Date for GAF Case Finder Date Range: " D ^%DT
32 Q:Y'>0
33 S YSGFEDT=+Y_".595959"
34 I (YSGFEDT>0)&(YSGFEDT<YSGFBDT) W !,?7,"Ending Date must be closer to today than Beginning Date",! H 2 W $C(7) G DTRANGE
35 Q
36SORT ; Choose sort
37 S DIR(0)="SA^1:PATIENT;2:PROVIDER",DIR("B")=1,DIR("T")=60
38 S DIR("A")="Sort by (1) PATIENT or (2) PROVIDER? "
39 D ^DIR
40 Q
41OE ;loop thru OUTPATIENT ENCOUNTER file
42 S YSOEDT=YSGFBDT-.0001
43 F S YSOEDT=$O(^SCE("B",YSOEDT)) Q:(YSOEDT>(YSGFEDT+.9))!(YSOEDT'>0) S YSOEFN=0 F S YSOEFN=$O(^SCE("B",YSOEDT,YSOEFN)) Q:YSOEFN'>0 D
44 . S G=^SCE(YSOEFN,0) ;outpatient encounter information
45 . S DFN=$P(G,U,2) Q:DFN'>0
46 . S YSSCFN=$P(G,U,3) Q:YSSCFN'>0
47 . S YSSCN=$P($G(^DIC(40.7,YSSCFN,0)),U,2) ;AMIS reporting stop code
48 . I (YSSCN>499)&(YSSCN<600)&(YSSCN'=526)&(YSSCN'=527)&(YSSCN'=528)&(YSSCN'=542)&(YSSCN'=545)&(YSSCN'=546) D
49 .. D GETPRV
50 .. S:YSPRV="" YSPRV=" "
51 .. S:'YSGFSRT SORT1=$P(^DPT(DFN,0),U),SORT2=YSPRV
52 .. S:YSGFSRT SORT1=YSPRV,SORT2=$P(^DPT(DFN,0),U)
53 .. S XTMP=$P(G,U)_U_$P(G,U,4)_U_YSOEFN
54 .. S ^TMP("YSGF",$J,SORT1,SORT2,DFN)=XTMP
55 Q
56HEAD ;header
57 K ^TMP("YSGFM",$J)
58 S YSGFS="",$P(YSGFS," ",75)=""
59 S YSGFN=0
60 S YSGFITE=$$SITE
61 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=$E(YSGFS,1,15)_"GAF Case Finder"
62 S Y=YSGFBDT\1 X ^DD("DD") S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)="Begining Date: "_Y
63 S Y=YSGFEDT\1 X ^DD("DD") S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=" Ending Date: "_Y
64 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=" Facility: "_YSGFITE
65 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=" "
66 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)="The following is a list of all patients who had a Mental Health Outpatient"
67 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)="Encounter between the above dates but do not have a GAF score WITHIN 90 DAYS."
68 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)="Last MH (non-telephonic) Outpatient Encounter in date range is listed."
69 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=" "
70 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)="Name"_$E(YSGFS,1,17)_"SSN Date Location Provider"
71 Q
72BOT ; bottom
73 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=" "
74 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=YSTOT_" MH patients without a GAF."
75 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=YSGFDNIT_" MH patients had a GAF."
76 S YSGFN=YSGFN+1,^TMP("YSGFM",$J,YSGFN)=" "
77 Q
78PTLST ;check for previous GAF and print
79 S SORT1="",YSTOT=0,YSGFDNIT=0
80 F S SORT1=$O(^TMP("YSGF",$J,SORT1)) Q:SORT1="" D
81 .S SORT2="" F S SORT2=$O(^TMP("YSGF",$J,SORT1,SORT2)) Q:SORT2="" D
82 ..S DFN=0 F S DFN=$O(^TMP("YSGF",$J,SORT1,SORT2,DFN)) Q:DFN'>0 D
83 ... S G=^TMP("YSGF",$J,SORT1,SORT2,DFN)
84 ... S:'YSGFSRT YSGFNM=SORT1,YSPRV=SORT2
85 ... S:YSGFSRT YSGFNM=SORT2,YSPRV=SORT1
86 ... S YSOEFN=$P(G,U,3)
87 ... D GAFCK ;check if GAF done OUTPATIENT
88 ... I YSGFI=1 S YSGFDNIT=YSGFDNIT+1 Q ;out if done
89 ... D PTFCK ;check inpatient GAF
90 ... I YSGFI=1 S YSGFDNIT=YSGFDNIT+1 Q ;out if done
91 ... S YSTOT=YSTOT+1
92 ... D DEM^VADPT S YSGFN=YSGFN+1
93 ... S ^TMP("YSGFM",$J,YSGFN)=$E(YSGFNM_YSGFS,1,20)_" "_$E(VA("BID")_" ",1,6)_" "
94 ... K YSDTA,YSPARSE
95 ... D GETGEN^SDOE(YSOEFN,"YSDTA")
96 ... D PARSE^SDOE(.YSDTA,"EXTERNAL","YSPARSE")
97 ... S XTMP=" "_$E(YSPARSE(.01),1,18)_" "_$E(YSPARSE(.04)_YSGFS,1,15)
98 ... S ^TMP("YSGFM",$J,YSGFN)=^TMP("YSGFM",$J,YSGFN)_XTMP
99 ... D GETPRV
100 ... S ^TMP("YSGFM",$J,YSGFN)=^TMP("YSGFM",$J,YSGFN)_" "_$E(YSPRV,1,10)
101 Q
102GETPRV ;Get provider info
103 K YSDTA
104 D GETPRV^SDOE(YSOEFN,"YSDTA")
105 S YSPRV=$O(YSDTA(-1))
106 I $L(YSPRV) D
107 .S YSPRV=$P(YSDTA(YSPRV),U)
108 .S YSPRV=$$EXTERNAL^DILFD(9000010.06,.01,"",YSPRV)
109 Q
110GAFCK ;check gaf already done 0=NONE 1=DONE
111 S YSGFI=0
112 Q:'$D(^YSD(627.8,"AX5",DFN))
113 S YSGAFDL=$O(^YSD(627.8,"AX5",DFN,0)) Q:YSGAFDL'>0
114 S X1=9999999-YSGAFDL
115 S X2=$P(G,U)
116 D ^%DTC
117 S:X<91 YSGFI=1
118 Q
119PTFCK ;
120 S YSGFI=0,YSX2=$P(G,U)
121 Q:'$D(^DGPT("B",DFN))
122 S YSIN=0 F S YSIN=$O(^DGPT("B",DFN,YSIN)) Q:YSIN'>0!(YSGFI=1) D
123 . S YSPTFGAF=$P($G(^DGPT(YSIN,300)),U,6) ; current functional assessment
124 . Q:YSPTFGAF'?1N.N
125 . S X1=$P($G(^DGPT(YSIN,70)),U) ; discharge date
126 . Q:X1'?7N.E
127 . S X2=YSX2
128 . D ^%DTC
129 . S:X<91 YSGFI=1
130 Q
131MAIL2 ; SEND MAILMAN
132 K ^TMP("YSMM",$J)
133 S YSGFMCNT=0,YSGFMTC=(YSGFN\1000)+1
134 S YSGFCNT=0,YSGFCNT2=0 F S YSGFCNT=$O(^TMP("YSGFM",$J,YSGFCNT)) Q:(YSGFCNT'>0) D
135 .S YSGFCNT2=YSGFCNT2+1,^TMP("YSMM",$J,YSGFCNT)=^TMP("YSGFM",$J,YSGFCNT)
136 .I (YSGFCNT2=1000)!(YSGFCNT=YSGFN) D
137 ..S YSGFMCNT=YSGFMCNT+1
138 ..S DTIME=600
139 ..S XMSUB="GAF Case Finder ("_YSGFMCNT_" OF "_YSGFMTC_")"
140 ..S XMTEXT="^TMP(""YSMM"",$J,"
141 ..S XMY(DUZ)=""
142 ..S XMDUZ="AUTOMATED MESSAGE"
143 ..D ^XMD
144 ..S YSGFCNT2=0
145 ..K ^TMP("YSMM",$J)
146 Q
147 ;
148SITE() ;SET YSGFITE EQUAL TO SITE-NAME
149 N DA,DIC,DIQ,DR
150 S YSDA=+$P($$SITE^VASITE,U,3)
151 S DIC=4,DR=".01",DA=YSDA,DIQ(0)="EN",DIQ="YSLOC"
152 D EN^DIQ1
153 S YSLOC=$P(YSLOC(4,+YSDA,.01,"E"),",")
154 QUIT YSLOC
Note: See TracBrowser for help on using the repository browser.