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

BSDU1.m

Go to the documentation of this file. 
  1. BSDU1 ; IHS/ANMC/LJF - IHS UTILITY CALLS-PAT INFO ; 
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1. PCP(PAT,ARRAY) ;PEP; -- returns one line of PCP info
  1.  ; PAT = patient internal entry number
  1.  ; ARRAY sent by reference and must be set to a string 
  1.  ; Example of call:  S ARRAY="ABC" D PCP^BSDU1(PAT,.ARRAY)
  1.  ;
  1.  ; Returned array
  1.  ; ARRAY(1)=pcp name/team name/pcp ien/team ien
  1.  ;  ARRAY(1,0)=date last updated/user who updated/reason
  1.  ;
  1.  ; ARRAY(2)=women's health pcp name/wh team name/wh pcp ien/team ien
  1.  ;  ARRAY(2,0)=date last updated/user who updated/reason
  1.  ;
  1.  ; ARRAY(3)=mental health prov name/mh team name/mh pcp ien/mh team ien
  1.  ;                 /mh medication mgr name/mh med mgr ien
  1.  ;  ARRAY(3,0)=date last updated/user who updated/reason
  1.  ; ARRAY(3) only used if site is running Cimarron MH Provider menu
  1.  ;
  1.  NEW LINE,PCP
  1.  S LINE=$$GET1^DIQ(9000001,PAT,.14)_"/"        ;pcp name
  1.  S PCP=$$GET1^DIQ(9000001,PAT,.14,"I")         ;pcp ien
  1.  I $P(^DD(9000001,.14,0),U,2)[6 S PCP=$G(^DIC(16,+PCP,"A3"))
  1.  S TEAM=$$TEAM(PCP)                            ;team name and ien
  1.  S LINE=LINE_$P(TEAM,U,2)_"/"_PCP_"/"_(+TEAM)
  1.  S @ARRAY@(1)=LINE
  1.  ;
  1.  S LINE=$$GET1^DIQ(9000001,PAT,.34)_"/"        ;date last updated
  1.  S LINE=LINE_$$GET1^DIQ(9000001,PAT,.33)_"/"   ;user who updated
  1.  S LINE=LINE_$$GET1^DIQ(9000001,PAT,.37)       ;reason changed
  1.  S @ARRAY@(1,0)=LINE
  1.  ;
  1.  S LINE=$$GET1^DIQ(9002086,PAT,.25)_"/"        ;wh pcp name
  1.  S PCP=$$GET1^DIQ(9002086,PAT,.25,"I")         ;wh pcp ien
  1.  S TEAM=$$TEAM(PCP)                            ;team name and ien
  1.  S LINE=LINE_$P(TEAM,U,2)_"/"_PCP_"/"_(+TEAM)
  1.  S @ARRAY@(2)=LINE
  1.  ;
  1.  S LINE=$$GET1^DIQ(9002086,PAT,.27)_"/"        ;date wh pcp updated
  1.  S LINE=LINE_$$GET1^DIQ(9002086,PAT,.26)_"/"   ;user who updated
  1.  S LINE=LINE_$$GET1^DIQ(9002086,PAT,.28)       ;reason changed
  1.  S @ARRAY@(2,0)=LINE
  1.  ;
  1.  S LINE=$$GET1^DIQ(9000001,PAT,1701)_"/"       ;mh pcp name
  1.  S PCP=$$GET1^DIQ(9000001,PAT,1701,"I")        ;mh pcp ien
  1.  S TEAM=$$TEAM(PCP)                            ;team name and ien
  1.  S LINE=LINE_$P(TEAM,U,2)_"/"_PCP_"/"_(+TEAM)
  1.  S LINE=LINE_"/"_$$GET1^DIQ(9000001,PAT,1704)_"/"    ;mh med mgr name
  1.  S LINE=LINE_$$GET1^DIQ(9000001,PAT,1704,"I")        ;mh med mgr ien
  1.  S @ARRAY@(3)=LINE
  1.  ;
  1.  S LINE=$$GET1^DIQ(9000001,PAT,1703)_"/"        ;date last updated
  1.  S LINE=LINE_$$GET1^DIQ(9000001,PAT,1702)_"/"   ;user who updated
  1.  S LINE=LINE_$$GET1^DIQ(9000001,PAT,1707)_"/"   ;reason changed
  1.  S LINE=LINE_$$GET1^DIQ(9000001,PAT,1706)_"/"   ;date med mgr updated
  1.  S LINE=LINE_$$GET1^DIQ(9000001,PAT,1705)_"/"   ;user who updated
  1.  S LINE=LINE_$$GET1^DIQ(9000001,PAT,1708)       ;reason changed
  1.  S @ARRAY@(3,0)=LINE
  1.  ;
  1.  Q
  1.  ;
  1. TEAM(PRV) ; returns team ien and name for provider PRV
  1.  I 'PRV Q 0
  1.  NEW X S X=$O(^BSDPCT("AB",PRV,0)) I 'X Q 0
  1.  Q X_U_$$GET1^DIQ(9009017.5,X,.01)
  1.  ;
  1.  ;
  1. PCLINE(PAT) ;PEP; returns display line of PCP info
  1.  NEW BSDX,X
  1.  S BSDX="BSDX" D PCP(PAT,.BSDX)
  1.  S X="Pcp/Team" S:$P($G(BSDX(2)),"/")]"" X=X_"/WH Pcp/Team"
  1.  S X=X_": "_$S($E(BSDX(1))'="/":$P(BSDX(1),"/",1,2),1:"None/None")
  1.  S:$P($G(BSDX(2)),"/")]"" X=X_"/"_$P(BSDX(2),"/",1,2)  ;wh pcp/team
  1.  Q X
  1.  ;
  1. PCPDISP(PAT,BDGY) ;PEP; returns array for multiple line display of PCP info
  1.  ; Call using D PCPDISP^BSDU1(DFN,.Y) then display Y array
  1.  NEW BDGX
  1.  S BDGX="BDGX" D PCP^BSDU1(PAT,.BDGX)
  1.  S LINE="Primary Care Provider/Team: "
  1.  S LINE=LINE_$P($G(BDGX(1)),"/")_" / "_$P($G(BDGX(1)),"/",2)
  1.  S BDGY(1)=LINE
  1.  ;
  1.  I $P($G(BDGX(2)),"/")]"" D
  1.  . S LINE=$$SP(3)_"Women's Health PCP/Team: "
  1.  . S LINE=LINE_$P($G(BDGX(2)),"/")_" / "_$P($G(BDGX(2)),"/",2)
  1.  . S BDGY(2)=LINE
  1.  ;
  1.  I $P($G(BDGX(3)),"/")]"" D
  1.  . S LINE=$$SP(3)_"Mental Health Providers/Team: "
  1.  . S LINE=LINE_$P($G(BDGX(3)),"/")_" / "_$P($G(BDGX(3)),"/",5)
  1.  . S LINE=LINE_" / "_$P($G(BDGX(3)),"/",2)
  1.  . S BDGY(3)=LINE
  1.  Q
  1.  ;
  1. CMS(PAT) ;EP; displays patient's CMS register memberships, if register allows it
  1.  NEW REG,CNT,BSDLN,FIRST
  1.  S REG=0,FIRST=1
  1.  F  S REG=$O(^ACM(41,"D",PAT,REG)) Q:'REG  D   ;find pat's registers
  1.  . I $$GET1^DIQ(9002241.1,REG,5)="NO" Q      ;not set for HS display
  1.  . S CNT=$G(CNT)+1                             ;count lines
  1.  . I FIRST D                                   ;if 1st line, set caption
  1.  .. S BSDLN(CNT)=" Member of these registers: ",BSDLN(CNT,"F")="!"
  1.  . I 'FIRST S BSDLN(CNT)="",BSDLN(CNT,"F")="!?28"  ;otherwise,set column
  1.  . ;  add register name to display
  1.  . S BSDLN(CNT)=BSDLN(CNT)_$$GET1^DIQ(9002241.1,REG,.01)
  1.  . S FIRST=0
  1.  ;
  1.  I $D(BSDLN) D EN^DDIOL(.BSDLN)                ;display lines
  1.  Q
  1.  ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)