source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSU2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1GMTSU2 ; SLC/KER - Health Summary Utilities ; 08/27/2002
2 ;;2.7;Health Summary;**29,56**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10035 ^DPT( file #2
6 ; DBIA 10060 ^VA(200,
7 ; DBIA 10090 ^DIC(4,
8 ; DBIA 2056 $$GET1^DIQ (file #200, 2 and 4)
9 ; DBIA 10103 $$NOW^XLFDT
10 ; DBIA 10112 $$SITE^VASITE
11 ; DBIA 10112 $$NAME^VASITE
12 ; DBIA 2541 $$KSP^XUPARAM
13 ; DBIA 10104 $$UP^XLFSTR
14 ;
15 Q
16 ; User
17USER(X) ; Is a user (1 yes 0 no) 0;1
18 N GMTS Q:+($G(X))=0 "" S GMTS=$$UNAM(+($G(X))),X=$S($L(GMTS)>0:1,1:0) Q X
19UACT(X) ; Active User (1 active) 0;11
20 N GMTS,GMTSN Q:+($G(X))=0 0 S GMTS=$$USER(+($G(X))) Q:+GMTS=0 0
21 S GMTS=+($$GET1^DIQ(200,+($G(X)),9.2,"I")) S GMTSN=$$NOW^XLFDT Q:GMTS>0&(GMTS<GMTSN) 0 Q 1
22UNAM(X) ; User Name 0;1
23 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.01)
24UHPH(X) ; Home Phone .13;1
25 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.132)
26UOPH(X) ; Office Phone .13;2
27 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.132)
28UPH3(X) ; Phone Number #3 .13;3
29 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.133)
30UPH4(X) ; Phone Number #4 .13;4
31 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.134)
32UCPH(X) ; Commercial Phone .13;5
33 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.135)
34UFAX(X) ; Fax Number .13;6
35 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.136)
36UAPG(X) ; Analog Pager .13;7
37 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.137)
38UDPG(X) ; Digital Pager .13;8
39 Q:+($G(X))=0 "" Q $$GET1^DIQ(200,+($G(X)),.138)
40 ;
41 ; Patient
42PAT(X) ; Is a patient (1 yes 0 no) 0;1
43 N GMTS Q:+($G(X))=0 "" S GMTS=$$PNAM(+($G(X))),X=$S($L(GMTS)>0:1,1:0) Q X
44PNAM(X) ; Patient Name 0;1
45 Q:+($G(X))=0 "" Q $$GET1^DIQ(2,+($G(X)),.01)
46PMAR(X) ; Patient Marital Status 0;5
47 Q:+($G(X))=0 "" Q $$GET1^DIQ(2,+($G(X)),.05)
48PWAR(X) ; Patient has a Ward Location
49 N GMTS Q:+($G(X))=0 "" S GMTS=PWLC(X),X=$S($L(GMTS):1,1:0) Q X
50PWLC(X) ; Ward Location
51 Q:+($G(X))=0 "" Q $$GET1^DIQ(2,+($G(X)),.1)
52PDIS(X,ARY) ; Rated Disabilties .372;0
53 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
54 . 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
55 S X=+($G(GMTSC)) S:X>0 ARY(0)=X,ARY="Rated Disabilities (VA)^Disability Percent^Service Connected" Q X
56PLAB(X) ; Lab Patient LR;1
57 Q:+($G(X))=0 "" Q $$GET1^DIQ(2,+($G(X)),63)
58 ;
59 ; Health Summary
60MSIT(X) ; Mix Case Site
61 Q $$EN^GMTSUMX($$SITE)
62SITE(X) ; Site
63 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))
64 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_")"
65 S:'$L(SITE)&($L(INTG)) X=INTG
66 Q X
67TSIT(X) ; Site
68 N SITE S U="^",X=""
69 S SITE=$$KSP^XUPARAM("INST"),SITE=$$UP^XLFSTR($$GET1^DIQ(4,+($G(SITE)),.01))
70 S X=SITE Q X
Note: See TracBrowser for help on using the repository browser.