source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSOBE.m@ 1076

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

initial load of WorldVistAEHR
File size: 6.7 KB
Line 
1GMTSOBE ; SLC/KER - HS Object - Export ; 01/06/2003
2 ;;2.7;Health Summary;**58**;Oct 20, 1995
3 ;
4 ; External References
5 ;
6 ; DBIA 10096 ^%ZOSF("DEL"
7 ; DBIA 2056 $$GET1^DIQ (file #200 and 4.3)
8 ; DBIA 10112 $$SITE^VASITE
9 ; DBIA 10103 $$DOW^XLFDT
10 ; DBIA 10103 $$DT^XLFDT
11 ; DBIA 10103 $$FMTE^XLFDT
12 ; DBIA 10103 $$NOW^XLFDT
13 ; DBIA 10104 $$UP^XLFSTR
14 ; DBIA 10070 ^XMD
15 ;
16EN ; Main Entry Point to Export a HS Object
17 N %Z,GMTS,GMTSCP,GMTSD,GMTSDM,GMTSDT,GMTSDW,GMTSEX,GMTSFRM,GMTSHD
18 N GMTSI,GMTSN,GMTSNC,GMTSND,GMTSNN,GMTSNX,GMTSO,GMTSON,GMTSOND
19 N GMTSQIT,GMTSRT,GMTSRTN,GMTSSX,GMTST,GMTSTMP,GMTSTN,GMTSTN0
20 N GMTSTNAT,GMTSTNT,GMTSTNV,GMTSTR,GMTSTT,GMTSTXT,GMTSUSR,GMTSX
21 N X,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ,Y I +($G(DUZ))=0 W !!," User not defined" Q
22 S GMTSUSR=$$GET1^DIQ(200,(+($G(DUZ))_","),.01) I '$L(GMTSUSR) W !!," Invalid User" Q
23 S X=$$OBJ^GMTSOBL Q:+X'>0 S GMTSFRM=$P($$SITE^VASITE,"^",2),GMTSO=+X,GMTSOND=$G(^GMT(142.5,+GMTSO,0))
24 S GMTSON=$P(GMTSOND,"^",1),GMTST=+($P(GMTSOND,"^",3)) Q:GMTST=0
25 S GMTSTN0=$G(^GMT(142,+GMTST,0)),GMTSTNT=$G(^GMT(142,+GMTST,"T"))
26 S GMTSTNV=$G(^GMT(142,+GMTST,"VA")),GMTSTN=$P(GMTSTN0,"^",1) Q:'$L(GMTSTN)
27 S GMTSTT=$P(GMTSTNT,"^",1) S:'$L(GMTSTT)&($L(GMTSTN)) GMTSTT=$$EN2^GMTSUMX(GMTSTN)
28 I GMTSTN="GMTS HS ADHOC OPTION" D Q
29 . W !," Can not export a Health Summary Object using GMTS HS ADHOC OPTION",!," (Adhoc) Health Summary Type."
30 S GMTSTNAT=+GMTSTNV I GMTSTNAT>0 D Q
31 . W !," Can not export a Health Summary Object using a nationally released",!," Remote Data View Health Summary Type."
32 S GMTSRTN="GMTSOBX" D INIT,TYPE,OBJ,MAIL
33 K ^TMP($J,"GMTSOBXM")
34 Q
35INIT ; Initialize Export Routine
36 Q:'$L(GMTSON) Q:'$L(GMTSFRM) Q:'$L(GMTSUSR)
37 W !!," Exporting Object Routine - ",GMTSRTN D CRTN(GMTSRTN)
38 N GMTST,GMTSI
39 K ^TMP($J,"GMTSOBXM")
40 S GMTST=$$CREATED D TL(GMTST)
41 D BL D:$L($G(GMTSON)) TL((" Object: "_GMTSON))
42 D:$L($G(GMTSFRM)) TL((" From: "_GMTSFRM))
43 D:$L($G(GMTSUSR)) TL((" Sender: "_GMTSUSR))
44 D:$L($G(GMTSON))!($L($G(GMTSFRM)))!($L($G(GMTSUSR))) BL
45 D TL(" 1) Use Packman to unpack the routine GMTSOBX contained in this message."),BL
46 D TL(" 2) Use the following Option to install the Health Summary Object")
47 D TL(" contained in this message."),BL
48 D TL(" GMTS OBJ IMPORT/INSTALL")
49 D TL(" Import/Install a Health Summary Object"),BL
50 D TL(" or run the routine INS^GMTSOBJ"),BL
51 D TL("$END TXT")
52 D TL(("$ROU "_GMTSRTN))
53 D TL((GMTSRTN_" ; CIO/SLC - HS Exported Object ; "_$P($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@",1)))
54 D TL((" ;;"_$$VER_";Health Summary;;Oct 20, 1995")),S
55 D:$L($G(GMTSON)) TL((" ; Object: "_GMTSON))
56 D:$L($G(GMTSFRM)) TL((" ; From: "_GMTSFRM))
57 D:$L($G(GMTSUSR)) TL((" ; Sender: "_GMTSUSR)) D S,Q
58 Q
59 ;
60TYPE ; Export Health Summary Type
61 ; This will not export:
62 ; National Health Summary Types
63 ; Local Components
64 ; Components with Selected Items
65 N GMTSCP,GMTSHD,GMTSNC,GMTSND,GMTSNN,GMTSRT,GMTSTMP,GMTSTR
66 N GMTSNX,GMTSSX,GMTSD
67 D TL(("TYPE ; Health Summary Type"))
68 I +($G(^GMT(142,+GMTST,"VA")))>0 D Q Q
69 D TL((" ;"_GMTSTN)),TL((" ;"_GMTSTT))
70 S GMTSTMP=$G(^GMT(142,+($G(GMTST)),0)),GMTSTMP=GMTSTN,$P(GMTSTMP,"^",2)="",$P(GMTSTMP,"^",5)=""
71 D TL((" ;0;"_GMTSTMP))
72 S GMTSRT="^GMT(142,"_+($G(GMTST))_","
73 S GMTSNN="^GMT(142,"_+($G(GMTST))_",1)"
74 S GMTSNC="^GMT(142,"_+($G(GMTST))_",1," S GMTSTR=1
75 F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) D
76 . S GMTSTR=$P($P(GMTSNN,GMTSRT,2),")",1)
77 . S:$P(GMTSTR,",",3)="1" GMTSD(+($P(GMTSTR,",",2)))="" Q:$P(GMTSTR,",",3)="1"
78 . S GMTSNX=$Q(@GMTSNN),GMTSSX=$P($P(GMTSNX,GMTSRT,2),")",1)
79 . S:$P(GMTSSX,",",3)="1" GMTSD(+($P(GMTSSX,",",2)))="" Q:$P(GMTSSX,",",3)="1"
80 . S GMTSND=@GMTSNN I GMTSTR="1,0" D TL((" ;"_GMTSTR_";"_GMTSND)) Q
81 . S GMTSCP=+($P(GMTSND,"^",2)) Q:+GMTSCP>1000
82 . S GMTSHD=$P($G(^GMT(142.1,+GMTSCP,0)),"^",9)
83 . S:$P(GMTSND,"^",5)="" $P(GMTSND,"^",5)=GMTSHD
84 . S:+($P(GMTSTR,",",2))=0 GMTSND=""
85 . I +($P(GMTSTR,",",2))=0,+($P(GMTSTR,",",4))>0,$D(GMTSD(+($P(GMTSTR,",",4)))) Q
86 . D TL((" ;"_GMTSTR_";"_GMTSND))
87 D TL((" ;99;"_$H)) D:$L(GMTSTT) TL((" ;""T"";"_GMTSTT)) D Q
88 Q
89 ;
90OBJ ; Export an Object
91 N GMTSNC,GMTSND,GMTSNN,GMTSRT,GMTSTMP,GMTSTR
92 D TL(("OBJ ; Health Summary Object")),TL((" ;"_GMTSON))
93 S GMTSTMP=$G(^GMT(142.5,+GMTSO,0)),$P(GMTSTMP,"^",3)="",$P(GMTSTMP,"^",17)="",$P(GMTSTMP,"^",18)="",$P(GMTSTMP,"^",19)=""
94 D TL((" ;0;"_GMTSTMP)) S GMTSRT="^GMT(142.5,"_+($G(GMTSO))_","
95 S GMTSNN="^GMT(142.5,"_+($G(GMTSO))_",1)",GMTSNC="^GMT(142.5,"_+($G(GMTSO))_",1,"
96 F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) D
97 . S GMTSTR=$P($P(GMTSNN,GMTSRT,2),")",1),GMTSND=@GMTSNN D TL((" ;"_GMTSTR_";"_GMTSND))
98 D Q,TL(("$END ROU "_GMTSRTN))
99 Q
100 ;
101 ; Message
102Q ; Quit Line
103 D TL(" Q") Q
104S ; Spacer/Comment Line
105 D TL(" ; ") Q
106BL ; Blank Line
107 D TL(" ") Q
108TL(X) ; Text Line
109 N GMTS S GMTS=+($G(^TMP($J,"GMTSOBXM",0))),GMTS=GMTS+1
110 S ^TMP($J,"GMTSOBXM",GMTS,0)=$G(X),^TMP($J,"GMTSOBXM",0)=GMTS
111 Q
112 ;
113 ; Mailman Support
114MAIL ; Send Object via Mailman
115 N %Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,GMTSN,GMTSQIT Q:'$D(^TMP($J,"GMTSOBXM"))
116 S XMDUZ=+($G(DUZ)) S:+XMDUZ=0 GMTSQIT=1 S GMTSN=$$XMY S:'$L(GMTSN) GMTSQIT=1 S:$L(GMTSN) XMY(GMTSN)=""
117 S XMSUB=$$XMSUB S:'$L(XMSUB) GMTSQIT=1 S XMTEXT="^TMP("_$J_",""GMTSOBXM""," Q:+($G(GMTSQIT))>0
118 D:+($G(GMTSQIT))'>0 ^XMD I +($G(XMZ))>0 H 1 W !," Message [",+($G(XMZ)),"] sent"
119 K %Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,^TMP($J,"GMTSOBXM")
120 Q
121XMY(X) ; Get Addressee
122 S X=$$GET1^DIQ(200,(+($G(DUZ))_","),.01) Q X
123XMSUB(X) ; Get Subject
124 N GMTSON S GMTSON=$P($G(^GMT(142.5,+($G(GMTSO)),0)),"^",1)
125 S X="Exported Health Summary Object" S:$L(GMTSON) X=$E(("Export HS Obj: "_GMTSON),1,65)
126 Q X
127DOM(X) ; Domain
128 S X=$$GET1^DIQ(4.3,"1,",.01) Q X
129DOW(X) ; Day of Week
130 S X=$$DT^XLFDT,X=$$DOW^XLFDT(X),X=$$UP^XLFSTR(X) Q X
131NOW(X) ; Now
132 N GMTSD,GMTST S X=$$NOW^XLFDT,X=$$FMTE^XLFDT(X,"5Z"),GMTSD=$P(X,"@",1)
133 S GMTST=$P($P(X,"@",2),":",1,2),X=GMTSD S:$L(GMTST) X=GMTSD_" at "_GMTST
134 Q X
135 ;
136 ; Miscellaneous
137CRTN(X) ; Clear Routine
138 S X=$G(X) Q:'$L(X) Q:$L(X)>8 Q:$$ROK(X)=0 X ^%ZOSF("DEL") Q
139VER(X) ; Health Summary Version
140 N GMTSEX,GMTSTXT S X="GMTS",GMTSEX="S GMTSTXT=$T(+2^"_X_")" X GMTSEX S X=$P(GMTSTXT,";",3) Q X
141ROK(X) ; Routine is OK
142 S X=$G(X) Q:'$L(X) 0
143 N GMTSEX,GMTSTXT S GMTSEX="S GMTSTXT=$T(+1^"_X_")" X GMTSEX Q:'$L(GMTSTXT) 0 Q 1
144CREATED(X) ; Created Text
145 N GMTST,GMTSN,GMTSDM,GMTSDW,GMTSDT S GMTST="$TXT",GMTSN=$$XMY S:$L(GMTSN) GMTST=GMTST_" Created by "_GMTSN
146 S GMTSDM=$$DOM S:$L(GMTSDM) GMTST=GMTST_" at "_GMTSDM S GMTSDW=$$DOW S:$L(GMTSDW) GMTST=GMTST_" on "_GMTSDW
147 S GMTSDT=$$NOW S:$L(GMTSDT) GMTST=GMTST_", "_GMTSDT S X=GMTST
148 Q X
Note: See TracBrowser for help on using the repository browser.