- 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 Mar 13, 2025@21:03:08 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
