Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSOBL2

GMTSOBL2.m

Go to the documentation of this file.
  1. GMTSOBL2 ; SLC/KER - HS Object - Lookup ; 01/06/2003
  1. ;;2.7;Health Summary;**58**;Oct 20, 1995
  1. ;
  1. ; External References
  1. ; DBIA 10006 ^DIC (file #142.5)
  1. ; DBIA 10013 ^DIK (file #142 and 142.5)
  1. ; DBIA 10016 ^DIM
  1. ; DBIA 10103 $$NOW^XLFDT
  1. ; DBIA 10103 $$FMADD^XLFDT
  1. ;
  1. Q
  1. N(X) ; Verify Name
  1. N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(X)),GMTSNEW=+($P($G(X),"^",3))
  1. I GMTSIEN'>0!('$L($P($G(^GMT(142.5,+($G(X)),0)),"^",1))) D
  1. . S DA=GMTSIEN,DIK="^GMT(142.5,"
  1. . W !," 'NAME' is a required field" Q:'GMTSNEW
  1. . D:DA>0 ^DIK S X=-1
  1. . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
  1. Q X
  1. NN(GMTS) ; No Name Entered
  1. N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(GMTS)),GMTSNEW=+($P($G(GMTS),"^",3))
  1. I +GMTSIEN>0 D
  1. . Q:$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1))
  1. . S DA=+GMTSIEN,DIK="^GMT(142.5,"
  1. . W !," 'NAME' is a required field" Q:'GMTSNEW D:DA>0 ^DIK
  1. . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
  1. . S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
  1. Q
  1. T(X) ; Type
  1. N GMTST,GMTSB,GMTSC,GMTSIEN,GMTSNEW S GMTSIEN=+($G(X)),GMTST=+($P($G(^GMT(142.5,GMTSIEN,0)),"^",3)),GMTSNEW=+($P($G(X),"^",3))
  1. I GMTST=0 D Q X
  1. . S DA=GMTSIEN,DIK="^GMT(142.5,"
  1. . W !," 'Health Summary Type' is a required field" Q:'GMTSNEW
  1. . D:DA>0 ^DIK S X=-1
  1. . W !," < Health Summary Object deleted >"
  1. S GMTSB=+($D(^GMT(142,GMTST,1,"B"))),GMTSB=$S(GMTSB>0:1,1:0)
  1. I GMTSB=0 D Q X
  1. . S DA=GMTSIEN,DIK="^GMT(142.5,"
  1. . W !," Selected Health Summary Type has no Components" Q:'GMTSNEW
  1. . D:DA>0 ^DIK S X=-1
  1. . W !," < Health Summary Object deleted >"
  1. S GMTSC=$O(^GMT(142,GMTST,1,"C",0)),GMTSC=$S(GMTSC<9999&(GMTSC>0):1,1:0)
  1. Q X
  1. NT(GMTS) ; No Type Entered
  1. N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(GMTS)),GMTSNEW=+($P($G(GMTS),"^",3))
  1. I +GMTSIEN>0 D
  1. . Q:+($P($G(^GMT(142.5,+GMTSIEN,0)),"^",3))>0
  1. . S DA=+GMTSIEN,DIK="^GMT(142.5,"
  1. . W !," 'HEALTH SUMMARY TYPE' is a required field" Q:'GMTSNEW
  1. . D:DA>0 ^DIK
  1. . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
  1. . S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
  1. Q
  1. NEW(GMTS) ; New
  1. S GMTS=+($G(GMTS))
  1. I +GMTS>0,$D(^GMT(142.5,GMTS,0)) D
  1. . N GMTSDT S GMTSDT=$$NOW^XLFDT
  1. . S $P(^GMT(142.5,+GMTS,0),"^",18)=GMTSDT
  1. . S GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
  1. . S $P(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
  1. . Q:+($G(DUZ))'>0 S $P(^GMT(142.5,+GMTS,0),"^",17)=+($G(DUZ))
  1. Q
  1. VER(X) ; Verify Object
  1. N GMTSIEN,GMTSNAM,GMTSNEW S GMTSIEN=+($G(X)) Q:+GMTSIEN'>0 -1
  1. S GMTSNAM=$P($G(X),"^",2),GMTSNEW=+($P($G(X),"^",3))
  1. Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
  1. I '$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1)) D Q -1
  1. . S DA=+GMTSIEN,DIK="^GMT(142.5," W !," 'NAME' is a required field" D:DA>0 ^DIK
  1. . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >" S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
  1. Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
  1. I +($P($G(^GMT(142.5,+GMTSIEN,0)),"^",3))'>0 D Q -1
  1. . S DA=+GMTSIEN,DIK="^GMT(142.5," W !," 'HEALTH SUMMARY TYPE' is a required field" D:DA>0 ^DIK
  1. . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >" S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
  1. Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
  1. Q X
  1. MOD(GMTS) ; Modified
  1. S GMTS=+($G(GMTS))
  1. I +GMTS>0,$D(^GMT(142.5,GMTS,0)) D
  1. . N GMTSDT S GMTSDT=$$NOW^XLFDT
  1. . S GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
  1. . S $P(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
  1. Q
  1. TRIM(X) ; Trim Spaces
  1. S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
  1. F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
  1. Q X
  1. B(X) ; Default "B"
  1. Q:+($G(DUZ))=0 "" N Y,DIR,DIC,DTOUT,DUOUT,DIROUT,DLAYGO,DA,D,D0,D1,DI,DQ S U="^"
  1. S DIC=142.5,DIC(0)="Z",X=" " D ^DIC S X=$S(+Y>0:Y,1:"") Q X
  1. Q
  1. NAH ; Name Help
  1. W !," Enter the name of the Health Summary Object, 3 to 30 characters"
  1. W !," in length. This Object is stored and then embedded in another"
  1. W !," document as needed."
  1. Q
  1. DIM(X) ; Test DIC("S")
  1. S X=$G(X) D ^DIM Q:'$D(X) ""
  1. Q X