- GMTSOBJ ; SLC/KER - HS Object - Create/Test/Display ; 01/06/2003
- ;;2.7;Health Summary;**58,63**;Oct 20, 1995
- ;
- ; 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,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)
- 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
- GMTSOBJ ; SLC/KER - HS Object - Create/Test/Display ; 01/06/2003
- +1 ;;2.7;Health Summary;**58,63**;Oct 20, 1995
- +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,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 KILL ^TMP("TIUHSOBJ",$JOB)
- DO ARY(DFN,OBJ,$NAME(^TMP("TIUHSOBJ",$JOB,"FGBL")))
- +16 IF +($GET(^TMP("TIUHSOBJ",$JOB,"FGBL",0)))>0
- QUIT "~@"_$NAME(^TMP("TIUHSOBJ",$JOB,"FGBL"))
- +17 QUIT "No Health Summary Report Found"
- +18 ;
- 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">GET(^GMT(142.5,+($GET">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">GET(DFN)),+($GET">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">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">GET(DFN)),$GET">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