GMTSOBJ ; SLC/KER - HS Object - Create/Test/Display ; 08/09/2018
;;2.7;Health Summary;**58,63,122**;Oct 20, 1995;Build 183
;
; External References
; DBIA 2320 $$DEL^%ZISH
; DBIA 2320 $$FTG^%ZISH
; DBIA 2320 $$PWD^%ZISH
; DBIA 2320 CLOSE^%ZISH
; DBIA 2320 OPEN^%ZISH
; DBIA 10006 ^DIC (file #142.5 and #2)
; DBIA 10013 ^DIK
; DBIA 2054 $$CREF^DILF
; DBIA 2054 $$OREF^DILF
; DBIA 10026 ^DIR
; DBIA 10103 $$NOW^XLFDT
;
Q
MGR ; Create/Modify Health Summary Object (Manager)
N GMTSMGR S GMTSMGR="" G OBJ
;
DEVOBJ ; Create/Modify Health Summary Object (Developer)
N GMTSDEV S GMTSDEV=5000
;
OBJ ; Create/Modify Health Summary Object
; Option: GMTS OBJ ENTER/EDIT
; Create/Modify Health Summary Object
N BOLD,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT,DUOUT,GMP,GMTS
N GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF,GMTSDLD,GMTSDT
N GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNEW,GMTSO,GMTSOBJ
N GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR,GMTSRDT,GMTSRHD
N GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT,GMTSV,GMTSVER,GMTSX
N IOINHI,IOINORM,NORM,OBJ,D,D0,D1,DI,DILN,X,Y
S DIC("S")="I +Y<50000000!(+Y>59999999)" K:+($G(GMTSDEV))=5000 DIC("S")
D OBJ^GMTSOBA
Q
;
CRE(NAME) ; Create/Modify Health Summary Object named 'NAME'
;
; Input NAME Name of Object to Create or Edit
; Output Internal Entry Number of Object file if
; found or created
;
N X,BOLD,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT,DUOUT,GMP,GMTS
N GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF,GMTSDLD,GMTSDT
N GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNAM,GMTSNEW,GMTSO
N GMTSOBJ,GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR,GMTSRDT
N GMTSRHD,GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT,GMTSV,GMTSVER
N GMTSX,IOINHI,IOINORM,NORM,OBJ,D,D0,D1,DI,DILN,Y S GMTSNAM=$G(NAME)
S:'$L(GMTSNAM) GMTSNAM=$$NAME^GMTSOBV("") Q:'$L(GMTSNAM) -1
S DIC("S")="I +Y<50000000!(+Y>59999999)" K:+($G(GMTSDEV))=5000 DIC("S")
D OBJ^GMTSOBA K DIC S DIC="^GMT(142.5,",DIC(0)="XM",X=GMTSNAM
D ^DIC,CRD^GMTSOBV(+Y),^DIC S X=+Y S:X'>0 X=-1
Q X
;
TYPE(NAME) ; Edit Health Summary Type named NAME
;
; Input NAME Name of Health Summary Type to Edit
; Output None
D ET^GMTSOBA2($G(NAME))
Q
;
INQ ; Inquire to Health Summary Object
; Option: GMTS OBJ INQ
; Health Summary Object Inquiry
N DIC,D,D0,D1,DI,DILN,GMTSP,GMTSPL,GMTSL,GMTSEXIT
S U="^",DIC="^GMT(142.5,",DIC(0)="AEMQF",GMTSP=$G(IOST),GMTSPL=0,GMTSL=0,GMTSEXIT=0
S DIC("A")=" Select Health Summary Object: " D ^DIC K DIC("A")
W:$L($G(IOF)) @IOF W:+($G(Y))>0 ! D:+($G(Y))>0 SO^GMTSOBS(+Y),CONT^GMTSOBS
Q
;
DEVDEL ; Delete Health Summary Object (Developer)
N GMTSDEV S GMTSDEV=5000
;
DEL ; Delete Health Summary Object
; Option: GMTS OBJ DELETE
; Delete Health Summary Object
N D,D0,D1,DI,DILN,DIC,DIR,DIK,DA,X,Y,GMTSP,GMTSPL,GMTSL,GMTSEXIT S U="^",(DIK,DIC)="^GMT(142.5,",DIC(0)="AEMQF"
I $$UACT^GMTSU2(+($G(DUZ)))'>0 W !!," >> You are not authorized to delete a Health Summary Object." Q
S DIC("A")=" Select Health Summary Object to Delete: "
S DIC("S")="I (+($P($G(^GMT(142.5,+Y,0)),""^"",17))=0!(+($P($G(^GMT(142.5,+Y,0)),""^"",17))=+($G(DUZ))))&(+($P($G(^GMT(142.5,+Y,0)),""^"",20))'>0)"
S:'$D(GMTSDEV) DIC("S")="I +($$DEL^GMTSOBV(+Y))>0"
K:$D(GMTSDEV) DIC("S") I +($G(Y))>50000000,+($G(Y))<59999999,'$D(GMTSDEV) W !," Can not delete a nationally exported object." Q
D ^DIC I +($G(Y))>0 D
. N GMTSDEL,GMTSO S GMTSDEL="" W ! D SO^GMTSOBS(+Y)
. S DA=+Y,GMTSO=$P($G(^GMT(142.5,+Y,0)),"^",1)
. S:$L(GMTSO) GMTSO=" """_GMTSO_""""
. S DIR("B")="NO",DIR(0)="YAO",DIR("A")=" Delete Health Summary Object"_GMTSO_"? "
. S (DIR("?"),DIR("??"))=" Enter either 'Y' or 'N'."
. W ! D ^DIR I +Y>0 D ^DIK
. I '$D(^GMT(142.5,+DA,0)) W !," <deleted>",!
Q
;
TEST ; Test Health Summary Object
; Option: GMTS OBJ TEST
; Test a Health Summary Object
N BOLD,D,D0,D1,DI,DILN,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT
N DUOUT,GMP,GMTS,GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF
N GMTSDLD,GMTSDT,GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNEW
N GMTSO,GMTSOBJ,GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR
N GMTSRDT,GMTSRHD,GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT
N GMTSV,GMTSVER,GMTSX,IOINHI,IOINORM,NORM,OBJ,X,Y
D PAT^GMTSOBV I +($G(DFN))'>0 W !!," No Patient Selected" Q
S GMTSL=$G(IOSL) N IOSL S IOSL=99999999
S DIC="^GMT(142.5,",DIC("A")=" Select HEALTH SUMMARY OBJECT to test: ",U="^"
S DIC(0)="AEMQ" K DLAYGO D ^DIC S GMTSOBJ=+($G(Y))
I +GMTSOBJ'>0 W !!," No Health Summary Object Selected" Q
K ^TMP("GMTSOBJ",$J,DFN) D GET(DFN,GMTSOBJ),DEV^GMTSOBS
Q
;
EXP ; Export a Health Summary Object
D EN^GMTSOBE
Q
;
INS ; Install Imported Health Summary Object
D EN^GMTSOBI
Q
;
GET(DFN,OBJ) ; Get Health Summary Object
;
; Input DFN IEN for Patient (#2)
; OBJ IEN for Health Summary Object (#142.5)
;
; Output Global array of Health Summary data
;
; ^TMP("GMTSOBJ",$J,DFN,#,0)
;
K ^TMP("GMTSOBJ",$J,DFN) D ARY(DFN,OBJ,$NA(^TMP("GMTSOBJ",$J,DFN)))
Q
;
TIU(DFN,OBJ) ; Get Health Summary Object (TIU)
;
; Input DFN IEN for Patient (#2)
; OBJ IEN for Health Summary Object (#142.5)
;
; Output Global array of Health Summary data
;
; ^TMP("TIUHSOBJ",$J,"FGBL",0)
; ^TMP("TIUHSOBJ",$J,"FGBL",#,0)
;
N ERRMSG,GMTSTIUOBJ,HSTYPE
S HSTYPE=$P($G(^GMT(142.5,OBJ,0)),U,3)
I $G(HSTYPE)="" Q "No Health Summary Report Found"
I $D(^GMT(142,HSTYPE,1))'>0 D Q ERRMSG
. S ERRMSG="There are no components in the Health Summary Type: "_$P($G(^GMT(142,HSTYPE,0)),U)
S GMTSTIUOBJ=1
K ^TMP("TIUHSOBJ",$J) D ARY(DFN,OBJ,$NA(^TMP("TIUHSOBJ",$J,"FGBL")))
Q:+($G(^TMP("TIUHSOBJ",$J,"FGBL",0)))>0 "~@"_$NA(^TMP("TIUHSOBJ",$J,"FGBL"))
Q "No Health Summary Report Found"
;
ARY(DFN,OBJ,ROOT) ; Build Array ROOT
;
; Input DFN IEN for Patient (#2)
; OBJ IEN for Health Summary Object (#142.5)
; ROOT Closed root (global or local array)
;
; Output Array of Health Summary data in ROOT
;
N GMTSBLK,GMTSFILE,GMTSHFN,GMTSNC,GMTSNCT,GMTSND,GMTSNDT,GMTSNN,GMTSIOM
N GMTSPATH,GMTSPRE,GMTSRT,GMTSRTO,GMTSRTC,GMTSRNN,GMTSRNC,GMTS0,POP,X,Y
Q:$G(^GMT(142.5,+($G(OBJ)),0))="" S GMTSRT=$G(ROOT)
Q:'$L(GMTSRT) Q:$E(GMTSRT,1)'="^"&($E(GMTSRT,1)'?1U)
S GMTSRTO=$$OREF^DILF(GMTSRT),GMTSRTC=$$CREF^DILF(GMTSRT)
Q:'$L(GMTSRTO) Q:'$L(GMTSRTC) Q:'$L($TR(GMTSRTC,")",""))
Q:$E(GMTSRTO,$L(GMTSRTO))'=","&($E(GMTSRTO,$L(GMTSRTO))'="(")
Q:GMTSRTO'[$TR(GMTSRTC,")","") S GMTS0=GMTSRTO_"0)"
S GMTSPATH=$$PWD^%ZISH,GMTSFILE=$J_$TR($$NOW^XLFDT,".","")_".DAT"
D OPEN^%ZISH("WRITEFILE",GMTSPATH,GMTSFILE,"W"),DIS(+($G(DFN)),+($G(OBJ)))
D CLOSE^%ZISH("WRITEFILE") K ^TMP("GMTSOBJ",$J,"OGBL")
S Y=$$FTG^%ZISH(GMTSPATH,GMTSFILE,$NA(^TMP("GMTSOBJ",$J,"OGBL",1)),4)
S GMTSHFN(GMTSFILE)="",Y=$$DEL^%ZISH(GMTSPATH,$NA(GMTSHFN))
S (GMTSBLK,GMTSNCT,GMTSPRE)=0 S GMTSNN="^TMP(""GMTSOBJ"","_$J_",""OGBL"")"
S GMTSNC="^TMP(""GMTSOBJ"","_$J_",""OGBL"","
F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) D
. S GMTSND=@GMTSNN,GMTSNDT=$$TRIM^GMTSOBV(GMTSND)
. I 'GMTSBLK S:GMTSNDT="" GMTSBLK=1 Q:GMTSBLK
. Q:GMTSPRE&(GMTSNDT="") S GMTSNCT=GMTSNCT+1
. S @(GMTSRTO_GMTSNCT_",0)")=GMTSND
. S @GMTS0=$G(@GMTS0)+1
. S GMTSPRE=$S(GMTSNDT="":1,1:0)
K ^TMP("GMTSOBJ",$J,"OGBL")
Q
;
SHOW(X) ; Show a Health Summary Object Definition
;
; Input X IEN for Health Summary Object (#142.5)
;
D SO^GMTSOBS(+($G(X)))
Q
;
; Input X IEN for Health Summary Object (#142.5)
; Output ARY() Array of fields and values
; (passed by reference)
;
; ARY(IEN,<field #>,"I") = Internal Value
; ARY(IEN,<field #>,"E") = External Value
; ARY(IEN,<field #>,"NAME") = Field Name
; ARY(IEN,<field #>,"PROMT") = Mixed Case of Field Name
;
D GET^GMTSOBS2(+($G(X)),.ARY)
Q
DEF(X,ARY) ; Extract a Health Summary Object Definition
;
; Input X IEN for Health Summary Object (#142.5)
; Output ARY() Array of fields and values
; (passed by reference)
;
; ARY("D",0) = # of lines in Definition
; ARY("D",#) = Definition Text
; ARY("E",0) = # of lines in Example
; ARY("E",#) = Example Text
;
D DEF^GMTSOBS(+($G(X)),.ARY)
Q
DIS(DFN,OBJ) ; Display Object
;
; Input DFN IEN for Patient (#2)
; OBJ IEN for Health Summary Object (#142.5)
;
; Output Display of Health Summary data
;
D DIS^GMTSOBS2(+($G(DFN)),$G(OBJ))
Q
STMP ; Show TMP
N GMTSNN,GMTSNC S GMTSNN="^TMP(""GMTSOBJ"","_$J_",""OGBL"")",GMTSNC="^TMP(""GMTSOBJ"","_$J_",""OGBL"","
F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) W !,GMTSNN,"=",@GMTSNN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBJ 9480 printed Nov 22, 2024@17:08:30 Page 2
GMTSOBJ ; SLC/KER - HS Object - Create/Test/Display ; 08/09/2018
+1 ;;2.7;Health Summary;**58,63,122**;Oct 20, 1995;Build 183
+2 ;
+3 ; External References
+4 ; DBIA 2320 $$DEL^%ZISH
+5 ; DBIA 2320 $$FTG^%ZISH
+6 ; DBIA 2320 $$PWD^%ZISH
+7 ; DBIA 2320 CLOSE^%ZISH
+8 ; DBIA 2320 OPEN^%ZISH
+9 ; DBIA 10006 ^DIC (file #142.5 and #2)
+10 ; DBIA 10013 ^DIK
+11 ; DBIA 2054 $$CREF^DILF
+12 ; DBIA 2054 $$OREF^DILF
+13 ; DBIA 10026 ^DIR
+14 ; DBIA 10103 $$NOW^XLFDT
+15 ;
+16 QUIT
MGR ; Create/Modify Health Summary Object (Manager)
+1 NEW GMTSMGR
SET GMTSMGR=""
GOTO OBJ
+2 ;
DEVOBJ ; Create/Modify Health Summary Object (Developer)
+1 NEW GMTSDEV
SET GMTSDEV=5000
+2 ;
OBJ ; Create/Modify Health Summary Object
+1 ; Option: GMTS OBJ ENTER/EDIT
+2 ; Create/Modify Health Summary Object
+3 NEW BOLD,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT,DUOUT,GMP,GMTS
+4 NEW GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF,GMTSDLD,GMTSDT
+5 NEW GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNEW,GMTSO,GMTSOBJ
+6 NEW GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR,GMTSRDT,GMTSRHD
+7 NEW GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT,GMTSV,GMTSVER,GMTSX
+8 NEW IOINHI,IOINORM,NORM,OBJ,D,D0,D1,DI,DILN,X,Y
+9 SET DIC("S")="I +Y<50000000!(+Y>59999999)"
if +($GET(GMTSDEV))=5000
KILL DIC("S")
+10 DO OBJ^GMTSOBA
+11 QUIT
+12 ;
CRE(NAME) ; Create/Modify Health Summary Object named 'NAME'
+1 ;
+2 ; Input NAME Name of Object to Create or Edit
+3 ; Output Internal Entry Number of Object file if
+4 ; found or created
+5 ;
+6 NEW X,BOLD,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT,DUOUT,GMP,GMTS
+7 NEW GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF,GMTSDLD,GMTSDT
+8 NEW GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNAM,GMTSNEW,GMTSO
+9 NEW GMTSOBJ,GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR,GMTSRDT
+10 NEW GMTSRHD,GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT,GMTSV,GMTSVER
+11 NEW GMTSX,IOINHI,IOINORM,NORM,OBJ,D,D0,D1,DI,DILN,Y
SET GMTSNAM=$GET(NAME)
+12 if '$LENGTH(GMTSNAM)
SET GMTSNAM=$$NAME^GMTSOBV("")
if '$LENGTH(GMTSNAM)
QUIT -1
+13 SET DIC("S")="I +Y<50000000!(+Y>59999999)"
if +($GET(GMTSDEV))=5000
KILL DIC("S")
+14 DO OBJ^GMTSOBA
KILL DIC
SET DIC="^GMT(142.5,"
SET DIC(0)="XM"
SET X=GMTSNAM
+15 DO ^DIC
DO CRD^GMTSOBV(+Y)
DO ^DIC
SET X=+Y
if X'>0
SET X=-1
+16 QUIT X
+17 ;
TYPE(NAME) ; Edit Health Summary Type named NAME
+1 ;
+2 ; Input NAME Name of Health Summary Type to Edit
+3 ; Output None
+4 DO ET^GMTSOBA2($GET(NAME))
+5 QUIT
+6 ;
INQ ; Inquire to Health Summary Object
+1 ; Option: GMTS OBJ INQ
+2 ; Health Summary Object Inquiry
+3 NEW DIC,D,D0,D1,DI,DILN,GMTSP,GMTSPL,GMTSL,GMTSEXIT
+4 SET U="^"
SET DIC="^GMT(142.5,"
SET DIC(0)="AEMQF"
SET GMTSP=$GET(IOST)
SET GMTSPL=0
SET GMTSL=0
SET GMTSEXIT=0
+5 SET DIC("A")=" Select Health Summary Object: "
DO ^DIC
KILL DIC("A")
+6 if $LENGTH($GET(IOF))
WRITE @IOF
if +($GET(Y))>0
WRITE !
if +($GET(Y))>0
DO SO^GMTSOBS(+Y)
DO CONT^GMTSOBS
+7 QUIT
+8 ;
DEVDEL ; Delete Health Summary Object (Developer)
+1 NEW GMTSDEV
SET GMTSDEV=5000
+2 ;
DEL ; Delete Health Summary Object
+1 ; Option: GMTS OBJ DELETE
+2 ; Delete Health Summary Object
+3 NEW D,D0,D1,DI,DILN,DIC,DIR,DIK,DA,X,Y,GMTSP,GMTSPL,GMTSL,GMTSEXIT
SET U="^"
SET (DIK,DIC)="^GMT(142.5,"
SET DIC(0)="AEMQF"
+4 IF $$UACT^GMTSU2(+($GET(DUZ)))'>0
WRITE !!," >> You are not authorized to delete a Health Summary Object."
QUIT
+5 SET DIC("A")=" Select Health Summary Object to Delete: "
+6 SET DIC("S")="I (+($P($G(^GMT(142.5,+Y,0)),""^"",17))=0!(+($P($G(^GMT(142.5,+Y,0)),""^"",17))=+($G(DUZ))))&(+($P($G(^GMT(142.5,+Y,0)),""^"",20))'>0)"
+7 if '$DATA(GMTSDEV)
SET DIC("S")="I +($$DEL^GMTSOBV(+Y))>0"
+8 if $DATA(GMTSDEV)
KILL DIC("S")
IF +($GET(Y))>50000000
IF +($GET(Y))<59999999
IF '$DATA(GMTSDEV)
WRITE !," Can not delete a nationally exported object."
QUIT
+9 DO ^DIC
IF +($GET(Y))>0
Begin DoDot:1
+10 NEW GMTSDEL,GMTSO
SET GMTSDEL=""
WRITE !
DO SO^GMTSOBS(+Y)
+11 SET DA=+Y
SET GMTSO=$PIECE($GET(^GMT(142.5,+Y,0)),"^",1)
+12 if $LENGTH(GMTSO)
SET GMTSO=" """_GMTSO_""""
+13 SET DIR("B")="NO"
SET DIR(0)="YAO"
SET DIR("A")=" Delete Health Summary Object"_GMTSO_"? "
+14 SET (DIR("?"),DIR("??"))=" Enter either 'Y' or 'N'."
+15 WRITE !
DO ^DIR
IF +Y>0
DO ^DIK
+16 IF '$DATA(^GMT(142.5,+DA,0))
WRITE !," <deleted>",!
End DoDot:1
+17 QUIT
+18 ;
TEST ; Test Health Summary Object
+1 ; Option: GMTS OBJ TEST
+2 ; Test a Health Summary Object
+3 NEW BOLD,D,D0,D1,DI,DILN,DA,DFN,DIC,DIE,DIR,DIROUT,DLAYGO,DR,DTOUT
+4 NEW DUOUT,GMP,GMTS,GMTSBLK,GMTSCHD,GMTSCON,GMTSDEC,GMTSDEF,GMTSDIF
+5 NEW GMTSDLD,GMTSDT,GMTSHDR,GMTSI,GMTSL,GMTSLBL,GMTSLEN,GMTSLIM,GMTSNEW
+6 NEW GMTSO,GMTSOBJ,GMTSOBN,GMTSPER,GMTSPRO,GMTSPX1,GMTSPX2,GMTSQ,GMTSR
+7 NEW GMTSRDT,GMTSRHD,GMTST,GMTSTD,GMTSTIM,GMTSTYP,GMTSUNIT,GMTSUNT
+8 NEW GMTSV,GMTSVER,GMTSX,IOINHI,IOINORM,NORM,OBJ,X,Y
+9 DO PAT^GMTSOBV
IF +($GET(DFN))'>0
WRITE !!," No Patient Selected"
QUIT
+10 SET GMTSL=$GET(IOSL)
NEW IOSL
SET IOSL=99999999
+11 SET DIC="^GMT(142.5,"
SET DIC("A")=" Select HEALTH SUMMARY OBJECT to test: "
SET U="^"
+12 SET DIC(0)="AEMQ"
KILL DLAYGO
DO ^DIC
SET GMTSOBJ=+($GET(Y))
+13 IF +GMTSOBJ'>0
WRITE !!," No Health Summary Object Selected"
QUIT
+14 KILL ^TMP("GMTSOBJ",$JOB,DFN)
DO GET(DFN,GMTSOBJ)
DO DEV^GMTSOBS
+15 QUIT
+16 ;
EXP ; Export a Health Summary Object
+1 DO EN^GMTSOBE
+2 QUIT
+3 ;
INS ; Install Imported Health Summary Object
+1 DO EN^GMTSOBI
+2 QUIT
+3 ;
GET(DFN,OBJ) ; Get Health Summary Object
+1 ;
+2 ; Input DFN IEN for Patient (#2)
+3 ; OBJ IEN for Health Summary Object (#142.5)
+4 ;
+5 ; Output Global array of Health Summary data
+6 ;
+7 ; ^TMP("GMTSOBJ",$J,DFN,#,0)
+8 ;
+9 KILL ^TMP("GMTSOBJ",$JOB,DFN)
DO ARY(DFN,OBJ,$NAME(^TMP("GMTSOBJ",$JOB,DFN)))
+10 QUIT
+11 ;
TIU(DFN,OBJ) ; Get Health Summary Object (TIU)
+1 ;
+2 ; Input DFN IEN for Patient (#2)
+3 ; OBJ IEN for Health Summary Object (#142.5)
+4 ;
+5 ; Output Global array of Health Summary data
+6 ;
+7 ; ^TMP("TIUHSOBJ",$J,"FGBL",0)
+8 ; ^TMP("TIUHSOBJ",$J,"FGBL",#,0)
+9 ;
+10 NEW ERRMSG,GMTSTIUOBJ,HSTYPE
+11 SET HSTYPE=$PIECE($GET(^GMT(142.5,OBJ,0)),U,3)
+12 IF $GET(HSTYPE)=""
QUIT "No Health Summary Report Found"
+13 IF $DATA(^GMT(142,HSTYPE,1))'>0
Begin DoDot:1
+14 SET ERRMSG="There are no components in the Health Summary Type: "_$PIECE($GET(^GMT(142,HSTYPE,0)),U)
End DoDot:1
QUIT ERRMSG
+15 SET GMTSTIUOBJ=1
+16 KILL ^TMP("TIUHSOBJ",$JOB)
DO ARY(DFN,OBJ,$NAME(^TMP("TIUHSOBJ",$JOB,"FGBL")))
+17 if +($GET(^TMP("TIUHSOBJ",$JOB,"FGBL",0)))>0
QUIT "~@"_$NAME(^TMP("TIUHSOBJ",$JOB,"FGBL"))
+18 QUIT "No Health Summary Report Found"
+19 ;
ARY(DFN,OBJ,ROOT) ; Build Array ROOT
+1 ;
+2 ; Input DFN IEN for Patient (#2)
+3 ; OBJ IEN for Health Summary Object (#142.5)
+4 ; ROOT Closed root (global or local array)
+5 ;
+6 ; Output Array of Health Summary data in ROOT
+7 ;
+8 NEW GMTSBLK,GMTSFILE,GMTSHFN,GMTSNC,GMTSNCT,GMTSND,GMTSNDT,GMTSNN,GMTSIOM
+9 NEW GMTSPATH,GMTSPRE,GMTSRT,GMTSRTO,GMTSRTC,GMTSRNN,GMTSRNC,GMTS0,POP,X,Y
+10 if $GET(^GMT(142.5,+($GET(OBJ)),0))=""
QUIT
SET GMTSRT=$GET(ROOT)
+11 if '$LENGTH(GMTSRT)
QUIT
if $EXTRACT(GMTSRT,1)'="^"&($EXTRACT(GMTSRT,1)'?1U)
QUIT
+12 SET GMTSRTO=$$OREF^DILF(GMTSRT)
SET GMTSRTC=$$CREF^DILF(GMTSRT)
+13 if '$LENGTH(GMTSRTO)
QUIT
if '$LENGTH(GMTSRTC)
QUIT
if '$LENGTH($TRANSLATE(GMTSRTC,")",""))
QUIT
+14 if $EXTRACT(GMTSRTO,$LENGTH(GMTSRTO))'=","&($EXTRACT(GMTSRTO,$LENGTH(GMTSRTO))'="(")
QUIT
+15 if GMTSRTO'[$TRANSLATE(GMTSRTC,")","")
QUIT
SET GMTS0=GMTSRTO_"0)"
+16 SET GMTSPATH=$$PWD^%ZISH
SET GMTSFILE=$JOB_$TRANSLATE($$NOW^XLFDT,".","")_".DAT"
+17 DO OPEN^%ZISH("WRITEFILE",GMTSPATH,GMTSFILE,"W")
DO DIS(+($GET(DFN)),+($GET(OBJ)))
+18 DO CLOSE^%ZISH("WRITEFILE")
KILL ^TMP("GMTSOBJ",$JOB,"OGBL")
+19 SET Y=$$FTG^%ZISH(GMTSPATH,GMTSFILE,$NAME(^TMP("GMTSOBJ",$JOB,"OGBL",1)),4)
+20 SET GMTSHFN(GMTSFILE)=""
SET Y=$$DEL^%ZISH(GMTSPATH,$NAME(GMTSHFN))
+21 SET (GMTSBLK,GMTSNCT,GMTSPRE)=0
SET GMTSNN="^TMP(""GMTSOBJ"","_$JOB_",""OGBL"")"
+22 SET GMTSNC="^TMP(""GMTSOBJ"","_$JOB_",""OGBL"","
+23 FOR
SET GMTSNN=$QUERY(@GMTSNN)
if GMTSNN=""!(GMTSNN'[GMTSNC)
QUIT
Begin DoDot:1
+24 SET GMTSND=@GMTSNN
SET GMTSNDT=$$TRIM^GMTSOBV(GMTSND)
+25 IF 'GMTSBLK
if GMTSNDT=""
SET GMTSBLK=1
if GMTSBLK
QUIT
+26 if GMTSPRE&(GMTSNDT="")
QUIT
SET GMTSNCT=GMTSNCT+1
+27 SET @(GMTSRTO_GMTSNCT_",0)")=GMTSND
+28 SET @GMTS0=$GET(@GMTS0)+1
+29 SET GMTSPRE=$SELECT(GMTSNDT="":1,1:0)
End DoDot:1
+30 KILL ^TMP("GMTSOBJ",$JOB,"OGBL")
+31 QUIT
+32 ;
SHOW(X) ; Show a Health Summary Object Definition
+1 ;
+2 ; Input X IEN for Health Summary Object (#142.5)
+3 ;
+4 DO SO^GMTSOBS(+($GET(X)))
+5 QUIT
+1 ;
+2 ; Input X IEN for Health Summary Object (#142.5)
+3 ; Output ARY() Array of fields and values
+4 ; (passed by reference)
+5 ;
+6 ; ARY(IEN,<field #>,"I") = Internal Value
+7 ; ARY(IEN,<field #>,"E") = External Value
+8 ; ARY(IEN,<field #>,"NAME") = Field Name
+9 ; ARY(IEN,<field #>,"PROMT") = Mixed Case of Field Name
+10 ;
+11 DO GET^GMTSOBS2(+($GET(X)),.ARY)
+12 QUIT
DEF(X,ARY) ; Extract a Health Summary Object Definition
+1 ;
+2 ; Input X IEN for Health Summary Object (#142.5)
+3 ; Output ARY() Array of fields and values
+4 ; (passed by reference)
+5 ;
+6 ; ARY("D",0) = # of lines in Definition
+7 ; ARY("D",#) = Definition Text
+8 ; ARY("E",0) = # of lines in Example
+9 ; ARY("E",#) = Example Text
+10 ;
+11 DO DEF^GMTSOBS(+($GET(X)),.ARY)
+12 QUIT
DIS(DFN,OBJ) ; Display Object
+1 ;
+2 ; Input DFN IEN for Patient (#2)
+3 ; OBJ IEN for Health Summary Object (#142.5)
+4 ;
+5 ; Output Display of Health Summary data
+6 ;
+7 DO DIS^GMTSOBS2(+($GET(DFN)),$GET(OBJ))
+8 QUIT
STMP ; Show TMP
+1 NEW GMTSNN,GMTSNC
SET GMTSNN="^TMP(""GMTSOBJ"","_$JOB_",""OGBL"")"
SET GMTSNC="^TMP(""GMTSOBJ"","_$JOB_",""OGBL"","
+2 FOR
SET GMTSNN=$QUERY(@GMTSNN)
if GMTSNN=""!(GMTSNN'[GMTSNC)
QUIT
WRITE !,GMTSNN,"=",@GMTSNN
+3 QUIT
