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

BPCRC8.m

Go to the documentation of this file. 
  1. BPCRC8 ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;
  1.  ;;1.5;BPC;;MAY 26, 2005
  1.  ;
  1. GETFACE(BPCRES,BPCPIEN,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC GETFACEDATA
  1.  ;
  1. EN ;
  1.  S U="^",XWBWRAP=1,BPCCTR=0,BPCPIEN=$G(BPCPIEN),BPCPARAM=$G(BPCPARAM)
  1.  S BPCS1="`",BPCS2="~"
  1.  K BPCRES,BPCTMP
  1.  I BPCPIEN="" S BPCRES(1)=-1,BPCRES(2)="PATIENT IEN NOT SENT!" D KILL Q
  1.  I '$D(^AUPNPAT(BPCPIEN,0)) S BPCRES(1)=-1,BPCRES(2)="PATIENT IEN IS NOT DEFINED!" D KILL Q
  1.  ;I BPCPARAM="JASPER" D EN^BPCFACE Q
  1.  D GETAUPN,GETDPT,BUILD,KILL
  1.  Q
  1. GETAUPN ;
  1.  S BPCDTA=$G(^AUPNPAT(BPCPIEN,0)),BPCEDTE=$P(BPCDTA,U,2),BPCLDTE=$P(BPCDTA,U,3),BPCSSNS=$P(BPCDTA,U,23),BPCTREN=$P(BPCDTA,U,7),BPCEMP=$P(BPCDTA,U,19)
  1.  S:BPCSSNS'="" BPCSSNS=$P($G(^AUTTSSN(BPCSSNS,0)),U,2) S:BPCSSNS="" BPCSSNS="UNKNOWN"
  1.  I BPCEMP'="" S BPCEMP=$P($G(^AUTNEMPL(BPCEMP,0)),U,1)
  1.  S BPCDTA=$G(^AUPNPAT(BPCPIEN,11)),BPCCLS=$P(BPCDTA,U,11),BPCCOM=$P(BPCDTA,U,18),BPCTRIB=$P(BPCDTA,U,8),BPCTQT=$P(BPCDTA,U,9),BPCIQT=$P(BPCDTA,U,10),BPCESTAT=$P(BPCDTA,U,12)
  1.  I BPCCLS'="" S BPCCLS=$P($G(^AUTTBEN(BPCCLS,0)),U,1)
  1.  I BPCTRIB'="" S BPCTRIB=$P($G(^AUTTTRI(BPCTRIB,0)),U,1)
  1.  I BPCESTAT'="" S BPCESTAT=$S(BPCESTAT="I":"INELIGIBLE",BPCESTAT="D":"DIRECT ONLY",BPCESTAT="C":"CHS & DIRECT",1:"PENDING VERIFICATION")
  1.  S BPCDTA=$G(^AUPNPAT(BPCPIEN,26)),BPCFCTY=$P(BPCDTA,U,2),BPCFST=$P(BPCDTA,U,3),BPCMCTY=$P(BPCDTA,U,5),BPCMST=$P(BPCDTA,U,6)
  1.  I BPCFST'="" S BPCFST=$P($G(^DIC(5,BPCFST,0)),U,1)
  1.  I BPCMST'="" S BPCMST=$P($G(^DIC(5,BPCMST,0)),U,1)
  1.  Q
  1. GETDPT ;
  1.  S BPCDTA=$G(^DPT(BPCPIEN,0)),BPCNAM=$P(BPCDTA,U,1),BPCSSN=$P(BPCDTA,U,9),BPCSEX=$P(BPCDTA,U,2),BPCDOB=$P(BPCDTA,U,3),BPCBCITY=$P(BPCDTA,U,11),BPCBSTA=$P(BPCDTA,U,12),BPCREL=$P(BPCDTA,U,8)
  1.  S:BPCBSTA'="" BPCBSTA=$P($G(^DIC(5,BPCBSTA,0)),U,1) S:BPCREL'="" BPCREL=$P($G(^DIC(13,BPCREL,0)),U,1)
  1.  S BPCSEX=$S(BPCSEX="M":"MALE",BPCSEX="F":"FEMALE",1:""),BPCAGE="",BPCAUN=""
  1.  D:BPCDOB'="" GETAGE
  1.  S BPCDTA=$G(^DPT(BPCPIEN,".11")),BPCSTIEN=$P(BPCDTA,U,5),BPCCTY=$P(BPCDTA,U,7),BPCADDR1=$P(BPCDTA,U,1),BPCADDR2=$P(BPCDTA,U,2),BPCADDR3=$P(BPCDTA,U,3),BPCCITY=$P(BPCDTA,U,4),BPCZIP=$P(BPCDTA,U,6)
  1.  S BPCSTATE="" I BPCSTIEN'="" S BPCSTATE=$P($G(^DIC(5,BPCSTIEN,0)),U,1) S:BPCCTY'="" BPCCTY=$P($G(^DIC(5,BPCSTIEN,1,BPCCTY,0)),U,1)
  1.  S BPCDTA=$G(^DPT(BPCPIEN,".13")),BPCHPH=$P(BPCDTA,U,1),BPCOPH=$P(BPCDTA,U,2)
  1.  S BPCDTA=$G(^DPT(BPCPIEN,".24")),BPCFNAM=$P(BPCDTA,U,1),BPCMNAM=$P(BPCDTA,U,3)
  1.  S BPCDTA=$G(^DPT(BPCPIEN,".33")),BPCEC=$P(BPCDTA,U,1),BPCECAD1=$P(BPCDTA,U,3),BPCECAD2=$P(BPCDTA,U,4),BPCECAD3=$P(BPCDTA,U,5),BPCECCTY=$P(BPCDTA,U,6),BPCECSTA=$P(BPCDTA,U,7),BPCECZIP=$P(BPCDTA,U,8),BPCECPNE=$P(BPCDTA,U,9)
  1.  S:BPCECSTA'="" BPCECSTA=$P($G(^DIC(5,BPCECSTA,0)),U,1)
  1.  S BPCVET=$G(^DPT(BPCPIEN,"VET"))
  1.  S (BPCSRVC,BPCSRVDT,BPCSRVSD,BPCCLAIM)=""
  1.  I BPCVET="Y" D
  1.  .S BPCDTA=$G(^DPT(BPCPIEN,".32")),BPCSRVC=$P(BPCDTA,U,5),BPCSRVDT=$P(BPCDTA,U,6),BPCSRVSD=$P(BPCDTA,U,7) S:BPCSRVC'="" BPCSRVC=$P($G(^DIC(23,BPCSRVC,0)),U,1)
  1.  . S BPCCLAIM=$P($G(^DPT(BPCPIEN,".31")),U,3)
  1.  S BPCSCON=$P($G(^DPT(BPCPIEN,".3")),U,1)
  1.  Q
  1. BUILD ;
  1.  S BPCDTA="DATA"_BPCS1_BPCNAM_BPCS1_BPCEDTE_BPCS1_BPCLDTE_BPCS1_BPCSSN_BPCS1_BPCSSNS_BPCS1_BPCSEX_BPCS1_BPCDOB_BPCS1_BPCAGE_BPCS1_BPCAUN_BPCS1_BPCCLS_BPCS1_BPCCOM
  1.  S BPCDTA=BPCDTA_BPCS1_BPCCTY_BPCS1_BPCADDR1_BPCS1_BPCADDR2_BPCS1_BPCADDR3_BPCS1_BPCCITY_BPCS1_BPCSTATE_BPCS1_BPCZIP_BPCS1_BPCHPH_BPCS1_BPCOPH_BPCS1_BPCTRIB_BPCS1_BPCTQT
  1.  S BPCDTA=BPCDTA_BPCS1_BPCIQT_BPCS1_BPCTREN_BPCS1_BPCBCITY_BPCS1_BPCBSTA_BPCS1_BPCREL_BPCS1_BPCFNAM_BPCS1_BPCFCTY_BPCS1_BPCFST_BPCS1_BPCMNAM_BPCS1_BPCMCTY_BPCS1_BPCMST
  1.  S BPCDTA=BPCDTA_BPCS1_BPCEC_BPCS1_BPCECAD1_BPCS1_BPCECAD2_BPCS1_BPCECAD3_BPCS1_BPCECCTY_BPCS1_BPCECSTA_BPCS1_BPCECZIP_BPCS1_BPCECPNE_BPCS1_BPCEMP_BPCS1_BPCESTAT
  1.  S BPCDTA=BPCDTA_BPCS1_BPCVET_BPCS1_BPCSRVC_BPCS1_BPCSRVDT_BPCS1_BPCSRVSD_BPCS1_BPCSCON_BPCS1_BPCCLAIM
  1.  S BPCCTR=BPCCTR+1,BPCRES(BPCCTR)=BPCDTA
  1.  D BUILD1,BUILD2,BUILD3,BUILD4,BUILD5,BUILD6,BUILD7,BUILD8
  1.  S BPCRES(0)=BPCCTR
  1.  Q
  1. BUILD1 ;
  1.  S BPCX=0,BPCD="",BPCC=0 F  S BPCX=$O(^AUPNPAT(BPCPIEN,43,BPCX)) Q:BPCX=""!(BPCX'?1.N)  S BPCDTA=^(BPCX,0),BPCY=$P(BPCDTA,U,1),BPCQ=$P(BPCDTA,U,2) S:BPCY'="" BPCY=$P($G(^AUTTTRI(BPCY,0)),U,1) I BPCY'=BPCTRIB D
  1.  . S BPCC=BPCC+1
  1.  . S:BPCD'="" BPCD=BPCD_BPCS2_BPCY_U_BPCQ S:BPCD="" BPCD=BPCY_U_BPCQ
  1.  S:BPCC>0 BPCCTR=BPCCTR+1,BPCRES(BPCCTR)="TRIBES"_BPCS1_BPCC_BPCS1_BPCD
  1.  Q
  1. BUILD2 ;
  1.  Q:'$D(^AUPNMCR("B",BPCPIEN))
  1.  S BPCX="",BPCD="",BPCC=0 F  S BPCX=$O(^AUPNMCR("B",BPCPIEN,BPCX)) Q:BPCX=""!(BPCX'?1.N)  S BPCDTA=$G(^AUPNMCR(BPCX,0)) D
  1.  . S BPCN=$P(BPCDTA,U,3),BPCSUF=$P(BPCDTA,U,4)
  1.  . S:BPCSUF'="" BPCSUF=$P($G(^AUTTMCS(BPCSUF,0)),U,1)
  1.  . S BPCY=0 F  S BPCY=$O(^AUPNMCR(BPCX,11,BPCY)) Q:BPCY=""!(BPCY'?1.N)  D
  1.  .. S BPCDTA=^AUPNMCR(BPCX,11,BPCY,0),BPCC=BPCC+1
  1.  .. S:BPCD'="" BPCD=BPCD_BPCS2_BPCDTA
  1.  .. S:BPCD="" BPCD=BPCDTA
  1.  S:BPCC>0 BPCCTR=BPCCTR+1,BPCRES(BPCCTR)="MCR"_BPCS1_BPCN_BPCSUF_BPCS1_BPCC_BPCS1_BPCD
  1.  Q
  1. BUILD3 ;
  1.  Q:'$D(^AUPNMCD("B",BPCPIEN))
  1.  S BPCX="",BPCD="",BPCC=0
  1.  F  S BPCX=$O(^AUPNMCD("B",BPCPIEN,BPCX)) Q:BPCX=""!(BPCX'?1.N)  D
  1.  . S BPCDTA=$G(^AUPNMCD(BPCX,0)),BPCN=$P(BPCDTA,U,3),BPCP=$P(BPCDTA,U,10)
  1.  . S:BPCP'="" BPCP=$P($G(^AUTNINS(BPCP,0)),U,1)
  1.  . S BPCY=0 F  S BPCY=$O(^AUPNMCD(BPCX,11,BPCY)) Q:BPCY=""!(BPCY'?1.N)  D
  1.  .. S BPCDTA=^AUPNMCD(BPCX,11,BPCY,0),BPCC=BPCC+1
  1.  .. S:BPCD'="" BPCD=BPCD_BPCS2_BPCDTA
  1.  .. S:BPCD="" BPCD=BPCDTA
  1.  S:BPCC>0 BPCCTR=BPCCTR+1,BPCRES(BPCCTR)="MCD"_BPCS1_BPCN_BPCS1_BPCC_BPCS1_BPCD_BPCS1_BPCP
  1.  Q
  1. BUILD4 ;
  1.  Q:'$D(^AUPNPRVT("B",BPCPIEN))
  1.  S BPCX="",BPCD="",BPCC=0 F  S BPCX=$O(^AUPNPRVT("B",BPCPIEN,BPCX)) Q:BPCX=""!(BPCX'?1.N)  S BPCY=0 F  S BPCY=$O(^AUPNPRVT(BPCX,11,BPCY)) Q:BPCY=""!(BPCY'?1.N)  D
  1.  . S BPCDTA=^AUPNPRVT(BPCX,11,BPCY,0),BPCC=BPCC+1,BPCN=$P(BPCDTA,U,1) S:BPCN'="" BPCN=$G(^AUTNINS(BPCN,4))
  1.  . S:BPCD'="" BPCD=BPCD_BPCS2_BPCN_U_$P(BPCDTA,U,2)_U_$P(BPCDTA,U,6)_U_$P(BPCDTA,U,7)
  1.  . S:BPCD="" BPCD=BPCN_U_$P(BPCDTA,U,2)_U_$P(BPCDTA,U,6)_U_$P(BPCDTA,U,7)
  1.  S:BPCC>0 BPCCTR=BPCCTR+1,BPCRES(BPCCTR)="PI"_BPCS1_BPCC_BPCS1_BPCD
  1.  Q
  1. BUILD5 ;
  1.  Q:'$D(^DPT(BPCPIEN,".01"))
  1.  S BPCX=0,BPCD="",BPCC=0 F  S BPCX=$O(^DPT(BPCPIEN,".01",BPCX)) Q:BPCX=""!(BPCX'?1.N)  D
  1.  . S BPCDTA=^DPT(BPCPIEN,".01",BPCX,0),BPCC=BPCC+1,BPCN=$P(BPCDTA,U,1)
  1.  . S:BPCD'="" BPCD=BPCD_U_BPCN
  1.  . S:BPCD="" BPCD=BPCN
  1.  S:BPCC>0 BPCCTR=BPCCTR+1,BPCRES(BPCCTR)="NAMES"_BPCS1_BPCC_BPCS1_BPCD
  1.  Q
  1. BUILD6 ;
  1.  Q:'$D(^AUPNPAT(BPCPIEN,41,0))
  1.  S BPCX=0,BPCD="",BPCC=0 F  S BPCX=$O(^AUPNPAT(BPCPIEN,41,BPCX)) Q:BPCX=""!(BPCX'?1.N)  I BPCX'=$G(DUZ(2)) D
  1.  . S BPCDTA=^(BPCX,0),BPCC=BPCC+1,BPCN=$P(BPCDTA,U,2),BPCY=$P($G(^DIC(4,BPCX,0)),U,1)
  1.  . S:BPCD'="" BPCD=BPCD_BPCS2_BPCY_U_BPCN
  1.  . S:BPCD="" BPCD=BPCY_U_BPCN
  1.  S:BPCC>0 BPCCTR=BPCCTR+1,BPCRES(BPCCTR)="REGS"_BPCS1_BPCC_BPCS1_BPCD
  1.  Q
  1. BUILD7 ;
  1.  Q:'$D(^AUPNPAT(BPCPIEN,12,0))
  1.  S BPCX=0,BPCD="",BPCC=0 F  S BPCX=$O(^AUPNPAT(BPCPIEN,12,BPCX)) Q:BPCX=""!(BPCX'?1.N)  D
  1.  . S BPCDTA=^AUPNPAT(BPCPIEN,12,BPCX,0),BPCC=BPCC+1,BPCN=$P(BPCDTA,U,1)
  1.  . S:BPCD'="" BPCD=BPCD_U_BPCN
  1.  . S:BPCD="" BPCD=BPCN
  1.  S:BPCC>0 BPCCTR=BPCCTR+1,BPCRES(BPCCTR)="HOME"_BPCS1_BPCC_BPCS1_BPCD
  1.  Q
  1. BUILD8 ;
  1.  Q:'$D(^AUPNPAT(BPCPIEN,13,0))
  1.  S BPCX=0,BPCD="",BPCC=0 F  S BPCX=$O(^AUPNPAT(BPCPIEN,13,BPCX)) Q:BPCX=""!(BPCX'?1.N)  D
  1.  . S BPCDTA=^AUPNPAT(BPCPIEN,13,BPCX,0),BPCC=BPCC+1,BPCN=$P(BPCDTA,U,1)
  1.  . S:BPCD'="" BPCD=BPCD_U_BPCN
  1.  . S:BPCD="" BPCD=BPCN
  1.  S:BPCC>0 BPCCTR=BPCCTR+1,BPCRES(BPCCTR)="ADD"_BPCS1_BPCC_BPCS1_BPCD
  1.  Q
  1. GETAGE ;
  1.  S %H=+$H D YMD^%DTC S BPCNOW=X
  1.  S X1=BPCNOW,X2=BPCDOB D ^%DTC S BPCAGE=X\365.25
  1.  I BPCAGE S BPCAUN="YRS" Q
  1.  I X#(365.25)>30.5 S BPCAGE=X#(365.25)\30.5,BPCAUN="MONTHS" Q
  1.  S BPCAGE=X,BPCAUN="DAYS"
  1.  K BPCNOW
  1.  Q
  1.  ;
  1. KILL ;
  1.  K BPCNAM,BPCEDTE,BPCLDTE,BPCSSN,BPCSEX,BPCDOB,BPCAGE,BPCAUN,BPCCLS,BPCCOM,BPCCTY,BPCADDR1,BPCADDR2,BPCADDR3,BPCCITY,BPCSTAT,BPCZIP,BPCHPH,BPCOPH
  1.  K BPCTRIB,BPCTQT,BPCIQT,BPCTREN,BPCBCITY,BPCBSTA,BPCREL,BPCFNAM,BPCFCTY,BPCFST,BPCMNAM,BPCMCTY,BPCMST,BPCEC,BPCECAD1,BPCECAD2,BPCECAD3
  1.  K BPCECCTY,BPCECSTA,BPCECZIP,BPCECPNE,BPCEMP,BPCESTAT,BPCVET,BPCSRVC,BPCSAVDT,BPCSRVSD,BPCSCON,BPCCLAIM
  1.  K BPCC,BPCCTR,BPCD,BPCDTA,BPCN,BPCNOW,BPCQ,BPCS1,BPCS2,BPCSRVDT,BPCSSNS,BPCSTATE,BPCSTIEN,BPCSUF,BPCX,BPCY
  1.  Q