source: FOIAVistA/tag/r/HEALTH_SUMMARY-GMTS/GMTSOBJ.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1GMTSOBJ ; SLC/KER - HS Object - Create/Test/Display ; 01/06/2003
2 ;;2.7;Health Summary;**58,63**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 2320 $$DEL^%ZISH
6 ; DBIA 2320 $$FTG^%ZISH
7 ; DBIA 2320 $$PWD^%ZISH
8 ; DBIA 2320 CLOSE^%ZISH
9 ; DBIA 2320 OPEN^%ZISH
10 ; DBIA 10006 ^DIC (file #142.5 and #2)
11 ; DBIA 10013 ^DIK
12 ; DBIA 2054 $$CREF^DILF
13 ; DBIA 2054 $$OREF^DILF
14 ; DBIA 10026 ^DIR
15 ; DBIA 10103 $$NOW^XLFDT
16 ;
17 Q
18MGR ; Create/Modify Health Summary Object (Manager)
19 N GMTSMGR S GMTSMGR="" G OBJ
20 ;
21DEVOBJ ; Create/Modify Health Summary Object (Developer)
22 N GMTSDEV S GMTSDEV=5000
23 ;
24OBJ ; Create/Modify Health Summary Object
25 ; Option: GMTS OBJ ENTER/EDIT
26 ; Create/Modify Health Summary Object
27 N BOLD,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT,DUOUT,GMP,GMTS
28 N GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF,GMTSDLD,GMTSDT
29 N GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNEW,GMTSO,GMTSOBJ
30 N GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR,GMTSRDT,GMTSRHD
31 N GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT,GMTSV,GMTSVER,GMTSX
32 N IOINHI,IOINORM,NORM,OBJ,D,D0,D1,DI,DILN,X,Y
33 S DIC("S")="I +Y<50000000!(+Y>59999999)" K:+($G(GMTSDEV))=5000 DIC("S")
34 D OBJ^GMTSOBA
35 Q
36 ;
37CRE(NAME) ; Create/Modify Health Summary Object named 'NAME'
38 ;
39 ; Input NAME Name of Object to Create or Edit
40 ; Output Internal Entry Number of Object file if
41 ; found or created
42 ;
43 N X,BOLD,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT,DUOUT,GMP,GMTS
44 N GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF,GMTSDLD,GMTSDT
45 N GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNAM,GMTSNEW,GMTSO
46 N GMTSOBJ,GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR,GMTSRDT
47 N GMTSRHD,GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT,GMTSV,GMTSVER
48 N GMTSX,IOINHI,IOINORM,NORM,OBJ,D,D0,D1,DI,DILN,Y S GMTSNAM=$G(NAME)
49 S:'$L(GMTSNAM) GMTSNAM=$$NAME^GMTSOBV("") Q:'$L(GMTSNAM) -1
50 S DIC("S")="I +Y<50000000!(+Y>59999999)" K:+($G(GMTSDEV))=5000 DIC("S")
51 D OBJ^GMTSOBA K DIC S DIC="^GMT(142.5,",DIC(0)="XM",X=GMTSNAM
52 D ^DIC,CRD^GMTSOBV(+Y),^DIC S X=+Y S:X'>0 X=-1
53 Q X
54 ;
55TYPE(NAME) ; Edit Health Summary Type named NAME
56 ;
57 ; Input NAME Name of Health Summary Type to Edit
58 ; Output None
59 D ET^GMTSOBA2($G(NAME))
60 Q
61 ;
62INQ ; Inquire to Health Summary Object
63 ; Option: GMTS OBJ INQ
64 ; Health Summary Object Inquiry
65 N DIC,D,D0,D1,DI,DILN,GMTSP,GMTSPL,GMTSL,GMTSEXIT
66 S U="^",DIC="^GMT(142.5,",DIC(0)="AEMQF",GMTSP=$G(IOST),GMTSPL=0,GMTSL=0,GMTSEXIT=0
67 S DIC("A")=" Select Health Summary Object: " D ^DIC K DIC("A")
68 W:$L($G(IOF)) @IOF W:+($G(Y))>0 ! D:+($G(Y))>0 SO^GMTSOBS(+Y),CONT^GMTSOBS
69 Q
70 ;
71DEVDEL ; Delete Health Summary Object (Developer)
72 N GMTSDEV S GMTSDEV=5000
73 ;
74DEL ; Delete Health Summary Object
75 ; Option: GMTS OBJ DELETE
76 ; Delete Health Summary Object
77 N D,D0,D1,DI,DILN,DIC,DIR,DIK,DA,X,Y,GMTSP,GMTSPL,GMTSL,GMTSEXIT S U="^",(DIK,DIC)="^GMT(142.5,",DIC(0)="AEMQF"
78 I $$UACT^GMTSU2(+($G(DUZ)))'>0 W !!," >> You are not authorized to delete a Health Summary Object." Q
79 S DIC("A")=" Select Health Summary Object to Delete: "
80 S DIC("S")="I (+($P($G(^GMT(142.5,+Y,0)),""^"",17))=0!(+($P($G(^GMT(142.5,+Y,0)),""^"",17))=+($G(DUZ))))&(+($P($G(^GMT(142.5,+Y,0)),""^"",20))'>0)"
81 S:'$D(GMTSDEV) DIC("S")="I +($$DEL^GMTSOBV(+Y))>0"
82 K:$D(GMTSDEV) DIC("S") I +($G(Y))>50000000,+($G(Y))<59999999,'$D(GMTSDEV) W !," Can not delete a nationally exported object." Q
83 D ^DIC I +($G(Y))>0 D
84 . N GMTSDEL,GMTSO S GMTSDEL="" W ! D SO^GMTSOBS(+Y)
85 . S DA=+Y,GMTSO=$P($G(^GMT(142.5,+Y,0)),"^",1)
86 . S:$L(GMTSO) GMTSO=" """_GMTSO_""""
87 . S DIR("B")="NO",DIR(0)="YAO",DIR("A")=" Delete Health Summary Object"_GMTSO_"? "
88 . S (DIR("?"),DIR("??"))=" Enter either 'Y' or 'N'."
89 . W ! D ^DIR I +Y>0 D ^DIK
90 . I '$D(^GMT(142.5,+DA,0)) W !," <deleted>",!
91 Q
92 ;
93TEST ; Test Health Summary Object
94 ; Option: GMTS OBJ TEST
95 ; Test a Health Summary Object
96 N BOLD,D,D0,D1,DI,DILN,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT
97 N DUOUT,GMP,GMTS,GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF
98 N GMTSDLD,GMTSDT,GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNEW
99 N GMTSO,GMTSOBJ,GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR
100 N GMTSRDT,GMTSRHD,GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT
101 N GMTSV,GMTSVER,GMTSX,IOINHI,IOINORM,NORM,OBJ,X,Y
102 D PAT^GMTSOBV I +($G(DFN))'>0 W !!," No Patient Selected" Q
103 S GMTSL=$G(IOSL) N IOSL S IOSL=99999999
104 S DIC="^GMT(142.5,",DIC("A")=" Select HEALTH SUMMARY OBJECT to test: ",U="^"
105 S DIC(0)="AEMQ" K DLAYGO D ^DIC S GMTSOBJ=+($G(Y))
106 I +GMTSOBJ'>0 W !!," No Health Summary Object Selected" Q
107 K ^TMP("GMTSOBJ",$J,DFN) D GET(DFN,GMTSOBJ),DEV^GMTSOBS
108 Q
109 ;
110EXP ; Export a Health Summary Object
111 D EN^GMTSOBE
112 Q
113 ;
114INS ; Install Imported Health Summary Object
115 D EN^GMTSOBI
116 Q
117 ;
118GET(DFN,OBJ) ; Get Health Summary Object
119 ;
120 ; Input DFN IEN for Patient (#2)
121 ; OBJ IEN for Health Summary Object (#142.5)
122 ;
123 ; Output Global array of Health Summary data
124 ;
125 ; ^TMP("GMTSOBJ",$J,DFN,#,0)
126 ;
127 K ^TMP("GMTSOBJ",$J,DFN) D ARY(DFN,OBJ,$NA(^TMP("GMTSOBJ",$J,DFN)))
128 Q
129 ;
130TIU(DFN,OBJ) ; Get Health Summary Object (TIU)
131 ;
132 ; Input DFN IEN for Patient (#2)
133 ; OBJ IEN for Health Summary Object (#142.5)
134 ;
135 ; Output Global array of Health Summary data
136 ;
137 ; ^TMP("TIUHSOBJ",$J,"FGBL",0)
138 ; ^TMP("TIUHSOBJ",$J,"FGBL",#,0)
139 ;
140 N ERRMSG,HSTYPE
141 S HSTYPE=$P($G(^GMT(142.5,OBJ,0)),U,3)
142 I $G(HSTYPE)="" Q "No Health Summary Report Found"
143 I $D(^GMT(142,HSTYPE,1))'>0 D Q ERRMSG
144 . S ERRMSG="There are no components in the Health Summary Type: "_$P($G(^GMT(142,HSTYPE,0)),U)
145 K ^TMP("TIUHSOBJ",$J) D ARY(DFN,OBJ,$NA(^TMP("TIUHSOBJ",$J,"FGBL")))
146 Q:+($G(^TMP("TIUHSOBJ",$J,"FGBL",0)))>0 "~@"_$NA(^TMP("TIUHSOBJ",$J,"FGBL"))
147 Q "No Health Summary Report Found"
148 ;
149ARY(DFN,OBJ,ROOT) ; Build Array ROOT
150 ;
151 ; Input DFN IEN for Patient (#2)
152 ; OBJ IEN for Health Summary Object (#142.5)
153 ; ROOT Closed root (global or local array)
154 ;
155 ; Output Array of Health Summary data in ROOT
156 ;
157 N GMTSBLK,GMTSFILE,GMTSHFN,GMTSNC,GMTSNCT,GMTSND,GMTSNDT,GMTSNN,GMTSIOM
158 N GMTSPATH,GMTSPRE,GMTSRT,GMTSRTO,GMTSRTC,GMTSRNN,GMTSRNC,GMTS0,POP,X,Y
159 Q:$G(^GMT(142.5,+($G(OBJ)),0))="" S GMTSRT=$G(ROOT)
160 Q:'$L(GMTSRT) Q:$E(GMTSRT,1)'="^"&($E(GMTSRT,1)'?1U)
161 S GMTSRTO=$$OREF^DILF(GMTSRT),GMTSRTC=$$CREF^DILF(GMTSRT)
162 Q:'$L(GMTSRTO) Q:'$L(GMTSRTC) Q:'$L($TR(GMTSRTC,")",""))
163 Q:$E(GMTSRTO,$L(GMTSRTO))'=","&($E(GMTSRTO,$L(GMTSRTO))'="(")
164 Q:GMTSRTO'[$TR(GMTSRTC,")","") S GMTS0=GMTSRTO_"0)"
165 S GMTSPATH=$$PWD^%ZISH,GMTSFILE=$J_$TR($$NOW^XLFDT,".","")_".DAT"
166 D OPEN^%ZISH("WRITEFILE",GMTSPATH,GMTSFILE,"W"),DIS(+($G(DFN)),+($G(OBJ)))
167 D CLOSE^%ZISH("WRITEFILE") K ^TMP("GMTSOBJ",$J,"OGBL")
168 S Y=$$FTG^%ZISH(GMTSPATH,GMTSFILE,$NA(^TMP("GMTSOBJ",$J,"OGBL",1)),4)
169 S GMTSHFN(GMTSFILE)="",Y=$$DEL^%ZISH(GMTSPATH,$NA(GMTSHFN))
170 S (GMTSBLK,GMTSNCT,GMTSPRE)=0 S GMTSNN="^TMP(""GMTSOBJ"","_$J_",""OGBL"")"
171 S GMTSNC="^TMP(""GMTSOBJ"","_$J_",""OGBL"","
172 F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) D
173 . S GMTSND=@GMTSNN,GMTSNDT=$$TRIM^GMTSOBV(GMTSND)
174 . I 'GMTSBLK S:GMTSNDT="" GMTSBLK=1 Q:GMTSBLK
175 . Q:GMTSPRE&(GMTSNDT="") S GMTSNCT=GMTSNCT+1
176 . S @(GMTSRTO_GMTSNCT_",0)")=GMTSND
177 . S @GMTS0=$G(@GMTS0)+1
178 . S GMTSPRE=$S(GMTSNDT="":1,1:0)
179 K ^TMP("GMTSOBJ",$J,"OGBL")
180 Q
181 ;
182SHOW(X) ; Show a Health Summary Object Definition
183 ;
184 ; Input X IEN for Health Summary Object (#142.5)
185 ;
186 D SO^GMTSOBS(+($G(X)))
187 Q
188EXTRACT(X,ARY) ; Show a Health Summary Object Definition
189 ;
190 ; Input X IEN for Health Summary Object (#142.5)
191 ; Output ARY() Array of fields and values
192 ; (passed by reference)
193 ;
194 ; ARY(IEN,<field #>,"I") = Internal Value
195 ; ARY(IEN,<field #>,"E") = External Value
196 ; ARY(IEN,<field #>,"NAME") = Field Name
197 ; ARY(IEN,<field #>,"PROMT") = Mixed Case of Field Name
198 ;
199 D GET^GMTSOBS2(+($G(X)),.ARY)
200 Q
201DEF(X,ARY) ; Extract a Health Summary Object Definition
202 ;
203 ; Input X IEN for Health Summary Object (#142.5)
204 ; Output ARY() Array of fields and values
205 ; (passed by reference)
206 ;
207 ; ARY("D",0) = # of lines in Definition
208 ; ARY("D",#) = Definition Text
209 ; ARY("E",0) = # of lines in Example
210 ; ARY("E",#) = Example Text
211 ;
212 D DEF^GMTSOBS(+($G(X)),.ARY)
213 Q
214DIS(DFN,OBJ) ; Display Object
215 ;
216 ; Input DFN IEN for Patient (#2)
217 ; OBJ IEN for Health Summary Object (#142.5)
218 ;
219 ; Output Display of Health Summary data
220 ;
221 D DIS^GMTSOBS2(+($G(DFN)),$G(OBJ))
222 Q
223STMP ; Show TMP
224 N GMTSNN,GMTSNC S GMTSNN="^TMP(""GMTSOBJ"","_$J_",""OGBL"")",GMTSNC="^TMP(""GMTSOBJ"","_$J_",""OGBL"","
225 F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) W !,GMTSNN,"=",@GMTSNN
226 Q
Note: See TracBrowser for help on using the repository browser.