- GMTSOBL2 ; SLC/KER - HS Object - Lookup ; 01/06/2003
- ;;2.7;Health Summary;**58**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10006 ^DIC (file #142.5)
- ; DBIA 10013 ^DIK (file #142 and 142.5)
- ; DBIA 10016 ^DIM
- ; DBIA 10103 $$NOW^XLFDT
- ; DBIA 10103 $$FMADD^XLFDT
- ;
- Q
- N(X) ; Verify Name
- N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(X)),GMTSNEW=+($P($G(X),"^",3))
- I GMTSIEN'>0!('$L($P($G(^GMT(142.5,+($G(X)),0)),"^",1))) D
- . S DA=GMTSIEN,DIK="^GMT(142.5,"
- . W !," 'NAME' is a required field" Q:'GMTSNEW
- . D:DA>0 ^DIK S X=-1
- . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
- Q X
- NN(GMTS) ; No Name Entered
- N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(GMTS)),GMTSNEW=+($P($G(GMTS),"^",3))
- I +GMTSIEN>0 D
- . Q:$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1))
- . S DA=+GMTSIEN,DIK="^GMT(142.5,"
- . W !," 'NAME' is a required field" Q:'GMTSNEW D:DA>0 ^DIK
- . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
- . S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
- Q
- T(X) ; Type
- N GMTST,GMTSB,GMTSC,GMTSIEN,GMTSNEW S GMTSIEN=+($G(X)),GMTST=+($P($G(^GMT(142.5,GMTSIEN,0)),"^",3)),GMTSNEW=+($P($G(X),"^",3))
- I GMTST=0 D Q X
- . S DA=GMTSIEN,DIK="^GMT(142.5,"
- . W !," 'Health Summary Type' is a required field" Q:'GMTSNEW
- . D:DA>0 ^DIK S X=-1
- . W !," < Health Summary Object deleted >"
- S GMTSB=+($D(^GMT(142,GMTST,1,"B"))),GMTSB=$S(GMTSB>0:1,1:0)
- I GMTSB=0 D Q X
- . S DA=GMTSIEN,DIK="^GMT(142.5,"
- . W !," Selected Health Summary Type has no Components" Q:'GMTSNEW
- . D:DA>0 ^DIK S X=-1
- . W !," < Health Summary Object deleted >"
- S GMTSC=$O(^GMT(142,GMTST,1,"C",0)),GMTSC=$S(GMTSC<9999&(GMTSC>0):1,1:0)
- Q X
- NT(GMTS) ; No Type Entered
- N DA,DIK,GMTSIEN,GMTSNEW S GMTSIEN=+($G(GMTS)),GMTSNEW=+($P($G(GMTS),"^",3))
- I +GMTSIEN>0 D
- . Q:+($P($G(^GMT(142.5,+GMTSIEN,0)),"^",3))>0
- . S DA=+GMTSIEN,DIK="^GMT(142.5,"
- . W !," 'HEALTH SUMMARY TYPE' is a required field" Q:'GMTSNEW
- . D:DA>0 ^DIK
- . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >"
- . S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
- Q
- NEW(GMTS) ; New
- S GMTS=+($G(GMTS))
- I +GMTS>0,$D(^GMT(142.5,GMTS,0)) D
- . N GMTSDT S GMTSDT=$$NOW^XLFDT
- . S $P(^GMT(142.5,+GMTS,0),"^",18)=GMTSDT
- . S GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
- . S $P(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
- . Q:+($G(DUZ))'>0 S $P(^GMT(142.5,+GMTS,0),"^",17)=+($G(DUZ))
- Q
- VER(X) ; Verify Object
- N GMTSIEN,GMTSNAM,GMTSNEW S GMTSIEN=+($G(X)) Q:+GMTSIEN'>0 -1
- S GMTSNAM=$P($G(X),"^",2),GMTSNEW=+($P($G(X),"^",3))
- Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
- I '$L($P($G(^GMT(142.5,+GMTSIEN,0)),"^",1)) D Q -1
- . S DA=+GMTSIEN,DIK="^GMT(142.5," W !," 'NAME' is a required field" D:DA>0 ^DIK
- . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >" S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
- Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
- I +($P($G(^GMT(142.5,+GMTSIEN,0)),"^",3))'>0 D Q -1
- . S DA=+GMTSIEN,DIK="^GMT(142.5," W !," 'HEALTH SUMMARY TYPE' is a required field" D:DA>0 ^DIK
- . W:'$D(^GMT(142.5,+DA,0)) !," < Health Summary Object deleted >" S:'$D(^GMT(142.5,+DA,0)) (DA,X,Y)=-1,GMTSQ=1
- Q:'$D(^GMT(142.5,+GMTSIEN,0)) -1
- Q X
- MOD(GMTS) ; Modified
- S GMTS=+($G(GMTS))
- I +GMTS>0,$D(^GMT(142.5,GMTS,0)) D
- . N GMTSDT S GMTSDT=$$NOW^XLFDT
- . S GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
- . S $P(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
- Q
- TRIM(X) ; Trim Spaces
- S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
- F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
- Q X
- B(X) ; Default "B"
- Q:+($G(DUZ))=0 "" N Y,DIR,DIC,DTOUT,DUOUT,DIROUT,DLAYGO,DA,D,D0,D1,DI,DQ S U="^"
- S DIC=142.5,DIC(0)="Z",X=" " D ^DIC S X=$S(+Y>0:Y,1:"") Q X
- Q
- NAH ; Name Help
- W !," Enter the name of the Health Summary Object, 3 to 30 characters"
- W !," in length. This Object is stored and then embedded in another"
- W !," document as needed."
- Q
- DIM(X) ; Test DIC("S")
- S X=$G(X) D ^DIM Q:'$D(X) ""
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSOBL2 4009 printed Feb 18, 2025@23:24:46 Page 2
- GMTSOBL2 ; SLC/KER - HS Object - Lookup ; 01/06/2003
- +1 ;;2.7;Health Summary;**58**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10006 ^DIC (file #142.5)
- +5 ; DBIA 10013 ^DIK (file #142 and 142.5)
- +6 ; DBIA 10016 ^DIM
- +7 ; DBIA 10103 $$NOW^XLFDT
- +8 ; DBIA 10103 $$FMADD^XLFDT
- +9 ;
- +10 QUIT
- N(X) ; Verify Name
- +1 NEW DA,DIK,GMTSIEN,GMTSNEW
- SET GMTSIEN=+($GET(X))
- SET GMTSNEW=+($PIECE($GET(X),"^",3))
- +2 IF GMTSIEN'>0!('$LENGTH($PIECE($GET(^GMT(142.5,+($GET(X)),0)),"^",1)))
- Begin DoDot:1
- +3 SET DA=GMTSIEN
- SET DIK="^GMT(142.5,"
- +4 WRITE !," 'NAME' is a required field"
- if 'GMTSNEW
- QUIT
- +5 if DA>0
- DO ^DIK
- SET X=-1
- +6 if '$DATA(^GMT(142.5,+DA,0))
- WRITE !," < Health Summary Object deleted >"
- End DoDot:1
- +7 QUIT X
- NN(GMTS) ; No Name Entered
- +1 NEW DA,DIK,GMTSIEN,GMTSNEW
- SET GMTSIEN=+($GET(GMTS))
- SET GMTSNEW=+($PIECE($GET(GMTS),"^",3))
- +2 IF +GMTSIEN>0
- Begin DoDot:1
- +3 if $LENGTH($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",1))
- QUIT
- +4 SET DA=+GMTSIEN
- SET DIK="^GMT(142.5,"
- +5 WRITE !," 'NAME' is a required field"
- if 'GMTSNEW
- QUIT
- if DA>0
- DO ^DIK
- +6 if '$DATA(^GMT(142.5,+DA,0))
- WRITE !," < Health Summary Object deleted >"
- +7 if '$DATA(^GMT(142.5,+DA,0))
- SET (DA,X,Y)=-1
- SET GMTSQ=1
- End DoDot:1
- +8 QUIT
- T(X) ; Type
- +1 NEW GMTST,GMTSB,GMTSC,GMTSIEN,GMTSNEW
- SET GMTSIEN=+($GET(X))
- SET GMTST=+($PIECE($GET(^GMT(142.5,GMTSIEN,0)),"^",3))
- SET GMTSNEW=+($PIECE($GET(X),"^",3))
- +2 IF GMTST=0
- Begin DoDot:1
- +3 SET DA=GMTSIEN
- SET DIK="^GMT(142.5,"
- +4 WRITE !," 'Health Summary Type' is a required field"
- if 'GMTSNEW
- QUIT
- +5 if DA>0
- DO ^DIK
- SET X=-1
- +6 WRITE !," < Health Summary Object deleted >"
- End DoDot:1
- QUIT X
- +7 SET GMTSB=+($DATA(^GMT(142,GMTST,1,"B")))
- SET GMTSB=$SELECT(GMTSB>0:1,1:0)
- +8 IF GMTSB=0
- Begin DoDot:1
- +9 SET DA=GMTSIEN
- SET DIK="^GMT(142.5,"
- +10 WRITE !," Selected Health Summary Type has no Components"
- if 'GMTSNEW
- QUIT
- +11 if DA>0
- DO ^DIK
- SET X=-1
- +12 WRITE !," < Health Summary Object deleted >"
- End DoDot:1
- QUIT X
- +13 SET GMTSC=$ORDER(^GMT(142,GMTST,1,"C",0))
- SET GMTSC=$SELECT(GMTSC<9999&(GMTSC>0):1,1:0)
- +14 QUIT X
- NT(GMTS) ; No Type Entered
- +1 NEW DA,DIK,GMTSIEN,GMTSNEW
- SET GMTSIEN=+($GET(GMTS))
- SET GMTSNEW=+($PIECE($GET(GMTS),"^",3))
- +2 IF +GMTSIEN>0
- Begin DoDot:1
- +3 if +($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",3))>0
- QUIT
- +4 SET DA=+GMTSIEN
- SET DIK="^GMT(142.5,"
- +5 WRITE !," 'HEALTH SUMMARY TYPE' is a required field"
- if 'GMTSNEW
- QUIT
- +6 if DA>0
- DO ^DIK
- +7 if '$DATA(^GMT(142.5,+DA,0))
- WRITE !," < Health Summary Object deleted >"
- +8 if '$DATA(^GMT(142.5,+DA,0))
- SET (DA,X,Y)=-1
- SET GMTSQ=1
- End DoDot:1
- +9 QUIT
- NEW(GMTS) ; New
- +1 SET GMTS=+($GET(GMTS))
- +2 IF +GMTS>0
- IF $DATA(^GMT(142.5,GMTS,0))
- Begin DoDot:1
- +3 NEW GMTSDT
- SET GMTSDT=$$NOW^XLFDT
- +4 SET $PIECE(^GMT(142.5,+GMTS,0),"^",18)=GMTSDT
- +5 SET GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
- +6 SET $PIECE(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
- +7 if +($GET(DUZ))'>0
- QUIT
- SET $PIECE(^GMT(142.5,+GMTS,0),"^",17)=+($GET(DUZ))
- End DoDot:1
- +8 QUIT
- VER(X) ; Verify Object
- +1 NEW GMTSIEN,GMTSNAM,GMTSNEW
- SET GMTSIEN=+($GET(X))
- if +GMTSIEN'>0
- QUIT -1
- +2 SET GMTSNAM=$PIECE($GET(X),"^",2)
- SET GMTSNEW=+($PIECE($GET(X),"^",3))
- +3 if '$DATA(^GMT(142.5,+GMTSIEN,0))
- QUIT -1
- +4 IF '$LENGTH($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",1))
- Begin DoDot:1
- +5 SET DA=+GMTSIEN
- SET DIK="^GMT(142.5,"
- WRITE !," 'NAME' is a required field"
- if DA>0
- DO ^DIK
- +6 if '$DATA(^GMT(142.5,+DA,0))
- WRITE !," < Health Summary Object deleted >"
- if '$DATA(^GMT(142.5,+DA,0))
- SET (DA,X,Y)=-1
- SET GMTSQ=1
- End DoDot:1
- QUIT -1
- +7 if '$DATA(^GMT(142.5,+GMTSIEN,0))
- QUIT -1
- +8 IF +($PIECE($GET(^GMT(142.5,+GMTSIEN,0)),"^",3))'>0
- Begin DoDot:1
- +9 SET DA=+GMTSIEN
- SET DIK="^GMT(142.5,"
- WRITE !," 'HEALTH SUMMARY TYPE' is a required field"
- if DA>0
- DO ^DIK
- +10 if '$DATA(^GMT(142.5,+DA,0))
- WRITE !," < Health Summary Object deleted >"
- if '$DATA(^GMT(142.5,+DA,0))
- SET (DA,X,Y)=-1
- SET GMTSQ=1
- End DoDot:1
- QUIT -1
- +11 if '$DATA(^GMT(142.5,+GMTSIEN,0))
- QUIT -1
- +12 QUIT X
- MOD(GMTS) ; Modified
- +1 SET GMTS=+($GET(GMTS))
- +2 IF +GMTS>0
- IF $DATA(^GMT(142.5,GMTS,0))
- Begin DoDot:1
- +3 NEW GMTSDT
- SET GMTSDT=$$NOW^XLFDT
- +4 SET GMTSDT=$$FMADD^XLFDT(GMTSDT,,,1,)
- +5 SET $PIECE(^GMT(142.5,+GMTS,0),"^",19)=GMTSDT
- End DoDot:1
- +6 QUIT
- TRIM(X) ; Trim Spaces
- +1 SET X=$GET(X)
- FOR
- if $EXTRACT(X,1)'=" "
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +2 FOR
- if $EXTRACT(X,$LENGTH(X))'=" "
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +3 QUIT X
- B(X) ; Default "B"
- +1 if +($GET(DUZ))=0
- QUIT ""
- NEW Y,DIR,DIC,DTOUT,DUOUT,DIROUT,DLAYGO,DA,D,D0,D1,DI,DQ
- SET U="^"
- +2 SET DIC=142.5
- SET DIC(0)="Z"
- SET X=" "
- DO ^DIC
- SET X=$SELECT(+Y>0:Y,1:"")
- QUIT X
- +3 QUIT
- NAH ; Name Help
- +1 WRITE !," Enter the name of the Health Summary Object, 3 to 30 characters"
- +2 WRITE !," in length. This Object is stored and then embedded in another"
- +3 WRITE !," document as needed."
- +4 QUIT
- DIM(X) ; Test DIC("S")
- +1 SET X=$GET(X)
- DO ^DIM
- if '$DATA(X)
- QUIT ""
- +2 QUIT X