GMTSDEMP ; SLC/DLT,KER - Demographic (Providers) ; 08/27/2002
;;2.7;Health Summary;**55,56**;Oct 20, 1995
;
; External References
; DBIA 10035 ^DPT( (file #2)
; DBIA 2056 $$GET1^DIQ (file #4, #200 and #404.51)
; DBIA 1252 $$OUTPTTM^SDUTL3
; DBIA 1252 $$OUTPTPR^SDUTL3
; DBIA 1252 $$OUTPTAP^SDUTL3
; DBIA 10103 $$DT^XLFDT
;
CD(DFN) ; Clinical Demographics (Provider Info)
Q:$D(GMTSQIT) N PAT,TEAM,TMPH,PROV,PHN,ANA,DIG,ASSP,PHN,ANA,DIG,IPRO
N LF,IPPH,IPGA,IPGD,ATTN,ATPH,APGA,APGD S LF=1,(TEAM,PROV,ASSP,IPRO,ATTN)=0
S (TMPH,PHN,ANA,DIG,PHN,ANA,DIG,IPPH,IPGA,IPGD,ATPH,APGA,APGD)=""
S:+($G(DT))=0 DT=$$DT^XLFDT
;
TEAM ; PCMM TEAM
S TEAM=$$OUTPTTM^SDUTL3(+($G(DFN)))
I +($G(TEAM))>0 D Q:$D(GMTSQIT)
. N PHN S PHN=$$GET1^DIQ(404.51,(+TEAM_","),.02)
. D LF Q:$D(GMTSQIT)
. S TEAM=$E($P($G(TEAM),"^",2),1,31)
. D:$L(TEAM)!($L(PHN)) WRT^GMTSDEM("PCMM Team",TEAM,"Phone",$G(PHN),1)
;
PROV ; PCMM Outpatient Provider
S PROV=$$OUTPTPR^SDUTL3(+($G(DFN))) I +PROV>0 D Q:$D(GMTSQIT)
. N PHN,ANA,DIG Q:'$L($P(PROV,"^",2)) S (PHN,ANA,DIG)=""
. S PHN=$$GET1^DIQ(200,(+($G(PROV))_","),.132)
. S ANA=$$GET1^DIQ(200,(+($G(PROV))_","),.137)
. S DIG=$$GET1^DIQ(200,(+($G(PROV))_","),.138)
. D LF Q:$D(GMTSQIT)
. D WRT^GMTSDEM("PCMM Provider",$E($P($G(PROV),"^",2),1,31),"Phone",$G(PHN),1)
. I $L($G(ANA)) D
. . D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1)
. I '$L($G(ANA)),$L($G(DIG)) D
. . D WRT^GMTSDEM("Digital Pager",DIG,"","",1)
;
ASSP ; PCMM Associate Provider
S ASSP=$$OUTPTAP^SDUTL3(+($G(DFN))) I +ASSP>0&(+ASSP'=+PROV) D
. N PHN,ANA,DIG S ASSP=+ASSP_"^"_$$GET1^DIQ(200,(+($G(ASSP))_","),.01)
. Q:'$L($P(ASSP,"^",2)) S (PHN,ANA,DIG)=""
. S PHN=$$GET1^DIQ(200,(+($G(ASSP))_","),.132),ANA=$$GET1^DIQ(200,(+($G(ASSP))_","),.137),DIG=$$GET1^DIQ(200,(+($G(ASSP))_","),.138)
. D LF Q:$D(GMTSQIT) S ASSP=$E($P($G(ASSP),"^",2),1,31)
. D WRT^GMTSDEM("PCMM Assoc. Prov",ASSP,"Phone",$G(PHN),1)
. I $L($G(ANA)) D WRT^GMTSDEM("Analog Pager",ANA,$S($L(DIG):"Digital Pager",1:""),$S($L(DIG):DIG,1:""),1)
. I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1)
;
IPAT ; Inpatient Provider/Attending
S ATTN=$G(^DPT(+($G(DFN)),.1041))
S IPRO=$G(^DPT(+($G(DFN)),.104)) I +IPRO>0 D
. S IPRO=+IPRO_"^"_$$GET1^DIQ(200,(+($G(IPRO))_","),.01)
. I '$L($P(IPRO,"^",2)) S IPRO=0,(IPPH,IPGA,IPGD)="" Q
. S IPPH=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
. S IPGA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
. S IPGD=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
;
ONEDOC ; Inpatient Provider and Attending are the Same
I +($G(IPRO))=+($G(ATTN)) D Q:$D(GMTSQIT)
. Q:$D(GMTSQIT) I +IPRO>0 D Q:$D(GMTSQIT)
. . N PHN,ANA,DIG
. . S PHN=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
. . S ANA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
. . S DIG=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
. . D LF Q:$D(GMTSQIT)
. . D WRT^GMTSDEM("Inpat. Prov/Attn",$E($P($G(IPRO),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
. . 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)
. . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
;
TWODOCS ; Inpatient Provider and Attending are Different
I +($G(IPRO))'=+($G(ATTN)) D Q:$D(GMTSQIT)
. I +IPRO>0 D Q:$D(GMTSQIT)
. . N PHN,ANA,DIG
. . S PHN=$$GET1^DIQ(200,(+($G(IPRO))_","),.132)
. . S ANA=$$GET1^DIQ(200,(+($G(IPRO))_","),.137)
. . S DIG=$$GET1^DIQ(200,(+($G(IPRO))_","),.138)
. . D LF Q:$D(GMTSQIT)
. . D WRT^GMTSDEM("Inpat. Provider",$E($P($G(IPRO),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
. . 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)
. . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
. I +ATTN>0 D Q:$D(GMTSQIT)
. . S ATTN=+ATTN_"^"_$$GET1^DIQ(200,(+($G(ATTN))_","),.01)
. . N PHN,ANA,DIG S (PHN,ANA,DIG)=""
. . S PHN=$$GET1^DIQ(200,(+($G(ATTN))_","),.132)
. . S ANA=$$GET1^DIQ(200,(+($G(ATTN))_","),.137)
. . S DIG=$$GET1^DIQ(200,(+($G(ATTN))_","),.138)
. . D LF Q:$D(GMTSQIT)
. . D WRT^GMTSDEM("Inpat. Attending",$E($P($G(ATTN),"^",2),1,31),"Phone",$G(PHN),1) Q:$D(GMTSQIT)
. . 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)
. . I '$L($G(ANA)),$L($G(DIG)) D WRT^GMTSDEM("Digital Pager",DIG,"","",1) Q:$D(GMTSQIT)
Q
LF ; Line Feed
I +($G(LF))>0 S LF=0 D WRT^GMTSDEM("",,,,0) S LF=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDEMP 4659 printed Nov 22, 2024@17:07:25 Page 2
GMTSDEMP ; SLC/DLT,KER - Demographic (Providers) ; 08/27/2002
+1 ;;2.7;Health Summary;**55,56**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10035 ^DPT( (file #2)
+5 ; DBIA 2056 $$GET1^DIQ (file #4, #200 and #404.51)
+6 ; DBIA 1252 $$OUTPTTM^SDUTL3
+7 ; DBIA 1252 $$OUTPTPR^SDUTL3
+8 ; DBIA 1252 $$OUTPTAP^SDUTL3
+9 ; DBIA 10103 $$DT^XLFDT
+10 ;
CD(DFN) ; Clinical Demographics (Provider Info)
+1 if $DATA(GMTSQIT)
QUIT
NEW PAT,TEAM,TMPH,PROV,PHN,ANA,DIG,ASSP,PHN,ANA,DIG,IPRO
+2 NEW LF,IPPH,IPGA,IPGD,ATTN,ATPH,APGA,APGD
SET LF=1
SET (TEAM,PROV,ASSP,IPRO,ATTN)=0
+3 SET (TMPH,PHN,ANA,DIG,PHN,ANA,DIG,IPPH,IPGA,IPGD,ATPH,APGA,APGD)=""
+4 if +($GET(DT))=0
SET DT=$$DT^XLFDT
+5 ;
TEAM ; PCMM TEAM
+1 SET TEAM=$$OUTPTTM^SDUTL3(+($GET(DFN)))
+2 IF +($GET(TEAM))>0
Begin DoDot:1
+3 NEW PHN
SET PHN=$$GET1^DIQ(404.51,(+TEAM_","),.02)
+4 DO LF
if $DATA(GMTSQIT)
QUIT
+5 SET TEAM=$EXTRACT($PIECE($GET(TEAM),"^",2),1,31)
+6 if $LENGTH(TEAM)!($LENGTH(PHN))
DO WRT^GMTSDEM("PCMM Team",TEAM,"Phone",$GET(PHN),1)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+7 ;
PROV ; PCMM Outpatient Provider
+1 SET PROV=$$OUTPTPR^SDUTL3(+($GET(DFN)))
IF +PROV>0
Begin DoDot:1
+2 NEW PHN,ANA,DIG
if '$LENGTH($PIECE(PROV,"^",2))
QUIT
SET (PHN,ANA,DIG)=""
+3 SET PHN=$$GET1^DIQ(200,(+($GET(PROV))_","),.132)
+4 SET ANA=$$GET1^DIQ(200,(+($GET(PROV))_","),.137)
+5 SET DIG=$$GET1^DIQ(200,(+($GET(PROV))_","),.138)
+6 DO LF
if $DATA(GMTSQIT)
QUIT
+7 DO WRT^GMTSDEM("PCMM Provider",$EXTRACT($PIECE($GET(PROV),"^",2),1,31),"Phone",$GET(PHN),1)
+8 IF $LENGTH($GET(ANA))
Begin DoDot:2
+9 DO WRT^GMTSDEM("Analog Pager",ANA,$SELECT($LENGTH(DIG):"Digital Pager",1:""),$SELECT($LENGTH(DIG):DIG,1:""),1)
End DoDot:2
+10 IF '$LENGTH($GET(ANA))
IF $LENGTH($GET(DIG))
Begin DoDot:2
+11 DO WRT^GMTSDEM("Digital Pager",DIG,"","",1)
End DoDot:2
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+12 ;
ASSP ; PCMM Associate Provider
+1 SET ASSP=$$OUTPTAP^SDUTL3(+($GET(DFN)))
IF +ASSP>0&(+ASSP'=+PROV)
Begin DoDot:1
+2 NEW PHN,ANA,DIG
SET ASSP=+ASSP_"^"_$$GET1^DIQ(200,(+($GET(ASSP))_","),.01)
+3 if '$LENGTH($PIECE(ASSP,"^",2))
QUIT
SET (PHN,ANA,DIG)=""
+4 SET PHN=$$GET1^DIQ(200,(+($GET(ASSP))_","),.132)
SET ANA=$$GET1^DIQ(200,(+($GET(ASSP))_","),.137)
SET DIG=$$GET1^DIQ(200,(+($GET(ASSP))_","),.138)
+5 DO LF
if $DATA(GMTSQIT)
QUIT
SET ASSP=$EXTRACT($PIECE($GET(ASSP),"^",2),1,31)
+6 DO WRT^GMTSDEM("PCMM Assoc. Prov",ASSP,"Phone",$GET(PHN),1)
+7 IF $LENGTH($GET(ANA))
DO WRT^GMTSDEM("Analog Pager",ANA,$SELECT($LENGTH(DIG):"Digital Pager",1:""),$SELECT($LENGTH(DIG):DIG,1:""),1)
+8 IF '$LENGTH($GET(ANA))
IF $LENGTH($GET(DIG))
DO WRT^GMTSDEM("Digital Pager",DIG,"","",1)
End DoDot:1
+9 ;
IPAT ; Inpatient Provider/Attending
+1 SET ATTN=$GET(^DPT(+($GET(DFN)),.1041))
+2 SET IPRO=$GET(^DPT(+($GET(DFN)),.104))
IF +IPRO>0
Begin DoDot:1
+3 SET IPRO=+IPRO_"^"_$$GET1^DIQ(200,(+($GET(IPRO))_","),.01)
+4 IF '$LENGTH($PIECE(IPRO,"^",2))
SET IPRO=0
SET (IPPH,IPGA,IPGD)=""
QUIT
+5 SET IPPH=$$GET1^DIQ(200,(+($GET(IPRO))_","),.132)
+6 SET IPGA=$$GET1^DIQ(200,(+($GET(IPRO))_","),.137)
+7 SET IPGD=$$GET1^DIQ(200,(+($GET(IPRO))_","),.138)
End DoDot:1
+8 ;
ONEDOC ; Inpatient Provider and Attending are the Same
+1 IF +($GET(IPRO))=+($GET(ATTN))
Begin DoDot:1
+2 if $DATA(GMTSQIT)
QUIT
IF +IPRO>0
Begin DoDot:2
+3 NEW PHN,ANA,DIG
+4 SET PHN=$$GET1^DIQ(200,(+($GET(IPRO))_","),.132)
+5 SET ANA=$$GET1^DIQ(200,(+($GET(IPRO))_","),.137)
+6 SET DIG=$$GET1^DIQ(200,(+($GET(IPRO))_","),.138)
+7 DO LF
if $DATA(GMTSQIT)
QUIT
+8 DO WRT^GMTSDEM("Inpat. Prov/Attn",$EXTRACT($PIECE($GET(IPRO),"^",2),1,31),"Phone",$GET(PHN),1)
if $DATA(GMTSQIT)
QUIT
+9 IF $LENGTH($GET(ANA))
DO WRT^GMTSDEM("Analog Pager",ANA,$SELECT($LENGTH(DIG):"Digital Pager",1:""),$SELECT($LENGTH(DIG):DIG,1:""),1)
if $DATA(GMTSQIT)
QUIT
+10 IF '$LENGTH($GET(ANA))
IF $LENGTH($GET(DIG))
DO WRT^GMTSDEM("Digital Pager",DIG,"","",1)
if $DATA(GMTSQIT)
QUIT
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+11 ;
TWODOCS ; Inpatient Provider and Attending are Different
+1 IF +($GET(IPRO))'=+($GET(ATTN))
Begin DoDot:1
+2 IF +IPRO>0
Begin DoDot:2
+3 NEW PHN,ANA,DIG
+4 SET PHN=$$GET1^DIQ(200,(+($GET(IPRO))_","),.132)
+5 SET ANA=$$GET1^DIQ(200,(+($GET(IPRO))_","),.137)
+6 SET DIG=$$GET1^DIQ(200,(+($GET(IPRO))_","),.138)
+7 DO LF
if $DATA(GMTSQIT)
QUIT
+8 DO WRT^GMTSDEM("Inpat. Provider",$EXTRACT($PIECE($GET(IPRO),"^",2),1,31),"Phone",$GET(PHN),1)
if $DATA(GMTSQIT)
QUIT
+9 IF $LENGTH($GET(ANA))
DO WRT^GMTSDEM("Analog Pager",ANA,$SELECT($LENGTH(DIG):"Digital Pager",1:""),$SELECT($LENGTH(DIG):DIG,1:""),1)
if $DATA(GMTSQIT)
QUIT
+10 IF '$LENGTH($GET(ANA))
IF $LENGTH($GET(DIG))
DO WRT^GMTSDEM("Digital Pager",DIG,"","",1)
if $DATA(GMTSQIT)
QUIT
End DoDot:2
if $DATA(GMTSQIT)
QUIT
+11 IF +ATTN>0
Begin DoDot:2
+12 SET ATTN=+ATTN_"^"_$$GET1^DIQ(200,(+($GET(ATTN))_","),.01)
+13 NEW PHN,ANA,DIG
SET (PHN,ANA,DIG)=""
+14 SET PHN=$$GET1^DIQ(200,(+($GET(ATTN))_","),.132)
+15 SET ANA=$$GET1^DIQ(200,(+($GET(ATTN))_","),.137)
+16 SET DIG=$$GET1^DIQ(200,(+($GET(ATTN))_","),.138)
+17 DO LF
if $DATA(GMTSQIT)
QUIT
+18 DO WRT^GMTSDEM("Inpat. Attending",$EXTRACT($PIECE($GET(ATTN),"^",2),1,31),"Phone",$GET(PHN),1)
if $DATA(GMTSQIT)
QUIT
+19 IF $LENGTH($GET(ANA))
DO WRT^GMTSDEM("Analog Pager",ANA,$SELECT($LENGTH(DIG):"Digital Pager",1:""),$SELECT($LENGTH(DIG):DIG,1:""),1)
if $DATA(GMTSQIT)
QUIT
+20 IF '$LENGTH($GET(ANA))
IF $LENGTH($GET(DIG))
DO WRT^GMTSDEM("Digital Pager",DIG,"","",1)
if $DATA(GMTSQIT)
QUIT
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+21 QUIT
LF ; Line Feed
+1 IF +($GET(LF))>0
SET LF=0
DO WRT^GMTSDEM("",,,,0)
SET LF=0
+2 QUIT
