GMTSU2 ; SLC/KER - Health Summary Utilities ; 08/27/2002
;;2.7;Health Summary;**29,56**;Oct 20, 1995
;
; External References
; DBIA 10035 ^DPT( file #2
; DBIA 10060 ^VA(200,
; DBIA 10090 ^DIC(4,
; DBIA 2056 $$GET1^DIQ (file #200, 2 and 4)
; DBIA 10103 $$NOW^XLFDT
; DBIA 10112 $$SITE^VASITE
; DBIA 10112 $$NAME^VASITE
; DBIA 2541 $$KSP^XUPARAM
; DBIA 10104 $$UP^XLFSTR
;
Q
; User
USER(X) ; Is a user (1 yes 0 no) 0;1
N GMTS Q:+($G(X))=0 "" S GMTS=$$UNAM(+($G(X))),X=$S($L(GMTS)>0:1,1:0) Q X
UACT(X) ; Active User (1 active) 0;11
N GMTS,GMTSN Q:+($G(X))=0 0 S GMTS=$$USER(+($G(X))) Q:+GMTS=0 0
S GMTS=+($$GET1^DIQ(200,+($G(X)),9.2,"I")) S GMTSN=$$NOW^XLFDT Q:GMTS>0&(GMTS<GMTSN) 0 Q 1
UNAM(X) ; User Name 0;1
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.01)
UHPH(X) ; Home Phone .13;1
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.132)
UOPH(X) ; Office Phone .13;2
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.132)
UPH3(X) ; Phone Number #3 .13;3
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.133)
UPH4(X) ; Phone Number #4 .13;4
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.134)
UCPH(X) ; Commercial Phone .13;5
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.135)
UFAX(X) ; Fax Number .13;6
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.136)
UAPG(X) ; Analog Pager .13;7
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.137)
UDPG(X) ; Digital Pager .13;8
Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.138)
;
; Patient
PAT(X) ; Is a patient (1 yes 0 no) 0;1
N GMTS Q:+($G(X))=0 "" S GMTS=$$PNAM(+($G(X))),X=$S($L(GMTS)>0:1,1:0) Q X
PNAM(X) ; Patient Name 0;1
Q:+($G(X))=0 "" Q $$GET1^DIQ(2,+($G(X)),.01)
PMAR(X) ; Patient Marital Status 0;5
Q:+($G(X))=0 "" Q $$GET1^DIQ(2,+($G(X)),.05)
PWAR(X) ; Patient has a Ward Location
N GMTS Q:+($G(X))=0 "" S GMTS=PWLC(X),X=$S($L(GMTS):1,1:0) Q X
PWLC(X) ; Ward Location
Q:+($G(X))=0 "" Q $$GET1^DIQ(2,+($G(X)),.1)
PDIS(X,ARY) ; Rated Disabilties .372;0
Q:+($G(X))=0 "" N GMTSI,GMTSC,GMTSR,GMTSD,GMTSS S (GMTSC,GMTSI)=0 F S GMTSI=$O(^DPT(+($G(X)),.372,GMTSI)) Q:+GMTSI=0 D
. S GMTSR=$$GET1^DIQ(2.04,(GMTSI_","_+($G(X))_","),.01),GMTSD=$$GET1^DIQ(2.04,(GMTSI_","_+($G(X))_","),2),GMTSS=$$GET1^DIQ(2.04,(GMTSI_","_+($G(X))_","),3),GMTSC=GMTSC+1,ARY(GMTSC)=GMTSR_"^"_GMTSD_"^"_GMTSS
S X=+($G(GMTSC)) S:X>0 ARY(0)=X,ARY="Rated Disabilities (VA)^Disability Percent^Service Connected" Q X
PLAB(X) ; Lab Patient LR;1
Q:+($G(X))=0 "" Q $$GET1^DIQ(2,+($G(X)),63)
;
; Health Summary
MSIT(X) ; Mix Case Site
Q $$EN^GMTSUMX($$SITE)
SITE(X) ; Site
N SITE,INTG,PRIM S U="^",X="" S SITE=$$KSP^XUPARAM("INST"),SITE=$$UP^XLFSTR($$GET1^DIQ(4,+($G(SITE)),.01)),INTG=$$UP^XLFSTR($$NAME^VASITE($$NOW^XLFDT)),PRIM=$$UP^XLFSTR($P($$SITE^VASITE($$NOW^XLFDT),"^",2))
S:$L(SITE)&(PRIM=SITE) PRIM="" S:'$L(SITE)&($L(PRIM)) SITE=PRIM,PRIM="" I $L(SITE) S X=SITE S:$L(INTG)&(INTG'=SITE) X=INTG_" ("_SITE_")"
S:'$L(SITE)&($L(INTG)) X=INTG
Q X
TSIT(X) ; Site
N SITE S U="^",X=""
S SITE=$$KSP^XUPARAM("INST"),SITE=$$UP^XLFSTR($$GET1^DIQ(4,+($G(SITE)),.01))
S X=SITE Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSU2 3349 printed Nov 22, 2024@17:10:33 Page 2
GMTSU2 ; SLC/KER - Health Summary Utilities ; 08/27/2002
+1 ;;2.7;Health Summary;**29,56**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10035 ^DPT( file #2
+5 ; DBIA 10060 ^VA(200,
+6 ; DBIA 10090 ^DIC(4,
+7 ; DBIA 2056 $$GET1^DIQ (file #200, 2 and 4)
+8 ; DBIA 10103 $$NOW^XLFDT
+9 ; DBIA 10112 $$SITE^VASITE
+10 ; DBIA 10112 $$NAME^VASITE
+11 ; DBIA 2541 $$KSP^XUPARAM
+12 ; DBIA 10104 $$UP^XLFSTR
+13 ;
+14 QUIT
+15 ; User
USER(X) ; Is a user (1 yes 0 no) 0;1
+1 NEW GMTS
if +($GET(X))=0
QUIT ""
SET GMTS=$$UNAM(+($GET(X)))
SET X=$SELECT($LENGTH(GMTS)>0:1,1:0)
QUIT X
UACT(X) ; Active User (1 active) 0;11
+1 NEW GMTS,GMTSN
if +($GET(X))=0
QUIT 0
SET GMTS=$$USER(+($GET(X)))
if +GMTS=0
QUIT 0
+2 SET GMTS=+($$GET1^DIQ(200,+($GET(X)),9.2,"I"))
SET GMTSN=$$NOW^XLFDT
if GMTS>0&(GMTS<GMTSN)
QUIT 0
QUIT 1
UNAM(X) ; User Name 0;1
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.01)
UHPH(X) ; Home Phone .13;1
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.132)
UOPH(X) ; Office Phone .13;2
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.132)
UPH3(X) ; Phone Number #3 .13;3
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.133)
UPH4(X) ; Phone Number #4 .13;4
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.134)
UCPH(X) ; Commercial Phone .13;5
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.135)
UFAX(X) ; Fax Number .13;6
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.136)
UAPG(X) ; Analog Pager .13;7
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.137)
UDPG(X) ; Digital Pager .13;8
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(200,+($GET(X)),.138)
+2 ;
+3 ; Patient
PAT(X) ; Is a patient (1 yes 0 no) 0;1
+1 NEW GMTS
if +($GET(X))=0
QUIT ""
SET GMTS=$$PNAM(+($GET(X)))
SET X=$SELECT($LENGTH(GMTS)>0:1,1:0)
QUIT X
PNAM(X) ; Patient Name 0;1
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(2,+($GET(X)),.01)
PMAR(X) ; Patient Marital Status 0;5
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(2,+($GET(X)),.05)
PWAR(X) ; Patient has a Ward Location
+1 NEW GMTS
if +($GET(X))=0
QUIT ""
SET GMTS=PWLC(X)
SET X=$SELECT($LENGTH(GMTS):1,1:0)
QUIT X
PWLC(X) ; Ward Location
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(2,+($GET(X)),.1)
PDIS(X,ARY) ; Rated Disabilties .372;0
+1 if +($GET(X))=0
QUIT ""
NEW GMTSI,GMTSC,GMTSR,GMTSD,GMTSS
SET (GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(^DPT(+($GET(X)),.372,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+2 SET GMTSR=$$GET1^DIQ(2.04,(GMTSI_","_+($GET(X))_","),.01)
SET GMTSD=$$GET1^DIQ(2.04,(GMTSI_","_+($GET(X))_","),2)
SET GMTSS=$$GET1^DIQ(2.04,(GMTSI_","_+($GET(X))_","),3)
SET GMTSC=GMTSC+1
SET ARY(GMTSC)=GMTSR_"^"_GMTSD_"^"_GMTSS
End DoDot:1
+3 SET X=+($GET(GMTSC))
if X>0
SET ARY(0)=X
SET ARY="Rated Disabilities (VA)^Disability Percent^Service Connected"
QUIT X
PLAB(X) ; Lab Patient LR;1
+1 if +($GET(X))=0
QUIT ""
QUIT $$GET1^DIQ(2,+($GET(X)),63)
+2 ;
+3 ; Health Summary
MSIT(X) ; Mix Case Site
+1 QUIT $$EN^GMTSUMX($$SITE)
SITE(X) ; Site
+1 NEW SITE,INTG,PRIM
SET U="^"
SET X=""
SET SITE=$$KSP^XUPARAM("INST")
SET SITE=$$UP^XLFSTR($$GET1^DIQ(4,+($GET(SITE)),.01))
SET INTG=$$UP^XLFSTR($$NAME^VASITE($$NOW^XLFDT))
SET PRIM=$$UP^XLFSTR($PIECE($$SITE^VASITE($$NOW^XLFDT),"^",2))
+2 if $LENGTH(SITE)&(PRIM=SITE)
SET PRIM=""
if '$LENGTH(SITE)&($LENGTH(PRIM))
SET SITE=PRIM
SET PRIM=""
IF $LENGTH(SITE)
SET X=SITE
if $LENGTH(INTG)&(INTG'=SITE)
SET X=INTG_" ("_SITE_")"
+3 if '$LENGTH(SITE)&($LENGTH(INTG))
SET X=INTG
+4 QUIT X
TSIT(X) ; Site
+1 NEW SITE
SET U="^"
SET X=""
+2 SET SITE=$$KSP^XUPARAM("INST")
SET SITE=$$UP^XLFSTR($$GET1^DIQ(4,+($GET(SITE)),.01))
+3 SET X=SITE
QUIT X
