source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSYTQS.m@ 1150

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

initial load of WorldVistAEHR
File size: 5.7 KB
RevLine 
[613]1GMTSYTQS ;SLC/JMH & ALB/ASF - MHA SCORE ; 10/3/07 12:05pm
2 ;;2.7;Health Summary;**77**;Oct 20, 1995;Build 47
3 ;
4 ; External References
5 ; DBIA 10035 ^DPT(
6 ; DBIA 10103 $$FMTE^XLFDT
7 ;
8 Q
9EN ; MHA SCOREIT
10 N GMTS1,GMTS2,GMTSAI,GMTSAJ,GMTSCC,GMTSCOR,GMTSCS,GMTSCW,GMTSDATA
11 N GMTSDAY,GMTSDTM,GMTSGIV,GMTSI,GMTSJ,GMTSLO,GMTSLOC,GMTSLPG,GMTSNN,GMTSNPG,GMTSOR,GMTSQIT,GMTSRAW,GMTSSCL,GMTSTITL,GMTSTN,GMTSTRA,GMTSX,MAX,N
12 K ^TMP("GMTSYTQS",$J),^TMP("GMTSYTQSEG",$J)
13 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:9999999)
14 S:+($G(GMTSBEG))'>2700101 GMTSBEG=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),-1095,0,0,1),GMTSEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),1,0,0,1),GMTS2=9999999-GMTSBEG,GMTS1=9999999-GMTSEND
15 S:'$L($P(GMTSBEG,".",2)) GMTSBEG=$$FMADD^XLFDT(GMTSBEG,0,0,0,1)
16 S:+($G(GMTSEND))'>2700101!(+($G(GMTSEND))>+($$FMADD^XLFDT($P($$NOW^XLFDT,".",1),+1,0,0,2))) GMTSEND=$$FMADD^XLFDT($P($$NOW^XLFDT,".",1),1,0,0,1),GMTS1=9999999-GMTSEND
17 S:'$L($P(GMTSEND,".",2)) GMTSEND=$$FMADD^XLFDT(GMTSEND,0,0,0,1)
18 S:+($G(GMTSEND))>0&(+($G(GMTS1))=0) GMTS1=9999999-GMTSEND S:+($G(GMTSBEG))>0&(+($G(GMTS2))=0) GMTS2=9999999-GMTSBEG
19 S GMTSLO=+($G(GMTSLO)) S:GMTSLO=0 GMTSLO=3 S GMTSLPG=+($G(GMTSLPG)),GMTSDTM=$G(GMTSDTM) S:'$L(GMTSDTM) GMTSDTM=$$DTM
20 S:'$D(GMTSTITL)!('$L($G(GMTSTITL))) GMTSTITL="MHA Administrations"
21 S DFN=+($G(DFN)) Q:'$L($P($G(^DPT(DFN,0)),"^",1))
22 S GMTSCW(0)=+($G(IOM)) S:GMTSCW(0)=0 GMTSCW(0)=80
23 S GMTSCW(1)=5,GMTSCW(2)=10,GMTSCW(3)=20,GMTSCW(4)=GMTSCW(0)-(GMTSCW(1)+GMTSCW(2)+GMTSCW(3)+8)
24 S GMTSCW("L")=(GMTSCW(1)+GMTSCW(2)+GMTSCW(3)+GMTSCW(4)+6)
25 S GMTSCS(1)=1,GMTSCS(2)=GMTSCS(1)+GMTSCW(1)+2,GMTSCS(3)=GMTSCS(2)+GMTSCW(2)+2,GMTSCS(4)=GMTSCS(3)+GMTSCW(3)+2
26 D GET Q:'$D(^TMP("GMTSYTQS",$J)) D OUT
27 Q
28OUT ; Output
29 N GMTSI,GMTSJ,GMTSNN
30 S GMTSNN=1
31 D HDR
32 S GMTSGIV="" F S GMTSGIV=$O(^TMP("GMTSYTQS",$J,GMTSGIV)) Q:GMTSGIV'>0!(GMTSNN>MAX) S GMTSTN="" F S GMTSTN=$O(^TMP("GMTSYTQS",$J,GMTSGIV,GMTSTN)) Q:GMTSTN="" D
33 . S GMTSJ=$G(^TMP("GMTSYTQS",$J,GMTSGIV,GMTSTN))
34 . S GMTSDAY=$$ITM(GMTSGIV)
35 . S GMTSOR=$P(GMTSJ,U,5) S:GMTSOR?1N.N GMTSOR=$$EXTERNAL^DILFD(601.84,5,,GMTSOR)
36 . S GMTSLOC=$P(GMTSJ,U,14) S:GMTSLOC?1N.N GMTSLOC=$$EXTERNAL^DILFD(601.84,13,,GMTSLOC)
37 . S GMTSNN=GMTSNN+1
38 . D LINE
39 . D:GMTSTN="GAF" GAFSCORE
40 . D:GMTSTN="ASI" ASISCORE
41 . D:(GMTSTN'="GAF")&(GMTSTN'="ASI") SCORE
42 K ^TMP("GMTSYTQS",$J),^TMP("GMTSYTQSEG",$J)
43 Q
44SCORE ;
45 K GMTSX S:+GMTSJ GMTSX("AD")=+GMTSJ S:'(+GMTSJ) GMTSX("DFN")=DFN,GMTSX("CODE")=GMTSTN,GMTSX("ADATE")=9999999.999999-GMTSGIV
46 D GETSCORE^YTQAPI8(.GMTSDATA,.GMTSX)
47 Q:^TMP($J,"YSCOR",1)'="[DATA]"
48 S N=1 F S N=$O(^TMP($J,"YSCOR",N)) Q:N'>0 D
49 . S GMTSCOR=^TMP($J,"YSCOR",N)
50 . S GMTSSCL=$P(GMTSCOR,"=")
51 . S:$L(GMTSSCL)>15 GMTSSCL=$E(GMTSSCL,1,15)_"*"
52 . S GMTSRAW=$P(GMTSCOR,"=",2),GMTSRAW=$P(GMTSRAW,U)
53 . S GMTSTRA=$P(GMTSCOR,"=",2),GMTSTRA=$P(GMTSTRA,U,2)
54 . D CKP^GMTSUP Q:$D(GMTSQIT)
55 . D:GMTSNPG=1 HDR
56 . W ?42,$J(GMTSRAW,5)," ",$J(GMTSTRA,8)," ",GMTSSCL,!
57 Q
58GAFSCORE ;
59 W $J($P(GMTSJ,U,2),5),!
60 Q
61ASISCORE ;
62 N IFN
63 S IFN=+GMTSJ
64 W ?42,$J($$GET1^DIQ(604,IFN_",",8.12),5),$J($$GET1^DIQ(604,IFN_",",.61),8)," Medical",!
65 W ?42,$J($$GET1^DIQ(604,IFN_",",9.34),5),$J($$GET1^DIQ(604,IFN_",",.62),5)," Employment",!
66 W ?42,$J($$GET1^DIQ(604,IFN_",",11.18),5),$J($$GET1^DIQ(604,IFN_",",.63),5)," Alcohol",!
67 W ?42,$J($$GET1^DIQ(604,IFN_",",11.185),5),$J($$GET1^DIQ(604,IFN_",",.635),5)," Drug",!
68 W ?42,$J($$GET1^DIQ(604,IFN_",",14.34),5),$J($$GET1^DIQ(604,IFN_",",.64),5)," Legal",!
69 W ?42,$J($$GET1^DIQ(604,IFN_",",18.29),5),$J($$GET1^DIQ(604,IFN_",",.65),5)," Family",!
70 W ?42,$J($$GET1^DIQ(604,IFN_",",19.33),5),$J($$GET1^DIQ(604,IFN_",",.66),5)," Psychiatric",!
71 Q
72LINE ; Output One Line
73 D CKP^GMTSUP Q:$D(GMTSQIT)
74 D:GMTSNPG=1 HDR
75 W GMTSDAY,?20,$J($E(GMTSTN,1,20)_$S($L(GMTSTN)>20:"* ",1:" "),22)
76 Q
77HDR ; Header
78 N GMTSI S GMTSI="",$P(GMTSI,"-",+($G(GMTSCW("L"))))="-"
79 D CKP^GMTSUP Q:$D(GMTSQIT) G:GMTSNPG=1 HDR W "Date",?31,"Instrument Raw Trans Scale",!
80 Q
81GET ; Get and Format Data
82 N %DT,X,Y,GMTSNN,GMTSGIV,GMTSTN
83 K ^TMP("GMTSYTQSEG",$J)
84 ;selctions
85 S GMTSCC=0 F S GMTSCC=$O(GMTSEG(GMTSCC)) Q:GMTSCC'>0 Q:$D(GMTSEG($G(GMTSCC,0),601.71)) ;ASF 7/6/07
86 Q:GMTSCC'>0 ;must have a selection
87 S GMTSAI=0 F S GMTSAI=$O(GMTSEG(GMTSCC,601.71,GMTSAI)) Q:GMTSAI'>0 S GMTSAJ=GMTSEG(GMTSCC,601.71,GMTSAI),^TMP("GMTSYTQSEG",$J,$P(^YTT(601.71,GMTSAJ,0),U))=""
88 ;
89 S GMTSNN=0
90 K GMTSX
91 S GMTSX("DFN")=DFN,GMTSX("COMPLETE")="Y" D ADMINS^YTQAPI5(.GMTSDATA,.GMTSX)
92 Q:'$D(GMTSDATA(3))
93 S N=2 F S N=$O(GMTSDATA(N)) Q:N'>0!(GMTSNN>MAX) D
94 . S GMTSTN=$P(GMTSDATA(N),U,2) Q:GMTSTN=""
95 . Q:'$D(^TMP("GMTSYTQSEG",$J,GMTSTN))
96 . S GMTSGIV=$P($G(GMTSDATA(N)),U,3) Q:GMTSGIV'?7N.E
97 . Q:GMTSGIV<GMTSBEG
98 . Q:GMTSGIV>GMTSEND
99 . S GMTSNN=GMTSNN+1
100 . S ^TMP("GMTSYTQS",$J,9999999.999999-GMTSGIV,GMTSTN)=GMTSDATA(N)
101 K GMTSDATA
102 D:$D(^TMP("GMTSYTQSEG",$J,"GAF")) GAFGET
103 K GMTSDATA
104 D:$D(^TMP("GMTSYTQSEG",$J,"ASI")) ASIGET
105 Q
106ASIGET ;
107 N G,GMTSIEN,GMTSNN,GMTSELS
108 S GMTSNN=0
109 S GMTSIEN=0
110 F S GMTSIEN=$O(^YSTX(604,"C",DFN,GMTSIEN)) Q:GMTSIEN'>0 D
111 . S G=^YSTX(604,GMTSIEN,0)
112 . S GMTSGIV=$P(G,U,12)
113 . S GMTSELS=$P($G(^YSTX(604,GMTSIEN,.5)),U)
114 . Q:GMTSELS'=1
115 . Q:GMTSGIV<GMTSBEG
116 . Q:GMTSGIV>GMTSEND
117 . S GMTSNN=GMTSNN+1
118 . S ^TMP("GMTSYTQS",$J,9999999.999999-GMTSGIV,"ASI")=GMTSIEN
119 Q
120GAFGET ;get axis5
121 N G,N,GMTSNN
122 S GMTSNN=0
123 S GMTSX("DFN")=DFN D GAFRET^YTQAPI6(.GMTSDATA,.GMTSX)
124 Q:'$D(GMTSDATA(2))
125 S N=1 F S N=$O(GMTSDATA(N)) Q:N'>0!(GMTSNN>MAX) D
126 . S G=GMTSDATA(N)
127 . S GMTSGIV=$P(^YSD(627.8,+G,0),U)
128 . Q:GMTSGIV<GMTSBEG
129 . Q:GMTSGIV>GMTSEND
130 . S GMTSNN=GMTSNN+1
131 . S ^TMP("GMTSYTQS",$J,9999999.999999-GMTSGIV,"GAF")=+G_U_$P(G,U,2)
132 Q
133ITM(X) ; Inverse date to Mental Health formats
134 S X=+($G(X)) Q:X=0 "" S X=9999999.999999-X D REGDTM4^GMTSU Q X
135DTM(X) ; Current Date and Time (External)
136 S X=$$NOW^XLFDT D REGDTM4^GMTSU Q X
Note: See TracBrowser for help on using the repository browser.