GMTSOBE ; SLC/KER - HS Object - Export ; 05/22/2008
;;2.7;Health Summary;**89,107**;Oct 20, 1995;Build 3
;
; External References
;
; DBIA 10096 ^%ZOSF("DEL"
; DBIA 2056 $$GET1^DIQ (file #200 and 4.3)
; DBIA 10112 $$SITE^VASITE
; DBIA 10103 $$DOW^XLFDT
; DBIA 10103 $$DT^XLFDT
; DBIA 10103 $$FMTE^XLFDT
; DBIA 10103 $$NOW^XLFDT
; DBIA 10104 $$UP^XLFSTR
; DBIA 10070 ^XMD
;
EN ; Main Entry Point to Export a HS Object
N %Z,GMTS,GMTSCP,GMTSD,GMTSDM,GMTSDT,GMTSDW,GMTSEX,GMTSFRM,GMTSHD
N GMTSI,GMTSN,GMTSNC,GMTSND,GMTSNN,GMTSNX,GMTSO,GMTSON,GMTSOND
N GMTSQIT,GMTSRT,GMTSRTN,GMTSSX,GMTST,GMTSTMP,GMTSTN,GMTSTN0
N GMTSTNAT,GMTSTNT,GMTSTNV,GMTSTR,GMTSTT,GMTSTXT,GMTSUSR,GMTSX
N X,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ,Y I +($G(DUZ))=0 W !!," User not defined" Q
S GMTSUSR=$$GET1^DIQ(200,(+($G(DUZ))_","),.01) I '$L(GMTSUSR) W !!," Invalid User" Q
S X=$$OBJ^GMTSOBL Q:+X'>0 S GMTSFRM=$P($$SITE^VASITE,"^",2),GMTSO=+X,GMTSOND=$G(^GMT(142.5,+GMTSO,0))
S GMTSON=$P(GMTSOND,"^",1),GMTST=+($P(GMTSOND,"^",3)) Q:GMTST=0
S GMTSTN0=$G(^GMT(142,+GMTST,0)),GMTSTNT=$G(^GMT(142,+GMTST,"T"))
S GMTSTNV=$G(^GMT(142,+GMTST,"VA")),GMTSTN=$P(GMTSTN0,"^",1) Q:'$L(GMTSTN)
S GMTSTT=$P(GMTSTNT,"^",1) S:'$L(GMTSTT)&($L(GMTSTN)) GMTSTT=$$EN2^GMTSUMX(GMTSTN)
I GMTSTN="GMTS HS ADHOC OPTION" D Q
. W !," Can not export a Health Summary Object using GMTS HS ADHOC OPTION",!," (Adhoc) Health Summary Type."
S GMTSTNAT=+GMTSTNV I GMTSTNAT>0 D Q
. W !," Can not export a Health Summary Object using a nationally released",!," Remote Data View Health Summary Type."
;p.107 added error msg for local components and components with selected Items
N GMTSCDA,GMTSCERR,GMTSERR S (GMTSCDA,GMTSCERR,GMTSERR)=0
F S GMTSCDA=$O(^GMT(142,GMTST,1,GMTSCDA)) Q:'GMTSCDA D
.I $P($G(^GMT(142,GMTST,1,GMTSCDA,0)),U,2)>1000 S GMTSCERR=1,GMTSCERR("LOC",$P($G(^GMT(142,GMTST,1,GMTSCDA,0)),U,2))=1
.I $O(^GMT(142,GMTST,1,GMTSCDA,0)) S GMTSCERR=1,GMTSCERR("SEL",$P($G(^GMT(142,GMTST,1,GMTSCDA,0)),U,2))=1
I GMTSCERR W ! D W !!,"Object NOT Exported!!",!!,"Press any key...." N X R X:DTIME Q
.I $O(GMTSCERR("LOC",0)) D
..W !!,"Cannot export a Health Summary Object using a Health Summary Type",!,"that contains Local Health Summary Components",!
..S GMTSERR=0 F S GMTSERR=$O(GMTSCERR("LOC",GMTSERR)) Q:'GMTSERR D
...W !,"Health Summary Type "_$P($G(^GMT(142,GMTST,0)),U)_" contains Local Health Summary",!,"Component "_$P($G(^GMT(142.1,GMTSERR,0)),U)
.I $O(GMTSCERR("SEL",0)) D
..W !!,"Cannot export a Health Summary Object using a Health Summary Type",!,"that contains Health Summary Components with Selected Items",!
..S GMTSERR=0 F S GMTSERR=$O(GMTSCERR("SEL",GMTSERR)) Q:'GMTSERR D
...W !,"Health Summary Type "_$P($G(^GMT(142,GMTST,0)),U)_" contains Health Summary Component ",!,$P($G(^GMT(142.1,GMTSERR,0)),U)_" with Selected Items"
S GMTSRTN="GMTSOBX" D INIT,TYPE,OBJ,MAIL
K ^TMP($J,"GMTSOBXM")
Q
INIT ; Initialize Export Routine
Q:'$L(GMTSON) Q:'$L(GMTSFRM) Q:'$L(GMTSUSR)
W !!," Exporting Object Routine - ",GMTSRTN D CRTN(GMTSRTN)
N GMTST,GMTSI
K ^TMP($J,"GMTSOBXM")
S GMTST=$$CREATED D TL(GMTST)
D BL D:$L($G(GMTSON)) TL((" Object: "_GMTSON))
D:$L($G(GMTSFRM)) TL((" From: "_GMTSFRM))
D:$L($G(GMTSUSR)) TL((" Sender: "_GMTSUSR))
D:$L($G(GMTSON))!($L($G(GMTSFRM)))!($L($G(GMTSUSR))) BL
D TL(" 1) Use Packman to unpack the routine GMTSOBX contained in this message."),BL
D TL(" 2) Use the following Option to install the Health Summary Object")
D TL(" contained in this message."),BL
D TL(" GMTS OBJ IMPORT/INSTALL")
D TL(" Import/Install a Health Summary Object"),BL
D TL(" or run the routine INS^GMTSOBJ"),BL
D TL("$END TXT")
D TL(("$ROU "_GMTSRTN))
D TL((GMTSRTN_" ; CIO/SLC - HS Exported Object ; "_$P($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@",1)))
D TL((" ;;"_$$VER_";Health Summary;;Oct 20, 1995")),S
D:$L($G(GMTSON)) TL((" ; Object: "_GMTSON))
D:$L($G(GMTSFRM)) TL((" ; From: "_GMTSFRM))
D:$L($G(GMTSUSR)) TL((" ; Sender: "_GMTSUSR)) D S,Q
Q
;
TYPE ; Export Health Summary Type
; This will not export:
; National Health Summary Types
; Local Components
; Components with Selected Items
N GMTSCP,GMTSHD,GMTSNC,GMTSND,GMTSNN,GMTSRT,GMTSTMP,GMTSTR
N GMTSNX,GMTSSX,GMTSD
D TL(("TYPE ; Health Summary Type"))
I +($G(^GMT(142,+GMTST,"VA")))>0 D Q Q
D TL((" ;"_GMTSTN)),TL((" ;"_GMTSTT))
S GMTSTMP=$G(^GMT(142,+($G(GMTST)),0)),GMTSTMP=GMTSTN,$P(GMTSTMP,"^",2)="",$P(GMTSTMP,"^",5)=""
D TL((" ;0;"_GMTSTMP))
S GMTSRT="^GMT(142,"_+($G(GMTST))_","
S GMTSNN="^GMT(142,"_+($G(GMTST))_",1)"
S GMTSNC="^GMT(142,"_+($G(GMTST))_",1," S GMTSTR=1
F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) D
. S GMTSTR=$P($P(GMTSNN,GMTSRT,2),")",1)
. S:$P(GMTSTR,",",3)="1" GMTSD(+($P(GMTSTR,",",2)))="" Q:$P(GMTSTR,",",3)="1"
. S GMTSNX=$Q(@GMTSNN),GMTSSX=$P($P(GMTSNX,GMTSRT,2),")",1)
. S:$P(GMTSSX,",",3)="1" GMTSD(+($P(GMTSSX,",",2)))="" Q:$P(GMTSSX,",",3)="1"
. S GMTSND=@GMTSNN I GMTSTR="1,0" D TL((" ;"_GMTSTR_";"_GMTSND)) Q
. S GMTSCP=+($P(GMTSND,"^",2)) Q:+GMTSCP>1000
. S GMTSHD=$P($G(^GMT(142.1,+GMTSCP,0)),"^",9)
. S:$P(GMTSND,"^",5)="" $P(GMTSND,"^",5)=GMTSHD
. S:+($P(GMTSTR,",",2))=0 GMTSND=""
. I +($P(GMTSTR,",",2))=0,+($P(GMTSTR,",",4))>0,$D(GMTSD(+($P(GMTSTR,",",4)))) Q
. D TL((" ;"_GMTSTR_";"_GMTSND))
D TL((" ;99;"_$H)) D:$L(GMTSTT) TL((" ;""T"";"_GMTSTT)) D Q
Q
;
OBJ ; Export an Object
N GMTSNC,GMTSND,GMTSNN,GMTSRT,GMTSTMP,GMTSTR
D TL(("OBJ ; Health Summary Object")),TL((" ;"_GMTSON))
S GMTSTMP=$G(^GMT(142.5,+GMTSO,0)),$P(GMTSTMP,"^",3)="",$P(GMTSTMP,"^",17)="",$P(GMTSTMP,"^",18)="",$P(GMTSTMP,"^",19)=""
D TL((" ;0;"_GMTSTMP)) S GMTSRT="^GMT(142.5,"_+($G(GMTSO))_","
S GMTSTMP=$G(^GMT(142.5,+GMTSO,2)) D TL((" ;2;"_GMTSTMP))
S GMTSNN="^GMT(142.5,"_+($G(GMTSO))_",1)",GMTSNC="^GMT(142.5,"_+($G(GMTSO))_",1,"
F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) D
. S GMTSTR=$P($P(GMTSNN,GMTSRT,2),")",1),GMTSND=@GMTSNN D TL((" ;"_GMTSTR_";"_GMTSND))
D Q,TL(("$END ROU "_GMTSRTN))
Q
;
; Message
Q ; Quit Line
D TL(" Q") Q
S ; Spacer/Comment Line
D TL(" ; ") Q
BL ; Blank Line
D TL(" ") Q
TL(X) ; Text Line
N GMTS S GMTS=+($G(^TMP($J,"GMTSOBXM",0))),GMTS=GMTS+1
S ^TMP($J,"GMTSOBXM",GMTS,0)=$G(X),^TMP($J,"GMTSOBXM",0)=GMTS
Q
;
; Mailman Support
MAIL ; Send Object via Mailman
N %Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,GMTSN,GMTSQIT Q:'$D(^TMP($J,"GMTSOBXM"))
S XMDUZ=+($G(DUZ)) S:+XMDUZ=0 GMTSQIT=1 S GMTSN=$$XMY S:'$L(GMTSN) GMTSQIT=1 S:$L(GMTSN) XMY(GMTSN)=""
S XMSUB=$$XMSUB S:'$L(XMSUB) GMTSQIT=1 S XMTEXT="^TMP("_$J_",""GMTSOBXM""," Q:+($G(GMTSQIT))>0
D:+($G(GMTSQIT))'>0 ^XMD I +($G(XMZ))>0 H 1 W !," Message [",+($G(XMZ)),"] sent"
K %Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,^TMP($J,"GMTSOBXM")
Q
XMY(X) ; Get Addressee
S X=$$GET1^DIQ(200,(+($G(DUZ))_","),.01) Q X
XMSUB(X) ; Get Subject
N GMTSON S GMTSON=$P($G(^GMT(142.5,+($G(GMTSO)),0)),"^",1)
S X="Exported Health Summary Object" S:$L(GMTSON) X=$E(("Export HS Obj: "_GMTSON),1,65)
Q X
DOM(X) ; Domain
S X=$$GET1^DIQ(4.3,"1,",.01) Q X
DOW(X) ; Day of Week
S X=$$DT^XLFDT,X=$$DOW^XLFDT(X),X=$$UP^XLFSTR(X) Q X
NOW(X) ; Now
N GMTSD,GMTST S X=$$NOW^XLFDT,X=$$FMTE^XLFDT(X,"5Z"),GMTSD=$P(X,"@",1)
S GMTST=$P($P(X,"@",2),":",1,2),X=GMTSD S:$L(GMTST) X=GMTSD_" at "_GMTST
Q X
;
; Miscellaneous
CRTN(X) ; Clear Routine
S X=$G(X) Q:'$L(X) Q:$L(X)>8 Q:$$ROK(X)=0 X ^%ZOSF("DEL") Q
VER(X) ; Health Summary Version
N GMTSEX,GMTSTXT S X="GMTS",GMTSEX="S GMTSTXT=$T(+2^"_X_")" X GMTSEX S X=$P(GMTSTXT,";",3) Q X
ROK(X) ; Routine is OK
S X=$G(X) Q:'$L(X) 0
N GMTSEX,GMTSTXT S GMTSEX="S GMTSTXT=$T(+1^"_X_")" X GMTSEX Q:'$L(GMTSTXT) 0 Q 1
CREATED(X) ; Created Text
N GMTST,GMTSN,GMTSDM,GMTSDW,GMTSDT S GMTST="$TXT",GMTSN=$$XMY S:$L(GMTSN) GMTST=GMTST_" Created by "_GMTSN
S GMTSDM=$$DOM S:$L(GMTSDM) GMTST=GMTST_" at "_GMTSDM S GMTSDW=$$DOW S:$L(GMTSDW) GMTST=GMTST_" on "_GMTSDW
S GMTSDT=$$NOW S:$L(GMTSDT) GMTST=GMTST_", "_GMTSDT S X=GMTST
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBE 8380 printed Nov 22, 2024@17:08:27 Page 2
GMTSOBE ; SLC/KER - HS Object - Export ; 05/22/2008
+1 ;;2.7;Health Summary;**89,107**;Oct 20, 1995;Build 3
+2 ;
+3 ; External References
+4 ;
+5 ; DBIA 10096 ^%ZOSF("DEL"
+6 ; DBIA 2056 $$GET1^DIQ (file #200 and 4.3)
+7 ; DBIA 10112 $$SITE^VASITE
+8 ; DBIA 10103 $$DOW^XLFDT
+9 ; DBIA 10103 $$DT^XLFDT
+10 ; DBIA 10103 $$FMTE^XLFDT
+11 ; DBIA 10103 $$NOW^XLFDT
+12 ; DBIA 10104 $$UP^XLFSTR
+13 ; DBIA 10070 ^XMD
+14 ;
EN ; Main Entry Point to Export a HS Object
+1 NEW %Z,GMTS,GMTSCP,GMTSD,GMTSDM,GMTSDT,GMTSDW,GMTSEX,GMTSFRM,GMTSHD
+2 NEW GMTSI,GMTSN,GMTSNC,GMTSND,GMTSNN,GMTSNX,GMTSO,GMTSON,GMTSOND
+3 NEW GMTSQIT,GMTSRT,GMTSRTN,GMTSSX,GMTST,GMTSTMP,GMTSTN,GMTSTN0
+4 NEW GMTSTNAT,GMTSTNT,GMTSTNV,GMTSTR,GMTSTT,GMTSTXT,GMTSUSR,GMTSX
+5 NEW X,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ,Y
IF +($GET(DUZ))=0
WRITE !!," User not defined"
QUIT
+6 SET GMTSUSR=$$GET1^DIQ(200,(+($GET(DUZ))_","),.01)
IF '$LENGTH(GMTSUSR)
WRITE !!," Invalid User"
QUIT
+7 SET X=$$OBJ^GMTSOBL
if +X'>0
QUIT
SET GMTSFRM=$PIECE($$SITE^VASITE,"^",2)
SET GMTSO=+X
SET GMTSOND=$GET(^GMT(142.5,+GMTSO,0))
+8 SET GMTSON=$PIECE(GMTSOND,"^",1)
SET GMTST=+($PIECE(GMTSOND,"^",3))
if GMTST=0
QUIT
+9 SET GMTSTN0=$GET(^GMT(142,+GMTST,0))
SET GMTSTNT=$GET(^GMT(142,+GMTST,"T"))
+10 SET GMTSTNV=$GET(^GMT(142,+GMTST,"VA"))
SET GMTSTN=$PIECE(GMTSTN0,"^",1)
if '$LENGTH(GMTSTN)
QUIT
+11 SET GMTSTT=$PIECE(GMTSTNT,"^",1)
if '$LENGTH(GMTSTT)&($LENGTH(GMTSTN))
SET GMTSTT=$$EN2^GMTSUMX(GMTSTN)
+12 IF GMTSTN="GMTS HS ADHOC OPTION"
Begin DoDot:1
+13 WRITE !," Can not export a Health Summary Object using GMTS HS ADHOC OPTION",!," (Adhoc) Health Summary Type."
End DoDot:1
QUIT
+14 SET GMTSTNAT=+GMTSTNV
IF GMTSTNAT>0
Begin DoDot:1
+15 WRITE !," Can not export a Health Summary Object using a nationally released",!," Remote Data View Health Summary Type."
End DoDot:1
QUIT
+16 ;p.107 added error msg for local components and components with selected Items
+17 NEW GMTSCDA,GMTSCERR,GMTSERR
SET (GMTSCDA,GMTSCERR,GMTSERR)=0
+18 FOR
SET GMTSCDA=$ORDER(^GMT(142,GMTST,1,GMTSCDA))
if 'GMTSCDA
QUIT
Begin DoDot:1
+19 IF $PIECE($GET(^GMT(142,GMTST,1,GMTSCDA,0)),U,2)>1000
SET GMTSCERR=1
SET GMTSCERR("LOC",$PIECE($GET(^GMT(142,GMTST,1,GMTSCDA,0)),U,2))=1
+20 IF $ORDER(^GMT(142,GMTST,1,GMTSCDA,0))
SET GMTSCERR=1
SET GMTSCERR("SEL",$PIECE($GET(^GMT(142,GMTST,1,GMTSCDA,0)),U,2))=1
End DoDot:1
+21 IF GMTSCERR
WRITE !
Begin DoDot:1
+22 IF $ORDER(GMTSCERR("LOC",0))
Begin DoDot:2
+23 WRITE !!,"Cannot export a Health Summary Object using a Health Summary Type",!,"that contains Local Health Summary Components",!
+24 SET GMTSERR=0
FOR
SET GMTSERR=$ORDER(GMTSCERR("LOC",GMTSERR))
if 'GMTSERR
QUIT
Begin DoDot:3
+25 WRITE !,"Health Summary Type "_$PIECE($GET(^GMT(142,GMTST,0)),U)_" contains Local Health Summary",!,"Component "_$PIECE($GET(^GMT(142.1,GMTSERR,0)),U)
End DoDot:3
End DoDot:2
+26 IF $ORDER(GMTSCERR("SEL",0))
Begin DoDot:2
+27 WRITE !!,"Cannot export a Health Summary Object using a Health Summary Type",!,"that contains Health Summary Components with Selected Items",!
+28 SET GMTSERR=0
FOR
SET GMTSERR=$ORDER(GMTSCERR("SEL",GMTSERR))
if 'GMTSERR
QUIT
Begin DoDot:3
+29 WRITE !,"Health Summary Type "_$PIECE($GET(^GMT(142,GMTST,0)),U)_" contains Health Summary Component ",!,$PIECE($GET(^GMT(142.1,GMTSERR,0)),U)_" with Selected Items"
End DoDot:3
End DoDot:2
End DoDot:1
WRITE !!,"Object NOT Exported!!",!!,"Press any key...."
NEW X
READ X:DTIME
QUIT
+30 SET GMTSRTN="GMTSOBX"
DO INIT
DO TYPE
DO OBJ
DO MAIL
+31 KILL ^TMP($JOB,"GMTSOBXM")
+32 QUIT
INIT ; Initialize Export Routine
+1 if '$LENGTH(GMTSON)
QUIT
if '$LENGTH(GMTSFRM)
QUIT
if '$LENGTH(GMTSUSR)
QUIT
+2 WRITE !!," Exporting Object Routine - ",GMTSRTN
DO CRTN(GMTSRTN)
+3 NEW GMTST,GMTSI
+4 KILL ^TMP($JOB,"GMTSOBXM")
+5 SET GMTST=$$CREATED
DO TL(GMTST)
+6 DO BL
if $LENGTH($GET(GMTSON))
DO TL((" Object: "_GMTSON))
+7 if $LENGTH($GET(GMTSFRM))
DO TL((" From: "_GMTSFRM))
+8 if $LENGTH($GET(GMTSUSR))
DO TL((" Sender: "_GMTSUSR))
+9 if $LENGTH($GET(GMTSON))!($LENGTH($GET(GMTSFRM)))!($LENGTH($GET(GMTSUSR)))
DO BL
+10 DO TL(" 1) Use Packman to unpack the routine GMTSOBX contained in this message.")
DO BL
+11 DO TL(" 2) Use the following Option to install the Health Summary Object")
+12 DO TL(" contained in this message.")
DO BL
+13 DO TL(" GMTS OBJ IMPORT/INSTALL")
+14 DO TL(" Import/Install a Health Summary Object")
DO BL
+15 DO TL(" or run the routine INS^GMTSOBJ")
DO BL
+16 DO TL("$END TXT")
+17 DO TL(("$ROU "_GMTSRTN))
+18 DO TL((GMTSRTN_" ; CIO/SLC - HS Exported Object ; "_$PIECE($$FMTE^XLFDT($$NOW^XLFDT,"5Z"),"@",1)))
+19 DO TL((" ;;"_$$VER_";Health Summary;;Oct 20, 1995"))
DO S
+20 if $LENGTH($GET(GMTSON))
DO TL((" ; Object: "_GMTSON))
+21 if $LENGTH($GET(GMTSFRM))
DO TL((" ; From: "_GMTSFRM))
+22 if $LENGTH($GET(GMTSUSR))
DO TL((" ; Sender: "_GMTSUSR))
DO S
DO Q
+23 QUIT
+24 ;
TYPE ; Export Health Summary Type
+1 ; This will not export:
+2 ; National Health Summary Types
+3 ; Local Components
+4 ; Components with Selected Items
+5 NEW GMTSCP,GMTSHD,GMTSNC,GMTSND,GMTSNN,GMTSRT,GMTSTMP,GMTSTR
+6 NEW GMTSNX,GMTSSX,GMTSD
+7 DO TL(("TYPE ; Health Summary Type"))
+8 IF +($GET(^GMT(142,+GMTST,"VA")))>0
DO Q
QUIT
+9 DO TL((" ;"_GMTSTN))
DO TL((" ;"_GMTSTT))
+10 SET GMTSTMP=$GET(^GMT(142,+($GET(GMTST)),0))
SET GMTSTMP=GMTSTN
SET $PIECE(GMTSTMP,"^",2)=""
SET $PIECE(GMTSTMP,"^",5)=""
+11 DO TL((" ;0;"_GMTSTMP))
+12 SET GMTSRT="^GMT(142,"_+($GET(GMTST))_","
+13 SET GMTSNN="^GMT(142,"_+($GET(GMTST))_",1)"
+14 SET GMTSNC="^GMT(142,"_+($GET(GMTST))_",1,"
SET GMTSTR=1
+15 FOR
SET GMTSNN=$QUERY(@GMTSNN)
if GMTSNN=""!(GMTSNN'[GMTSNC)
QUIT
Begin DoDot:1
+16 SET GMTSTR=$PIECE($PIECE(GMTSNN,GMTSRT,2),")",1)
+17 if $PIECE(GMTSTR,",",3)="1"
SET GMTSD(+($PIECE(GMTSTR,",",2)))=""
if $PIECE(GMTSTR,",",3)="1"
QUIT
+18 SET GMTSNX=$QUERY(@GMTSNN)
SET GMTSSX=$PIECE($PIECE(GMTSNX,GMTSRT,2),")",1)
+19 if $PIECE(GMTSSX,",",3)="1"
SET GMTSD(+($PIECE(GMTSSX,",",2)))=""
if $PIECE(GMTSSX,",",3)="1"
QUIT
+20 SET GMTSND=@GMTSNN
IF GMTSTR="1,0"
DO TL((" ;"_GMTSTR_";"_GMTSND))
QUIT
+21 SET GMTSCP=+($PIECE(GMTSND,"^",2))
if +GMTSCP>1000
QUIT
+22 SET GMTSHD=$PIECE($GET(^GMT(142.1,+GMTSCP,0)),"^",9)
+23 if $PIECE(GMTSND,"^",5)=""
SET $PIECE(GMTSND,"^",5)=GMTSHD
+24 if +($PIECE(GMTSTR,",",2))=0
SET GMTSND=""
+25 IF +($PIECE(GMTSTR,",",2))=0
IF +($PIECE(GMTSTR,",",4))>0
IF $DATA(GMTSD(+($PIECE(GMTSTR,",",4))))
QUIT
+26 DO TL((" ;"_GMTSTR_";"_GMTSND))
End DoDot:1
+27 DO TL((" ;99;"_$HOROLOG))
if $LENGTH(GMTSTT)
DO TL((" ;""T"";"_GMTSTT))
DO Q
+28 QUIT
+29 ;
OBJ ; Export an Object
+1 NEW GMTSNC,GMTSND,GMTSNN,GMTSRT,GMTSTMP,GMTSTR
+2 DO TL(("OBJ ; Health Summary Object"))
DO TL((" ;"_GMTSON))
+3 SET GMTSTMP=$GET(^GMT(142.5,+GMTSO,0))
SET $PIECE(GMTSTMP,"^",3)=""
SET $PIECE(GMTSTMP,"^",17)=""
SET $PIECE(GMTSTMP,"^",18)=""
SET $PIECE(GMTSTMP,"^",19)=""
+4 DO TL((" ;0;"_GMTSTMP))
SET GMTSRT="^GMT(142.5,"_+($GET(GMTSO))_","
+5 SET GMTSTMP=$GET(^GMT(142.5,+GMTSO,2))
DO TL((" ;2;"_GMTSTMP))
+6 SET GMTSNN="^GMT(142.5,"_+($GET(GMTSO))_",1)"
SET GMTSNC="^GMT(142.5,"_+($GET(GMTSO))_",1,"
+7 FOR
SET GMTSNN=$QUERY(@GMTSNN)
if GMTSNN=""!(GMTSNN'[GMTSNC)
QUIT
Begin DoDot:1
+8 SET GMTSTR=$PIECE($PIECE(GMTSNN,GMTSRT,2),")",1)
SET GMTSND=@GMTSNN
DO TL((" ;"_GMTSTR_";"_GMTSND))
End DoDot:1
+9 DO Q
DO TL(("$END ROU "_GMTSRTN))
+10 QUIT
+11 ;
+12 ; Message
Q ; Quit Line
+1 DO TL(" Q")
QUIT
S ; Spacer/Comment Line
+1 DO TL(" ; ")
QUIT
BL ; Blank Line
+1 DO TL(" ")
QUIT
TL(X) ; Text Line
+1 NEW GMTS
SET GMTS=+($GET(^TMP($JOB,"GMTSOBXM",0)))
SET GMTS=GMTS+1
+2 SET ^TMP($JOB,"GMTSOBXM",GMTS,0)=$GET(X)
SET ^TMP($JOB,"GMTSOBXM",0)=GMTS
+3 QUIT
+4 ;
+5 ; Mailman Support
MAIL ; Send Object via Mailman
+1 NEW %Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,GMTSN,GMTSQIT
if '$DATA(^TMP($JOB,"GMTSOBXM"))
QUIT
+2 SET XMDUZ=+($GET(DUZ))
if +XMDUZ=0
SET GMTSQIT=1
SET GMTSN=$$XMY
if '$LENGTH(GMTSN)
SET GMTSQIT=1
if $LENGTH(GMTSN)
SET XMY(GMTSN)=""
+3 SET XMSUB=$$XMSUB
if '$LENGTH(XMSUB)
SET GMTSQIT=1
SET XMTEXT="^TMP("_$JOB_",""GMTSOBXM"","
if +($GET(GMTSQIT))>0
QUIT
+4 if +($GET(GMTSQIT))'>0
DO ^XMD
IF +($GET(XMZ))>0
HANG 1
WRITE !," Message [",+($GET(XMZ)),"] sent"
+5 KILL %Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,^TMP($JOB,"GMTSOBXM")
+6 QUIT
XMY(X) ; Get Addressee
+1 SET X=$$GET1^DIQ(200,(+($GET(DUZ))_","),.01)
QUIT X
XMSUB(X) ; Get Subject
+1 NEW GMTSON
SET GMTSON=$PIECE($GET(^GMT(142.5,+($GET(GMTSO)),0)),"^",1)
+2 SET X="Exported Health Summary Object"
if $LENGTH(GMTSON)
SET X=$EXTRACT(("Export HS Obj: "_GMTSON),1,65)
+3 QUIT X
DOM(X) ; Domain
+1 SET X=$$GET1^DIQ(4.3,"1,",.01)
QUIT X
DOW(X) ; Day of Week
+1 SET X=$$DT^XLFDT
SET X=$$DOW^XLFDT(X)
SET X=$$UP^XLFSTR(X)
QUIT X
NOW(X) ; Now
+1 NEW GMTSD,GMTST
SET X=$$NOW^XLFDT
SET X=$$FMTE^XLFDT(X,"5Z")
SET GMTSD=$PIECE(X,"@",1)
+2 SET GMTST=$PIECE($PIECE(X,"@",2),":",1,2)
SET X=GMTSD
if $LENGTH(GMTST)
SET X=GMTSD_" at "_GMTST
+3 QUIT X
+4 ;
+5 ; Miscellaneous
CRTN(X) ; Clear Routine
+1 SET X=$GET(X)
if '$LENGTH(X)
QUIT
if $LENGTH(X)>8
QUIT
if $$ROK(X)=0
QUIT
XECUTE ^%ZOSF("DEL")
QUIT
VER(X) ; Health Summary Version
+1 NEW GMTSEX,GMTSTXT
SET X="GMTS"
SET GMTSEX="S GMTSTXT=$T(+2^"_X_")"
XECUTE GMTSEX
SET X=$PIECE(GMTSTXT,";",3)
QUIT X
ROK(X) ; Routine is OK
+1 SET X=$GET(X)
if '$LENGTH(X)
QUIT 0
+2 NEW GMTSEX,GMTSTXT
SET GMTSEX="S GMTSTXT=$T(+1^"_X_")"
XECUTE GMTSEX
if '$LENGTH(GMTSTXT)
QUIT 0
QUIT 1
CREATED(X) ; Created Text
+1 NEW GMTST,GMTSN,GMTSDM,GMTSDW,GMTSDT
SET GMTST="$TXT"
SET GMTSN=$$XMY
if $LENGTH(GMTSN)
SET GMTST=GMTST_" Created by "_GMTSN
+2 SET GMTSDM=$$DOM
if $LENGTH(GMTSDM)
SET GMTST=GMTST_" at "_GMTSDM
SET GMTSDW=$$DOW
if $LENGTH(GMTSDW)
SET GMTST=GMTST_" on "_GMTSDW
+3 SET GMTSDT=$$NOW
if $LENGTH(GMTSDT)
SET GMTST=GMTST_", "_GMTSDT
SET X=GMTST
+4 QUIT X
