GMTSOBE ; SLC/KER - HS Object - Export ; 01/06/2003 ;;2.7;Health Summary;**58**;Oct 20, 1995 ; ; 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." 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 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