source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSOBS.m@ 841

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

initial load of WorldVistAEHR
File size: 8.0 KB
RevLine 
[613]1GMTSOBS ; SLC/KER - HS Object - Show ; 01/06/2003
2 ;;2.7;Health Summary;**58**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10103 $$FMADD^XLFDT
6 ; DBIA 10103 $$NOW^XLFDT
7 ; DBIA 10103 $$FMTE^XLFDT
8 ; DBIA 10104 $$UP^XLFSTR
9 ; DBIA 2056 $$GET1^DIQ (file #200)
10 ; DBIA 10060 ^VA(200, (read w/fileman)
11 ; DBIA 10086 ^%ZIS
12 ; DBIA 10086 HOME^%ZIS
13 ; DBIA 10089 ^%ZISC
14 ; DBIA 10088 ENDR^%ZISS
15 ; DBIA 10063 ^%ZTLOAD
16 ;
17 Q
18DEF(X,GMTSARY) ; Extract Object Definition/Example
19 N GMTSEXT S GMTSEXT="" D SO($G(X)) Q
20SO(X) ; Show Object
21 N GMTSNAM,GMTSLBL,GMTSTYP,GMTSHST,GMTSPER,GMTSNOD,GMTSPLB
22 N GMTSLBB,GMTSRDT,GMTSCON,GMTSRHD,GMTSCHD,GMTSUND,GMTSLIM,GMTSBLK
23 N GMTSDEC,GMTSOWN,GMTSCRE,GMTSMOD,GMTSUNT,GMTSLEN,GMTSTIM,GMTSI
24 N GMTSO,GMTSL,GMTSDTM,GMTSDED,GMTSDCH,GMTSDCN,GMTSTIM,GMTSWIN,TXT S U="^"
25 S GMTSO=$G(^GMT(142.5,+($G(X)),0))
26 S GMTSNAM=$P(GMTSO,U,1) Q:'$L(GMTSNAM)
27 S GMTSLBL=$P(GMTSO,U,2) S:'$L(GMTSLBL) GMTSLBL="UNSPECIFIED"
28 S (GMTSHST,GMTSTYP)=+($P(GMTSO,U,3)) Q:+GMTSTYP=0
29 S GMTSTYP=$P($G(^GMT(142,+GMTSTYP,0)),"^",1) Q:'$L(GMTSTYP)
30 S GMTSPER=$P(GMTSO,U,4)
31 S GMTSLEN=+GMTSPER
32 S GMTSUNT=$E(GMTSPER,$L(GMTSPER))
33 S:+GMTSUNT>0 GMTSUNT="D"
34 ;
35 S GMTSNOD=+($P(GMTSO,U,5))
36 S GMTSHDR=+($P(GMTSO,U,6))
37 S GMTSPLB=+($P(GMTSO,U,7))
38 S GMTSLBB=+($P(GMTSO,U,8))
39 S GMTSRDT=+($P(GMTSO,U,9))
40 S GMTSCON=+($P(GMTSO,U,10))
41 S GMTSRHD=+($P(GMTSO,U,11))
42 S GMTSCHD=+($P(GMTSO,U,12))
43 S GMTSUND=+($P(GMTSO,U,13))
44 S GMTSLIM=+($P(GMTSO,U,14))
45 S GMTSBLK=+($P(GMTSO,U,15))
46 S GMTSDEC=+($P(GMTSO,U,16))
47 S GMTSOWN=+($P(GMTSO,U,17)),GMTSOWN=$$GET1^DIQ(200,(+GMTSOWN_","),.01)
48 S GMTSCRE=+($P(GMTSO,U,18)),GMTSCRE=$TR($$FMTE^XLFDT(GMTSCRE,"5ZM"),"@"," ")
49 S GMTSMOD=+($P(GMTSO,U,19)),GMTSMOD=$TR($$FMTE^XLFDT(GMTSMOD,"5ZM"),"@"," ")
50 S (GMTSTIM,GMTSPER)=$P(GMTSO,"^",4),GMTSTIM=$S($E(GMTSTIM,$L(GMTSTIM))="Y":" year",$E(GMTSTIM,$L(GMTSTIM))="M":" month",$E(GMTSTIM,$L(GMTSTIM))="W":" week",1:" day")
51 S:+GMTSPER>1 GMTSTIM=GMTSTIM_"s" S GMTSTIM=+GMTSPER_GMTSTIM
52 I $L(GMTSPER) D
53 . N GMTSPX1,GMTSPX2,GMTSLEN,GMTSUNT,GMTSDIF
54 . S GMTSPX1=$$NOW^XLFDT,GMTSUNT=$E(GMTSPER,$L(GMTSPER)),GMTSLEN=+GMTSPER
55 . I +GMTSLEN=0!($L(GMTSUNT)'=1)!("DWMY"'[GMTSUNT) S GMTSPER="" Q
56 . S:GMTSUNT="D" GMTSDIF=GMTSLEN S:GMTSUNT="W" GMTSDIF=GMTSLEN*7
57 . S:GMTSUNT="M" GMTSDIF=GMTSLEN*30.4 S:GMTSUNT="Y" GMTSDIF=GMTSLEN*365.25
58 . S GMTSDIF=$P(GMTSDIF,".",1),GMTSPX2=$$FMADD^XLFDT(GMTSPX1,-(GMTSDIF))
59 . S GMTSPX1=$$UP^XLFSTR($$FMTE^XLFDT(GMTSPX1,"ZD"))
60 . S GMTSPX2=$$UP^XLFSTR($$FMTE^XLFDT(GMTSPX2,"ZD"))
61 . S GMTSWIN=GMTSPER_" ("_GMTSPX2_" - "_GMTSPX1_")"
62 S:'$L(GMTSPER) GMTSPER="UNSPECIFIED"
63 S:$L($G(GMTSTIM))&('$L($G(GMTSWIN))) GMTSWIN=$G(GMTSTIM)
64 W:$L($G(GMTSHDR(1))) !,GMTSHDR(1)
65 W:$L($G(GMTSHDR(2))) !,GMTSHDR(2)
66 ;
67 S TXT=" OBJECT NAME: "_$G(GMTSNAM)
68 D D(TXT)
69 S TXT=" HEALTH SUMMARY TYPE: "_$G(GMTSTYP)
70 D D(TXT)
71 ;
72 S TXT=" REPORT PERIOD: "_$G(GMTSPER),TXT=TXT_$J(" ",(41-$L(TXT)))_"PRINT REPORT DATE/TIME: "_$S(+GMTSHDR>0&(+GMTSRDT>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
73 D D(TXT)
74 ;
75 S TXT=" LABEL: "_$G(GMTSLBL),TXT=TXT_$J(" ",(41-$L(TXT)))_"PRINT CONFIDENTIALITY BANNER: "_$S(+GMTSHDR>0&(+GMTSCON>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
76 D D(TXT)
77 ;
78 S TXT=" PRINT LABEL: "_$S(+GMTSPLB>0:"YES",1:"NO"),TXT=TXT_$J(" ",(41-$L(TXT)))_"PRINT REPORT HEADER: "_$S(+GMTSHDR>0&(+GMTSRHD>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
79 D D(TXT)
80 ;
81 S TXT=" BLANK LINE AFTER LABEL: "_$S(+GMTSLBB>0:"YES",1:"NO"),TXT=TXT_$J(" ",(41-$L(TXT)))_"PRINT COMPONENT HEADER: "_$S(+GMTSHDR>0&(+GMTSCHD>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
82 D D(TXT)
83 ;
84 S TXT=" SUPPRESS COMPONENTS W/O DATA: "_$S(+GMTSNOD>0:"YES",1:"NO")
85 S TXT=TXT_$J(" ",(41-$L(TXT)))_" PRINT TIME-OCCURRENCE LIMITS: "_$S(+GMTSHDR>0&(+GMTSLIM>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
86 D D(TXT)
87 ;
88 S TXT=" SUPPRESS HEADER: "_$S(+GMTSHDR>0:"YES",1:"NO")
89 S TXT=TXT_$J(" ",(41-$L(TXT)))_" UNDERLINE COMPONENT HEADER: "_$S(+GMTSHDR>0&(+GMTSUND>0):"YES",1:"NO")
90 D D(TXT)
91 ;
92 S TXT=" SUPPRESS DECEASED INFORMATION: "_$S(+GMTSHDR>0&(+GMTSDEC>0):"NO",1:"YES")
93 S TXT=TXT_$J(" ",(41-$L(TXT)))_" BLANK LINE AFTER HEADER: "_$S(+GMTSHDR>0&(+GMTSBLK>0):"YES",+GMTSHDR'>0:"YES",1:"NO")
94 D D(TXT)
95 ;
96 S TXT=" CREATOR: "_GMTSOWN
97 S TXT=TXT_$J(" ",(41-$L(TXT)))_"CREATED: "_GMTSCRE
98 D D(TXT)
99 ;
100 S TXT="",TXT=TXT_$J(" ",(41-$L(TXT)))_"LAST MODIFIED: "_GMTSMOD
101 D D(TXT)
102 ;
103 Q:$D(GMTSABRR)
104 ;
105 S TXT=" EXAMPLE:" D E(TXT)
106 S GMTSDTM=$$NOW^XLFDT,GMTSDED=$$FMADD^XLFDT(GMTSDTM,-2000)
107 S GMTSDED=$TR($$FMTE^XLFDT($P(GMTSDED,".",1),"2ZM"),"@"," ")
108 S GMTSDTM=$TR($$FMTE^XLFDT(GMTSDTM,"2ZM"),"@"," ")
109 S GMTSDCH=$$DCH(+($G(GMTSHST))),GMTSDCN=$P(GMTSDCH,"^",2),GMTSDCH=$P(GMTSDCH,"^",1)
110 S:'$L(GMTSDCH) GMTSDCH="PN - Progress Notes" S GMTSTIM=$$TIM($G(GMTSPER))
111 D:+GMTSHDR>0 SP^GMTSOBS2
112 D:+GMTSHDR'>0 HS^GMTSOBS2
113 Q
114DCH(X) ; Default Component Header
115 N GMTSABR,GMTSDHD,GMTSDCH,GMTSDCN,GMTSTYP S GMTSTYP=+($G(X)),GMTSABR=$O(^GMT(142,+GMTSTYP,1,0))
116 S GMTSABR=$G(^GMT(142,+GMTSTYP,1,+GMTSABR,0)),GMTSABR=+($P(GMTSABR,"^",2))
117 S GMTSDCN=$P($G(^GMT(142.1,+GMTSABR,0)),"^",1),GMTSDHD=$P($G(^GMT(142.1,+GMTSABR,0)),"^",9),GMTSABR=$P($G(^GMT(142.1,+GMTSABR,0)),"^",4)
118 S GMTSDCH=$S($L(GMTSABR)&($L(GMTSDHD)):(GMTSABR_" - "_GMTSDHD),1:"PN - Progress Notes")
119 S X=GMTSDCH_"^"_GMTSDCN Q X
120TIM(X) ; Time
121 N GMTSTIM,GMTSPER S (GMTSTIM,GMTSPER)=$G(X) S:'$L(GMTSTIM) (GMTSTIM,GMTSPER)="3M"
122 S GMTSTIM=$S($E(GMTSTIM,$L(GMTSTIM))="Y":" year",$E(GMTSTIM,$L(GMTSTIM))="M":" month",$E(GMTSTIM,$L(GMTSTIM))="W":" week",1:" day")
123 S:+GMTSPER>1 GMTSTIM=GMTSTIM_"s" S GMTSTIM=+GMTSPER_GMTSTIM
124 S X=GMTSTIM Q X
125 Q
126DEV ; Device
127 I +($G(DFN))=0!('$D(^TMP("GMTSOBJ",$J,DFN))) K ^TMP("GMTSOBJ",$J,DFN) Q
128 I $D(CAP) D NODEV K ^TMP("GMTSOBJ",$J,DFN) Q
129 N ZTRTN,%ZIS,IOP,POP S %ZIS="PQ" D ^%ZIS Q:POP I $D(IO("Q")) D QUE Q
130NOQUE ; Print without Queuing
131 N ZTRTN S ZTRTN="DSP^GMTSOBS"
132 I $D(IOST),$D(IOF) W:IOST["C-"&('$D(GMTSNOI)) @IOF
133 D @ZTRTN,^%ZISC K ^TMP("GMTSOBJ",$J,DFN) Q
134QUE ; Queued Print
135 N %,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK,ZTRTN S ZTRTN="DSP^GMTSOBS" K IO("Q"),ZTSAVE
136 S ZTSAVE("^TMP(""GMTSOBJ"","_$J_","_DFN_",")="" S ZTSAVE("DFN")=""
137 S:$D(GMTSHDR) ZTSAVE("GMTSHDR")=""
138 S ZTDESC="Display Health Summary Object" S ZTIO=ION,ZTDTH=$H
139 D ^%ZTLOAD I '$D(ZTSK) W !!,"Request Cancelled",! H 3 W:$D(IOF) @IOF
140 I $D(ZTSK) W !!,"Request Queued",! H 3 W:$D(IOF) @IOF
141 K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC Q
142 Q
143NODEV ; Print without Device Selection
144 W !! N ZTRTN,POP,IOP,%ZIS,IOSL S IOSL=99999999999
145 S ZTRTN="DSP^GMTSOBS" D @ZTRTN,^%ZISC K ^TMP("GMTSOBJ",$J,DFN)
146 Q
147DSP ; Print Health Summary Type
148 Q:+($G(DFN))=0 N GMTST,GMTSI,GMTSC,GMTSP,GMTSL,GMTSEXIT,GMTSCR,GMTSPL D HOME^%ZIS
149 S GMTSPL=3,GMTSEXIT=0,GMTSP=$G(IOST),GMTSL=+($G(IOSL)) S:+GMTSL=0 GMTSL=24
150 D ATTR W !!,$G(BOLD),"<----------------------------- Break in Document ---------------------------->",$G(NORM) S GMTSPL=GMTSPL+1
151 W !,$G(BOLD),"<---------------------------- Beginning of Object --------------------------->",$G(NORM) S GMTSPL=GMTSPL+1 D KATTR
152 S GMTSI=0 F S GMTSI=$O(^TMP("GMTSOBJ",$J,DFN,GMTSI)) Q:+GMTSI=0 D
153 . W !,$G(^TMP("GMTSOBJ",$J,DFN,GMTSI,0)) S GMTSPL=+GMTSPL+1 D CONT
154 K ^TMP("GMTSOBJ",$J,DFN)
155 D ATTR W !,$G(BOLD),"<------------------------------ End of Object ------------------------------->",$G(NORM) S GMTSPL=+GMTSPL+1
156 W !,$G(BOLD),"<----------------------------- Document Resumes ----------------------------->",$G(NORM) D KATTR S GMTSPL=+GMTSPL+1 S:+GMTSL>0 IOSL=GMTSL
157 S GMTSPL=GMTSL D CONT W:GMTSP["P-"&($D(IOF)) @IOF
158 Q
159D(X) ; Display
160 I '$D(GMTSEXT) W !,$G(X) Q
161 N GMTSC S GMTSC=$G(GMTSARY("D",0))+1,GMTSARY("D",+GMTSC)=$G(X),GMTSARY("D",0)=GMTSC
162 Q
163E(X) ; Example
164 I '$D(GMTSEXT) W !,$G(X) Q
165 N GMTSC S GMTSC=$G(GMTSARY("E",0))+1,GMTSARY("E",+GMTSC)=$G(X),GMTSARY("E",0)=GMTSC
166 Q
167CONT ; Press <Return> to Continue
168 I GMTSP["P-" W:$L($G(IOF))&($D(IOF)) @IOF Q
169 Q:(GMTSP["C-"!(GMTSP=""))&(GMTSPL'>(GMTSL-4)) S GMTSPL=0 Q:GMTSEXIT
170 N GMTSCR S GMTSPL=0 W !!," Press <Return> to Continue "
171 R GMTSCR:660 I '$T!(GMTSCR["^") S GMTSCR="^",GMTSEXIT=1
172 W:GMTSP'["P-"&($D(IOF)) @IOF Q
173 Q
174ATTR ; Set Screen Attributes
175 N X,IOINHI,IOINORM S X="IOINHI;IOINORM" D ENDR^%ZISS S BOLD=$G(IOINHI),NORM=$G(IOINORM)
176 Q
177KATTR ; Kill Screen Attributes
178 K NORM,BOLD Q
Note: See TracBrowser for help on using the repository browser.