source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSGAF1.m@ 1005

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1YSGAF1 ;ASF/ALB- GLOBAL ASSESSMENT OF FUNCTIONNING CONT;9/25/97 11:19 ;11/10/97 16:08
2 ;;5.01;MENTAL HEALTH;**33**;Dec 30, 1994
3 Q
4ONELOC ;single hospital location
5 N DIC,Y
6 S YSCLIN="",YSCNAME=""
7 S DIC="^SC(",DIC(0)="AEQMZ" D ^DIC Q:Y<1
8 S YSCLIN=+Y,YSCNAME=$P(Y,U,2)
9 S YSSTOP=$P(Y(0),U,7) S:YSSTOP YSSTOP=$P($G(^DIC(40.7,YSSTOP,0)),U,2) ;ASF 9/30
10 I YSSTOP>499&(YSSTOP<600) Q
11 W !,YSCNAME," does not have a mental health stop code"
12 S DIR("A")="Do you wish to continue? ",DIR("B")="No",DIR(0)="Y" D ^DIR
13 I Y'=1 D ONELOC
14 Q
15DATE ;
16 N %DT
17 S %DT("A")="Enter Report Date: ",%DT("B")="T",%DT="AEF" D ^%DT
18 S YSDATE=Y
19 Q
20ONLYREQ ;only > ysdays
21 S YSONLY=""
22 K DIR S DIR(0)="Y",DIR("A")="Show only patients who do not have a GAF within "_YSDAYS_" days",DIR("B")="Yes" D ^DIR K DIR
23 Q:$D(DIRUT) S YSONLY=Y
24 Q
25LP1 ;loop to create tmp pt list
26 K ^TMP("YSGAF",$J)
27 S YSDD=YSDATE
28 F S YSDD=$O(^SC(YSCLIN,"S",YSDD)) Q:YSDD<1!(YSDD\1-YSDATE) D LP2
29 Q
30LP2 ;apps at one time
31 S K=0 F S K=$O(^SC(YSCLIN,"S",YSDD,1,K)) Q:K<1 D:$G(^SC(YSCLIN,"S",YSDD,1,K,0))
32 . S YSG=^SC(YSCLIN,"S",YSDD,1,K,0)
33 . S DFN=+YSG,YSPTN=$P(^DPT(DFN,0),U)
34 . Q:$P($G(^DPT(DFN,"S",YSDD,0)),U,2)'="" ;dont list if cancelled, noshow or ip
35 . S ^TMP("YSGAF",$J,"A",YSPTN,DFN)=""
36 Q
37HX ;GAF history
38 N %DT,DA,DIE,DIR,DIRUT,DLAYGO,DR,K,VA,VADM,X,X1,X2,Y,YSCLIN,YSCNAME,YSDA,YSDATE,YSDAYS,YSDD,YSDXEG,YSDXEL,YSDXEN,YSG,YSGAFLC,YSGAFLD,YSGAFLN,YSGC,YSGD,YSGN,YSGR,YSGT,YSLINE,YSN,YSONLY,YSOUT,YSPAGE,YSPTN,YSRULE,YSSTOP
39 K DIC,DFN D ^YSLRP Q:'$D(DFN)
40 ;ASK DEVICE
41 S %ZIS="QM"
42 D ^%ZIS
43 Q:$G(POP)
44 I $D(IO("Q")) D Q
45 .N ZTRTN,ZTDESC,ZTSAVE
46 .S ZTRTN="QHX^YSGAF1"
47 .S ZTDESC="YSGAF1 HX PRINT"
48 . S ZTSAVE("DFN")=""
49 .D ^%ZTLOAD
50 .D HOME^%ZIS
51 .Q
52 U IO
53QHX ;Queued Task Entry Point
54 S:$D(ZTQUEUED) ZTREQ="@"
55 D DEM^VADPT
56 K ^TMP("YSGAF",$J)
57 D HXLP
58 D TOP
59 I '$D(^TMP("YSGAF",$J,"H")) W !!,"No previous GAF's on file for this patient" Q
60 S YSOUT=1
61 S YSDD=0 F S YSDD=$O(^TMP("YSGAF",$J,"H",YSDD)) Q:YSDD'>0 S YSN=0 F S YSN=$O(^TMP("YSGAF",$J,"H",YSDD,YSN)) Q:YSN'>0 D D:$Y+4>IOSL BOT Q:YSOUT<1
62 . S YSG=^TMP("YSGAF",$J,"H",YSDD,YSN)
63 . S Y=$P(YSG,U,2) W !,$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),$S($L($P(YSG,U,4)):"Err",1:" ")
64 . I $P(YSG,U,3) W $E($P($G(^VA(200,$P(YSG,U,3),0)),U),1,15)
65 . W ?26,$J(+YSG,3)
66 . W " ",$E(YSGR,1,+YSG\2)
67 D ^%ZISC
68 Q
69HXLP ;
70 S YSDD=0 F S YSDD=$O(^YSD(627.8,"AX5",DFN,YSDD)) Q:YSDD'>0 S YSN=0 F S YSN=$O(^YSD(627.8,"AX5",DFN,YSDD,YSN)) Q:YSN'>0 D
71 . S ^TMP("YSGAF",$J,"H",YSDD,YSN)=$P($G(^YSD(627.8,YSN,60)),U,3)_U_$P($G(^YSD(627.8,YSN,0)),U,3)_U_$P($G(^YSD(627.8,YSN,0)),U,4)_U_$G(^YSD(627.8,YSN,80,1,0))
72 Q
73TOP ;
74 S YSGT=" 10 20 30 40 50 60 70 80 90 |"
75 S YSGR="####|####|####|####|####|####|####|####|####|####|"
76 W @IOF,"Global Assessment of Functioning Historical Listing"
77 W !,VADM(1),?$X+5,VA("PID"),?45,"printed: "
78 D NOW^%DTC S Y=% X ^DD("DD") W Y
79 S YSLINE="",$P(YSLINE,"-",79)="" W !,YSLINE
80 W !,"Date",?10,"Clinician",?26,"GAF",?30,YSGT
81 Q
82BOT ;page end
83 K DIR S YSOUT=1 I IOST'?1"C".E D TOP Q
84 W !! S DIR(0)="E" D ^DIR
85 S YSOUT=Y D:Y=1 TOP
86 Q
Note: See TracBrowser for help on using the repository browser.