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

GMTSDEMP.m

Go to the documentation of this file. 
  1. GMTSDEMP ; SLC/DLT,KER - Demographic (Providers)   ; 08/27/2002
  1.  ;;2.7;Health Summary;**55,56**;Oct 20, 1995
  1.  ;                    
  1.  ; External References
  1.  ;   DBIA 10035  ^DPT( (file #2)
  1.  ;   DBIA  2056  $$GET1^DIQ (file #4, #200 and #404.51)
  1.  ;   DBIA  1252  $$OUTPTTM^SDUTL3
  1.  ;   DBIA  1252  $$OUTPTPR^SDUTL3
  1.  ;   DBIA  1252  $$OUTPTAP^SDUTL3
  1.  ;   DBIA 10103  $$DT^XLFDT
  1.  ;                  
  1. CD(DFN) ; Clinical Demographics (Provider Info)
  1.  Q:$D(GMTSQIT)  N PAT,TEAM,TMPH,PROV,PHN,ANA,DIG,ASSP,PHN,ANA,DIG,IPRO
  1.  N LF,IPPH,IPGA,IPGD,ATTN,ATPH,APGA,APGD S LF=1,(TEAM,PROV,ASSP,IPRO,ATTN)=0
  1.  S (TMPH,PHN,ANA,DIG,PHN,ANA,DIG,IPPH,IPGA,IPGD,ATPH,APGA,APGD)=""
  1.  S:+($G(DT))=0 DT=$$DT^XLFDT
  1.  ;
  1. TEAM ; PCMM TEAM
  1.  S TEAM=$$OUTPTTM^SDUTL3(+($G(DFN)))
  1.  I +($G(TEAM))>0 D  Q:$D(GMTSQIT)
  1.  . N PHN S PHN=$$GET1^DIQ(404.51,(+TEAM_","),.02)
  1.  . D LF Q:$D(GMTSQIT)
  1.  . S TEAM=$E($P($G(TEAM),"^",2),1,31)
  1.  . D:$L(TEAM)!($L(PHN)) WRT^GMTSDEM("PCMM Team",TEAM,"Phone",$G(PHN),1)
  1.  ;
  1. PROV ; PCMM Outpatient Provider
  1.  S PROV=$$OUTPTPR^SDUTL3(+($G(DFN))) I +PROV>0 D  Q:$D(GMTSQIT)
  1.  . N PHN,ANA,DIG Q:'$L($P(PROV,"^",2))  S (PHN,ANA,DIG)=""
  1.  . S PHN=$$GET1^DIQ(200,(+($G(PROV))_","),.132)
  1.  . S ANA=$$GET1^DIQ(200,(+($G(PROV))_","),.137)
  1.  . S DIG=$$GET1^DIQ(200,(+($G(PROV))_","),.138)
  1.  . D LF Q:$D(GMTSQIT)
  1.  . D WRT^GMTSDEM("PCMM Provider",$E($P($G(PROV),"^",2),1,31),"Phone",$G(PHN),1)
  1.  . I $L($G(ANA)) D
  1.  . . D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1)
  1.  . I '$L($G(ANA)),$L($G(DIG)) D
  1.  . . D WRT^GMTSDEM("Digital Pager",DIG,"","",1)
  1.  ;
  1. ASSP ; PCMM Associate Provider
  1.  S ASSP=$$OUTPTAP^SDUTL3(+($G(DFN))) I +ASSP>0&(+ASSP'=+PROV) D
  1.  . N PHN,ANA,DIG S ASSP=+ASSP_"^"_$$GET1^DIQ(200,(+($G(ASSP))_","),.01)
  1.  . Q:'$L($P(ASSP,"^",2))  S (PHN,ANA,DIG)=""
  1.  . S PHN=$$GET1^DIQ(200,(+($G(ASSP))_","),.132),ANA=$$GET1^DIQ(200,(+($G(ASSP))_","),.137),DIG=$$GET1^DIQ(200,(+($G(ASSP))_","),.138)
  1.  . D LF Q:$D(GMTSQIT)  S ASSP=$E($P($G(ASSP),"^",2),1,31)
  1.  . D WRT^GMTSDEM("PCMM Assoc. Prov",ASSP,"Phone",$G(PHN),1)
  1.  . I $L($G(ANA)) D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1)
  1.  . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1)
  1.  ;
  1. IPAT ; Inpatient Provider/Attending
  1.  S ATTN=$G(^DPT(+($G(DFN)),.1041))
  1.  S IPRO=$G(^DPT(+($G(DFN)),.104)) I +IPRO>0 D
  1.  . S IPRO=+IPRO_"^"_$$GET1^DIQ(200,(+($G(IPRO))_","),.01)
  1.  . I '$L($P(IPRO,"^",2)) S IPRO=0,(IPPH,IPGA,IPGD)="" Q
  1.  . S IPPH=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
  1.  . S IPGA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
  1.  . S IPGD=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
  1.  ;
  1. ONEDOC ;   Inpatient Provider and Attending are the Same
  1.  I +($G(IPRO))=+($G(ATTN)) D  Q:$D(GMTSQIT)
  1.  . Q:$D(GMTSQIT)  I +IPRO>0 D  Q:$D(GMTSQIT)
  1.  . . N PHN,ANA,DIG
  1.  . . S PHN=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
  1.  . . S ANA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
  1.  . . S DIG=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
  1.  . . D LF Q:$D(GMTSQIT)
  1.  . . D WRT^GMTSDEM("Inpat. Prov/Attn",$E($P($G(IPRO),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
  1.  . . 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)
  1.  . . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
  1.  ;
  1. TWODOCS ;   Inpatient Provider and Attending are Different
  1.  I +($G(IPRO))'=+($G(ATTN)) D  Q:$D(GMTSQIT)
  1.  . I +IPRO>0 D  Q:$D(GMTSQIT)
  1.  . . N PHN,ANA,DIG
  1.  . . S PHN=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
  1.  . . S ANA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
  1.  . . S DIG=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
  1.  . . D LF Q:$D(GMTSQIT)
  1.  . . D WRT^GMTSDEM("Inpat. Provider",$E($P($G(IPRO),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
  1.  . . 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)
  1.  . . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
  1.  . I +ATTN>0 D  Q:$D(GMTSQIT)
  1.  . . S ATTN=+ATTN_"^"_$$GET1^DIQ(200,(+($G(ATTN))_","),.01)
  1.  . . N PHN,ANA,DIG S (PHN,ANA,DIG)=""
  1.  . . S PHN=$$GET1^DIQ(200,(+($G(ATTN))_","),.132)
  1.  . . S ANA=$$GET1^DIQ(200,(+($G(ATTN))_","),.137)
  1.  . . S DIG=$$GET1^DIQ(200,(+($G(ATTN))_","),.138)
  1.  . . D LF Q:$D(GMTSQIT)
  1.  . . D WRT^GMTSDEM("Inpat. Attending",$E($P($G(ATTN),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
  1.  . . 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)
  1.  . . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
  1.  Q
  1. LF ; Line Feed
  1.  I +($G(LF))>0 S LF=0 D WRT^GMTSDEM("",,,,0) S LF=0
  1.  Q