source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDEMP.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1GMTSDEMP ; SLC/DLT,KER - Demographic (Providers) ; 08/27/2002
2 ;;2.7;Health Summary;**55,56**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10035 ^DPT( (file #2)
6 ; DBIA 2056 $$GET1^DIQ (file #4, #200 and #404.51)
7 ; DBIA 1252 $$OUTPTTM^SDUTL3
8 ; DBIA 1252 $$OUTPTPR^SDUTL3
9 ; DBIA 1252 $$OUTPTAP^SDUTL3
10 ; DBIA 10103 $$DT^XLFDT
11 ;
12CD(DFN) ; Clinical Demographics (Provider Info)
13 Q:$D(GMTSQIT) N PAT,TEAM,TMPH,PROV,PHN,ANA,DIG,ASSP,PHN,ANA,DIG,IPRO
14 N LF,IPPH,IPGA,IPGD,ATTN,ATPH,APGA,APGD S LF=1,(TEAM,PROV,ASSP,IPRO,ATTN)=0
15 S (TMPH,PHN,ANA,DIG,PHN,ANA,DIG,IPPH,IPGA,IPGD,ATPH,APGA,APGD)=""
16 S:+($G(DT))=0 DT=$$DT^XLFDT
17 ;
18TEAM ; PCMM TEAM
19 S TEAM=$$OUTPTTM^SDUTL3(+($G(DFN)))
20 I +($G(TEAM))>0 D Q:$D(GMTSQIT)
21 . N PHN S PHN=$$GET1^DIQ(404.51,(+TEAM_","),.02)
22 . D LF Q:$D(GMTSQIT)
23 . S TEAM=$E($P($G(TEAM),"^",2),1,31)
24 . D:$L(TEAM)!($L(PHN)) WRT^GMTSDEM("PCMM Team",TEAM,"Phone",$G(PHN),1)
25 ;
26PROV ; PCMM Outpatient Provider
27 S PROV=$$OUTPTPR^SDUTL3(+($G(DFN))) I +PROV>0 D Q:$D(GMTSQIT)
28 . N PHN,ANA,DIG Q:'$L($P(PROV,"^",2)) S (PHN,ANA,DIG)=""
29 . S PHN=$$GET1^DIQ(200,(+($G(PROV))_","),.132)
30 . S ANA=$$GET1^DIQ(200,(+($G(PROV))_","),.137)
31 . S DIG=$$GET1^DIQ(200,(+($G(PROV))_","),.138)
32 . D LF Q:$D(GMTSQIT)
33 . D WRT^GMTSDEM("PCMM Provider",$E($P($G(PROV),"^",2),1,31),"Phone",$G(PHN),1)
34 . I $L($G(ANA)) D
35 . . D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1)
36 . I '$L($G(ANA)),$L($G(DIG)) D
37 . . D WRT^GMTSDEM("Digital Pager",DIG,"","",1)
38 ;
39ASSP ; PCMM Associate Provider
40 S ASSP=$$OUTPTAP^SDUTL3(+($G(DFN))) I +ASSP>0&(+ASSP'=+PROV) D
41 . N PHN,ANA,DIG S ASSP=+ASSP_"^"_$$GET1^DIQ(200,(+($G(ASSP))_","),.01)
42 . Q:'$L($P(ASSP,"^",2)) S (PHN,ANA,DIG)=""
43 . S PHN=$$GET1^DIQ(200,(+($G(ASSP))_","),.132),ANA=$$GET1^DIQ(200,(+($G(ASSP))_","),.137),DIG=$$GET1^DIQ(200,(+($G(ASSP))_","),.138)
44 . D LF Q:$D(GMTSQIT) S ASSP=$E($P($G(ASSP),"^",2),1,31)
45 . D WRT^GMTSDEM("PCMM Assoc. Prov",ASSP,"Phone",$G(PHN),1)
46 . I $L($G(ANA)) D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1)
47 . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1)
48 ;
49IPAT ; Inpatient Provider/Attending
50 S ATTN=$G(^DPT(+($G(DFN)),.1041))
51 S IPRO=$G(^DPT(+($G(DFN)),.104)) I +IPRO>0 D
52 . S IPRO=+IPRO_"^"_$$GET1^DIQ(200,(+($G(IPRO))_","),.01)
53 . I '$L($P(IPRO,"^",2)) S IPRO=0,(IPPH,IPGA,IPGD)="" Q
54 . S IPPH=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
55 . S IPGA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
56 . S IPGD=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
57 ;
58ONEDOC ; Inpatient Provider and Attending are the Same
59 I +($G(IPRO))=+($G(ATTN)) D Q:$D(GMTSQIT)
60 . Q:$D(GMTSQIT) I +IPRO>0 D Q:$D(GMTSQIT)
61 . . N PHN,ANA,DIG
62 . . S PHN=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
63 . . S ANA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
64 . . S DIG=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
65 . . D LF Q:$D(GMTSQIT)
66 . . D WRT^GMTSDEM("Inpat. Prov/Attn",$E($P($G(IPRO),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
67 . . I $L($G(ANA)) D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1) Q:$D(GMTSQIT)
68 . . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
69 ;
70TWODOCS ; Inpatient Provider and Attending are Different
71 I +($G(IPRO))'=+($G(ATTN)) D Q:$D(GMTSQIT)
72 . I +IPRO>0 D Q:$D(GMTSQIT)
73 . . N PHN,ANA,DIG
74 . . S PHN=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
75 . . S ANA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
76 . . S DIG=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
77 . . D LF Q:$D(GMTSQIT)
78 . . D WRT^GMTSDEM("Inpat. Provider",$E($P($G(IPRO),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
79 . . I $L($G(ANA)) D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1) Q:$D(GMTSQIT)
80 . . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
81 . I +ATTN>0 D Q:$D(GMTSQIT)
82 . . S ATTN=+ATTN_"^"_$$GET1^DIQ(200,(+($G(ATTN))_","),.01)
83 . . N PHN,ANA,DIG S (PHN,ANA,DIG)=""
84 . . S PHN=$$GET1^DIQ(200,(+($G(ATTN))_","),.132)
85 . . S ANA=$$GET1^DIQ(200,(+($G(ATTN))_","),.137)
86 . . S DIG=$$GET1^DIQ(200,(+($G(ATTN))_","),.138)
87 . . D LF Q:$D(GMTSQIT)
88 . . D WRT^GMTSDEM("Inpat. Attending",$E($P($G(ATTN),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
89 . . I $L($G(ANA)) D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1) Q:$D(GMTSQIT)
90 . . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
91 Q
92LF ; Line Feed
93 I +($G(LF))>0 S LF=0 D WRT^GMTSDEM("",,,,0) S LF=0
94 Q
Note: See TracBrowser for help on using the repository browser.