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

BDGPI1.m

Go to the documentation of this file. 
  1. BDGPI1 ; IHS/ANMC/LJF - PI EXPANDED DEMOGRAPHICS ; 
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1. EN ; -- main entry point for BDG PI - DEMOGRAPHICS
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG PI - DEMOGRAPHICS")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)=$$SP(10)_"** "_$$CONF^BDGF_" **"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  K ^TMP("BDGPI1",$J)
  1.  S VALMCNT=0
  1.  D BASIC,PCP,INSUR,EC,NOK
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGPI1",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. BASIC ; -- set up demographic data for display
  1.  ; very similar code to SECTION1^BDGPI
  1.  NEW LINE,BDGR
  1.  ; name, cwad display, chart # and date of birth
  1.  S LINE=$$GET1^DIQ(2,DFN,.01)_" "_$TR($$CWAD^BDGF2(DFN)," ","")
  1.  S LINE=$$PAD(LINE,32)_"HRCN: "_$$HRCN^BDGF2(DFN,DUZ(2))
  1.  S LINE=$$PAD(LINE,54)_"DOB: "_$$GET1^DIQ(2,DFN,.03)
  1.  D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; street address, home phone and primary care provider
  1.  S LINE=$$PAD($$GET1^DIQ(2,DFN,.111),32)
  1.  S LINE=LINE_"HOME: "_$$GET1^DIQ(2,DFN,.131)
  1.  S LINE=$$PAD(LINE,54)_"SEX: "_$$GET1^DIQ(2,DFN,.02)
  1.  D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; city, state, eligibility, office phone
  1.  S LINE=$$GET1^DIQ(2,DFN,.114)_", "_$$STATE^BDGPI(DFN)
  1.  S LINE=$$PAD(LINE,30)_"OFFICE: "_$$GET1^DIQ(2,DFN,.132)
  1.  S LINE=$$PAD(LINE,53)_"ELIG: "_$$GET1^DIQ(9000001,DFN,1112)
  1.  D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; service unit based on community of residence
  1.  S LINE=$$GET1^DIQ(9999999.05,+$$GET1^DIQ(9000001,DFN,1117),.05)
  1.  I LINE]"" D SET("("_LINE_" Service Unit)",.VALMCNT)
  1.  Q
  1.  ;
  1. PCP ; set up primary care provider info for display
  1.  NEW BDGX
  1.  S BDGX="BDGX" D PCP^BSDU1(DFN,.BDGX)
  1.  S LINE="Primary Care Provider/Team: "
  1.  S LINE=LINE_$P($G(BDGX(1)),"/")_" / "_$P($G(BDGX(1)),"/",2)
  1.  D SET("",.VALMCNT),SET(LINE,.VALMCNT)
  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.  . D SET(LINE,.VALMCNT)
  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.  . D SET(LINE,.VALMCNT)
  1.  ;
  1.  Q
  1.  ;
  1. INSUR ; set up insurance info for display
  1.  ; -- insurance (from health summary)
  1.  Q:$T(^APCHS5)=""
  1.  NEW APCHSPAT,APCHSCKP,APCHSNPG,APCHSCVD,APCHSBRK,APCHSQ,X
  1.  K ^TMP("BDGPI1A",$J)
  1.  S APCHSPAT=DFN,APCHSCKP="",APCHSNPG=0,APCHSBRK=""
  1.  S APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$E(Y,6,7)_""/""_$E(Y,2,3)"
  1.  D GUIR^XBLM("^APCHS5","^TMP(""BDGPI1A"",$J,")
  1.  D SET("",.VALMCNT)
  1.  S X=0 F  S X=$O(^TMP("BDGPI1A",$J,X)) Q:'X  D
  1.  . D SET(^TMP("BDGPI1A",$J,X),.VALMCNT)
  1.  K ^TMP("BDGPI1A",$J)
  1.  Q
  1.  ;
  1. EC ; set up emergency contact info for display
  1.  D SET("",.VALMCNT)
  1.  K BDGX D ENP^XBDIQ1(2,DFN,".331:.339","BDGX(")
  1.  ;
  1.  S LINE="Emergency Contact: "
  1.  I BDGX(.331)="" D SET(LINE_"None on file",.VALMCNT) Q
  1.  S LINE=LINE_BDGX(.331)_" ("_BDGX(.332)_")"
  1.  D SET(LINE,.VALMCNT)
  1.  ;
  1.  S LINE=$$PAD($$SP(19)_BDGX(.333),50)_"EC Phone: "_BDGX(.339)
  1.  D SET(LINE,.VALMCNT)
  1.  S LINE=$$SP(19)_BDGX(.336)_", "_BDGX(.337)_"  "_BDGX(.338)
  1.  D SET(LINE,.VALMCNT)
  1.  K BDGX
  1.  Q
  1.  ;
  1. NOK ; set up next of kin info for display
  1.  D SET("",.VALMCNT)
  1.  K BDGX D ENP^XBDIQ1(2,DFN,".211:.219","BDGX(")
  1.  ;
  1.  S LINE="Next of Kin: "
  1.  I BDGX(.211)="" D SET(LINE_"None on file",.VALMCNT) Q
  1.  S LINE=LINE_BDGX(.211)_" ("_BDGX(.212)_")"
  1.  D SET(LINE,.VALMCNT)
  1.  ;
  1.  S LINE=$$PAD($$SP(13)_BDGX(.213),50)_"NOK Phone: "_BDGX(.219)
  1.  D SET(LINE,.VALMCNT)
  1.  S LINE=$$SP(13)_BDGX(.216)_", "_BDGX(.217)_"  "_BDGX(.218)
  1.  D SET(LINE,.VALMCNT)
  1.  K BDGX
  1.  Q
  1.  ;
  1. SET(LINE,NUM) ; puts display line into array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGPI1",$J,NUM,0)=LINE
  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)