- BPCRC9 ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;
- ;;1.5;BPC;;MAY 26, 2005
- ;
- GETLET(BPCRES,BPCPIEN,BPCRIEN,BPCFLAG,BPCVIEN,BPCPARAM) ;;EP CALL FROM REMOTE PROC: BPC GETREFLETTER
- ;
- EN ;
- S U="^",XWBWRAP=1,BPCCTR=0,BPCPIEN=$G(BPCPIEN),BPCRIEN=$G(BPCRIEN),BPCFLAG=$G(BPCFLAG),BPCVIEN=$G(BPCVIEN),BPCPARAM=$G(BPCPARAM)
- D NOW^%DTC S BPCNOW=X
- S BPCS1="`",BPCS2="~"
- K BPCRES,BPCTMP
- I BPCPIEN="" S BPCRES(1)=-1,BPCRES(2)="PATIENT IEN NOT SENT!" D KILL Q
- I '$D(^AUPNPAT(BPCPIEN,0)) S BPCRES(1)=-1,BPCRES(2)="PATIENT IEN IS NOT DEFINED!" D KILL Q
- D GETDATA,KILL
- Q
- GETDATA ;
- S BPCID=$$HRN^AUPNPAT(BPCPIEN,DUZ(2),2),BPCSEX=$$VAL^XBDIQ1(2,BPCPIEN,.02),BPCSSN=$$VAL^XBDIQ1(2,BPCPIEN,.09),BPCADDR=$$VAL^XBDIQ1(9000001,BPCPIEN,1602.2),BPCDOB=$$VAL^XBDIQ1(2,BPCPIEN,.03),BPCNAME=$$VAL^XBDIQ1(2,BPCPIEN,.01)
- S BPCCITY=$$VAL^XBDIQ1(9000001,BPCPIEN,1603.2),BPCSTATE=$$VAL^XBDIQ1(9000001,BPCPIEN,1604.2),BPCZIP=$$VAL^XBDIQ1(9000001,BPCPIEN,1605.2),BPCPHONE=$$VAL^XBDIQ1(9000001,BPCPIEN,1606.2)
- S BPCAIDNO=$$VAL^XBDIQ1(90001.31,DUZ(2),1101),BPCALNO=$$VAL^XBDIQ1(90001.31,DUZ(2),1102),BPCANAM=$$VAL^XBDIQ1(90001.31,DUZ(2),1103),BPCAADR=$$VAL^XBDIQ1(90001.31,DUZ(2),1104),BPCATEL=$$VAL^XBDIQ1(90001.31,DUZ(2),1105)
- S BPCCONT=$$VAL^XBDIQ1(90001.31,DUZ(2),.17),BPCCPHON=$$VAL^XBDIQ1(90001.31,DUZ(2),.18)
- S BPCAPNO=$$VAL^XBDIQ1(90001.31,DUZ(2),1106),BPCIDAT=$$VAL^XBDIQ1(90001,BPCRIEN,.01),BPCRNO=$$VAL^XBDIQ1(90001,BPCRIEN,.02),BPCRFAC=$$VAL^XBDIQ1(90001,BPCRIEN,.0999),BPCOPRV=$$VAL^XBDIQ1(90001,BPCRIEN,.09)
- S BPCPTYP=$$VAL^XBDIQ1(90001,BPCRIEN,.14),BPCEBDOS=$$VAL^XBDIQ1(90001,BPCRIEN,1105),BPCEEDOS=$$VAL^XBDIQ1(90001,BPCRIEN,1107),BPCOPVST=$$VAL^XBDIQ1(90001,BPCRIEN,1111),BPCLOS=$$VAL^XBDIQ1(90001,BPCRIEN,1109)
- S BPCPURP=$$VAL^XBDIQ1(90001,BPCRIEN,1201),BPCSNDA=$$VAL^XBDIQ1(90001,BPCRIEN,.34),BPCPRV=$$VAL^XBDIQ1(90001,BPCRIEN,.06),BPCESTAT=$$VAL^XBDIQ1(9000001,BPCPIEN,1112)
- S BPCX=0,BPCD="" F S BPCX=$O(^BMCREF(BPCRIEN,1,BPCX)) Q:BPCX=""!(BPCX'?1.N) D
- . S BPCDTA=^BMCREF(BPCRIEN,1,BPCX,0)
- . S:BPCD'="" BPCD=BPCD_BPCS2_BPCDTA
- . S:BPCD="" BPCD=BPCDTA
- S BPCHX=BPCD
- S BPCFADR1="",BPCFADR2="",BPCFCITY="",BPCFSTAT="",BPCFZIP="",BPCFPH="",BPCPID=""
- I BPCFLAG="V" D
- . S BPCFADR1=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1301)
- . S BPCFADR2=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1310)
- . S BPCFCITY=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1302)
- . S BPCFSTAT=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1303)
- . S BPCFZIP=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1304)
- . S BPCFPH=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1109)
- . S BPCPID=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1701)
- I BPCFLAG="I" D
- . S BPCFADR1=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.14)
- . S BPCFCITY=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.15)
- . S BPCFSTAT=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.16)
- . S BPCFZIP=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.17)
- . S BPCFPH=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.13)
- S BPCLADR=$$VAL^XBDIQ1(9999999.06,DUZ(2),.14),BPCLCITY=$$VAL^XBDIQ1(9999999.06,DUZ(2),.15),BPCLSTAT=$$VAL^XBDIQ1(9999999.06,DUZ(2),.16),BPCLZIP=$$VAL^XBDIQ1(9999999.06,DUZ(2),.17)
- S BPCMCR="",BPCMCD="",BPCPI="",BPCMCDN=""
- I $$MCR^AUPNPAT(BPCPIEN,BPCNOW) S BPCMCR="YES"
- I $$MCD^AUPNPAT(BPCPIEN,BPCNOW) S BPCMCD=$$MCDPN^AUPNPAT(BPCPIEN,BPCNOW,"E"),BPCMCDN=$$MCDN(BPCPIEN)
- I $$PI^AUPNPAT(BPCPIEN,BPCNOW) S BPCPI=$$PIN^AUPNPAT(BPCPIEN,BPCNOW,"E")
- S BPCDTA=BPCNAME_BPCS1_BPCID_BPCS1_BPCSEX_BPCS1_BPCDOB_BPCS1_BPCSSN_BPCS1_BPCADDR_BPCS1_BPCCITY_BPCS1_BPCSTATE_BPCS1_BPCZIP_BPCS1_BPCPHONE_BPCS1_BPCAIDNO_BPCS1_BPCALNO_BPCS1_BPCANAM_BPCS1_BPCAADR_BPCS1_BPCATEL_BPCS1_BPCAPNO
- S BPCDTA=BPCDTA_BPCS1_BPCIDAT_BPCS1_BPCRNO_BPCS1_BPCRFAC_BPCS1_BPCFADR1_BPCS1_BPCFADR2_BPCS1_BPCFCITY_BPCS1_BPCFSTAT_BPCS1_BPCFZIP_BPCS1_BPCFPH_BPCS1_BPCOPRV_BPCS1_BPCPTYP_BPCS1_BPCEBDOS_BPCS1_BPCEEDOS_BPCS1_BPCOPVST
- S BPCDTA=BPCDTA_BPCS1_BPCLOS_BPCS1_BPCPURP_BPCS1_BPCSNDA_BPCS1_BPCHX_BPCS1_BPCMCR_BPCS1_BPCMCD_BPCS1_BPCPI_BPCS1_BPCLADR_BPCS1_BPCLCITY_BPCS1_BPCLSTAT_BPCS1_BPCLZIP_BPCS1_BPCPRV_BPCS1_BPCESTAT_BPCS1_BPCCONT_BPCS1_BPCCPHON
- S BPCDTA=BPCDTA_BPCS1_BPCMCDN_BPCS1_BPCPID
- S BPCRES(1)=1,BPCRES(2)=BPCDTA
- Q
- MCDN(BPCP) ;
- I $G(BPCP)="" Q ""
- S BPCMIEN=$O(^AUPNMCD("B",BPCP,"")) S:BPCMIEN="" BPCY="" D:BPCMIEN'=""
- . S BPCD=$G(^AUPNMCD(BPCMIEN,0))
- . S BPCY=$P(BPCD,U,3)
- K BPCMIEN,BPCD
- Q BPCY
- KILL ;
- K BPCAADR,BPCADDR,BPCAIDNO,BPCALNO,BPCANAM,BPCAPNO,BPCATEL,BPCCITY,BPCCONT,BPCCPHON,BPCCTR,BPCD,BPCDOB,BPCDTA,BPCEBDOS,BPCEEDOS,BPCESTAT,BPCFADR1,BPCFADR2,BPCFCITY,BPCFLAG,BPCFPH,BPCFSTAT,BPCFZIP,BPCHX,BPCID
- K BPCIDAT,BPCLADR,BPCLCITY,BPCLOS,BPCLSTAT,BPCLZIP,BPCMCD,BPCMCDN,BPCMCR,BPCMIEN,BPCNAME,BPCNOW,BPCOPRV,BPCOPVST,BPCPARAM,BPCPHONE,BPCPI,BPCPID,BPCPIEN,BPCPRV,BPCPTYP,BPCPURP,BPCRFAC,BPCRIEN,BPCRNO
- K BPCS1,BPCS2,BPCSEX,BPCSNDA,BPCSSN,BPCSTATE,BPCVIEN,BPCX,BPCY,BPCZIP
- Q
- BPCRC9 ; IHS/OIT/MJL - REFERRED CARE GUI RPC ROUTINES ;
- +1 ;;1.5;BPC;;MAY 26, 2005
- +2 ;
- GETLET(BPCRES,BPCPIEN,BPCRIEN,BPCFLAG,BPCVIEN,BPCPARAM) ;;EP CALL FROM REMOTE PROC: BPC GETREFLETTER
- +1 ;
- EN ;
- +1 SET U="^"
- SET XWBWRAP=1
- SET BPCCTR=0
- SET BPCPIEN=$GET(BPCPIEN)
- SET BPCRIEN=$GET(BPCRIEN)
- SET BPCFLAG=$GET(BPCFLAG)
- SET BPCVIEN=$GET(BPCVIEN)
- SET BPCPARAM=$GET(BPCPARAM)
- +2 DO NOW^%DTC
- SET BPCNOW=X
- +3 SET BPCS1="`"
- SET BPCS2="~"
- +4 KILL BPCRES,BPCTMP
- +5 IF BPCPIEN=""
- SET BPCRES(1)=-1
- SET BPCRES(2)="PATIENT IEN NOT SENT!"
- DO KILL
- QUIT
- +6 IF '$DATA(^AUPNPAT(BPCPIEN,0))
- SET BPCRES(1)=-1
- SET BPCRES(2)="PATIENT IEN IS NOT DEFINED!"
- DO KILL
- QUIT
- +7 DO GETDATA
- DO KILL
- +8 QUIT
- GETDATA ;
- +1 SET BPCID=$$HRN^AUPNPAT(BPCPIEN,DUZ(2),2)
- SET BPCSEX=$$VAL^XBDIQ1(2,BPCPIEN,.02)
- SET BPCSSN=$$VAL^XBDIQ1(2,BPCPIEN,.09)
- SET BPCADDR=$$VAL^XBDIQ1(9000001,BPCPIEN,1602.2)
- SET BPCDOB=$$VAL^XBDIQ1(2,BPCPIEN,.03)
- SET BPCNAME=$$VAL^XBDIQ1(2,BPCPIEN,.01)
- +2 SET BPCCITY=$$VAL^XBDIQ1(9000001,BPCPIEN,1603.2)
- SET BPCSTATE=$$VAL^XBDIQ1(9000001,BPCPIEN,1604.2)
- SET BPCZIP=$$VAL^XBDIQ1(9000001,BPCPIEN,1605.2)
- SET BPCPHONE=$$VAL^XBDIQ1(9000001,BPCPIEN,1606.2)
- +3 SET BPCAIDNO=$$VAL^XBDIQ1(90001.31,DUZ(2),1101)
- SET BPCALNO=$$VAL^XBDIQ1(90001.31,DUZ(2),1102)
- SET BPCANAM=$$VAL^XBDIQ1(90001.31,DUZ(2),1103)
- SET BPCAADR=$$VAL^XBDIQ1(90001.31,DUZ(2),1104)
- SET BPCATEL=$$VAL^XBDIQ1(90001.31,DUZ(2),1105)
- +4 SET BPCCONT=$$VAL^XBDIQ1(90001.31,DUZ(2),.17)
- SET BPCCPHON=$$VAL^XBDIQ1(90001.31,DUZ(2),.18)
- +5 SET BPCAPNO=$$VAL^XBDIQ1(90001.31,DUZ(2),1106)
- SET BPCIDAT=$$VAL^XBDIQ1(90001,BPCRIEN,.01)
- SET BPCRNO=$$VAL^XBDIQ1(90001,BPCRIEN,.02)
- SET BPCRFAC=$$VAL^XBDIQ1(90001,BPCRIEN,.0999)
- SET BPCOPRV=$$VAL^XBDIQ1(90001,BPCRIEN,.09)
- +6 SET BPCPTYP=$$VAL^XBDIQ1(90001,BPCRIEN,.14)
- SET BPCEBDOS=$$VAL^XBDIQ1(90001,BPCRIEN,1105)
- SET BPCEEDOS=$$VAL^XBDIQ1(90001,BPCRIEN,1107)
- SET BPCOPVST=$$VAL^XBDIQ1(90001,BPCRIEN,1111)
- SET BPCLOS=$$VAL^XBDIQ1(90001,BPCRIEN,1109)
- +7 SET BPCPURP=$$VAL^XBDIQ1(90001,BPCRIEN,1201)
- SET BPCSNDA=$$VAL^XBDIQ1(90001,BPCRIEN,.34)
- SET BPCPRV=$$VAL^XBDIQ1(90001,BPCRIEN,.06)
- SET BPCESTAT=$$VAL^XBDIQ1(9000001,BPCPIEN,1112)
- +8 SET BPCX=0
- SET BPCD=""
- FOR
- SET BPCX=$ORDER(^BMCREF(BPCRIEN,1,BPCX))
- IF BPCX=""!(BPCX'?1.N)
- QUIT
- Begin DoDot:1
- +9 SET BPCDTA=^BMCREF(BPCRIEN,1,BPCX,0)
- +10 IF BPCD'=""
- SET BPCD=BPCD_BPCS2_BPCDTA
- +11 IF BPCD=""
- SET BPCD=BPCDTA
- End DoDot:1
- +12 SET BPCHX=BPCD
- +13 SET BPCFADR1=""
- SET BPCFADR2=""
- SET BPCFCITY=""
- SET BPCFSTAT=""
- SET BPCFZIP=""
- SET BPCFPH=""
- SET BPCPID=""
- +14 IF BPCFLAG="V"
- Begin DoDot:1
- +15 SET BPCFADR1=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1301)
- +16 SET BPCFADR2=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1310)
- +17 SET BPCFCITY=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1302)
- +18 SET BPCFSTAT=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1303)
- +19 SET BPCFZIP=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1304)
- +20 SET BPCFPH=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1109)
- +21 SET BPCPID=$$VAL^XBDIQ1(9999999.11,BPCVIEN,1701)
- End DoDot:1
- +22 IF BPCFLAG="I"
- Begin DoDot:1
- +23 SET BPCFADR1=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.14)
- +24 SET BPCFCITY=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.15)
- +25 SET BPCFSTAT=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.16)
- +26 SET BPCFZIP=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.17)
- +27 SET BPCFPH=$$VAL^XBDIQ1(9999999.06,BPCVIEN,.13)
- End DoDot:1
- +28 SET BPCLADR=$$VAL^XBDIQ1(9999999.06,DUZ(2),.14)
- SET BPCLCITY=$$VAL^XBDIQ1(9999999.06,DUZ(2),.15)
- SET BPCLSTAT=$$VAL^XBDIQ1(9999999.06,DUZ(2),.16)
- SET BPCLZIP=$$VAL^XBDIQ1(9999999.06,DUZ(2),.17)
- +29 SET BPCMCR=""
- SET BPCMCD=""
- SET BPCPI=""
- SET BPCMCDN=""
- +30 IF $$MCR^AUPNPAT(BPCPIEN,BPCNOW)
- SET BPCMCR="YES"
- +31 IF $$MCD^AUPNPAT(BPCPIEN,BPCNOW)
- SET BPCMCD=$$MCDPN^AUPNPAT(BPCPIEN,BPCNOW,"E")
- SET BPCMCDN=$$MCDN(BPCPIEN)
- +32 IF $$PI^AUPNPAT(BPCPIEN,BPCNOW)
- SET BPCPI=$$PIN^AUPNPAT(BPCPIEN,BPCNOW,"E")
- +33 SET BPCDTA=BPCNAME_BPCS1_BPCID_BPCS1_BPCSEX_BPCS1_BPCDOB_BPCS1_BPCSSN_BPCS1_BPCADDR_BPCS1_BPCCITY_BPCS1_BPCSTATE_BPCS1_BPCZIP_BPCS1_BPCPHONE_BPCS1_BPCAIDNO_BPCS1_BPCALNO_BPCS1_BPCANAM_BPCS1_BPCAADR_BPCS1_BPCATEL_BPCS1_BPCAPNO
- +34 SET BPCDTA=BPCDTA_BPCS1_BPCIDAT_BPCS1_BPCRNO_BPCS1_BPCRFAC_BPCS1_BPCFADR1_BPCS1_BPCFADR2_BPCS1_BPCFCITY_BPCS1_BPCFSTAT_BPCS1_BPCFZIP_BPCS1_BPCFPH_BPCS1_BPCOPRV_BPCS1_BPCPTYP_BPCS1_BPCEBDOS_BPCS1_BPCEEDOS_BPCS1_BPCOPVST
- +35 SET BPCDTA=BPCDTA_BPCS1_BPCLOS_BPCS1_BPCPURP_BPCS1_BPCSNDA_BPCS1_BPCHX_BPCS1_BPCMCR_BPCS1_BPCMCD_BPCS1_BPCPI_BPCS1_BPCLADR_BPCS1_BPCLCITY_BPCS1_BPCLSTAT_BPCS1_BPCLZIP_BPCS1_BPCPRV_BPCS1_BPCESTAT_BPCS1_BPCCONT_BPCS1_BPCCPHON
- +36 SET BPCDTA=BPCDTA_BPCS1_BPCMCDN_BPCS1_BPCPID
- +37 SET BPCRES(1)=1
- SET BPCRES(2)=BPCDTA
- +38 QUIT
- MCDN(BPCP) ;
- +1 IF $GET(BPCP)=""
- QUIT ""
- +2 SET BPCMIEN=$ORDER(^AUPNMCD("B",BPCP,""))
- IF BPCMIEN=""
- SET BPCY=""
- IF BPCMIEN'=""
- Begin DoDot:1
- +3 SET BPCD=$GET(^AUPNMCD(BPCMIEN,0))
- +4 SET BPCY=$PIECE(BPCD,U,3)
- End DoDot:1
- +5 KILL BPCMIEN,BPCD
- +6 QUIT BPCY
- KILL ;
- +1 KILL BPCAADR,BPCADDR,BPCAIDNO,BPCALNO,BPCANAM,BPCAPNO,BPCATEL,BPCCITY,BPCCONT,BPCCPHON,BPCCTR,BPCD,BPCDOB,BPCDTA,BPCEBDOS,BPCEEDOS,BPCESTAT,BPCFADR1,BPCFADR2,BPCFCITY,BPCFLAG,BPCFPH,BPCFSTAT,BPCFZIP,BPCHX,BPCID
- +2 KILL BPCIDAT,BPCLADR,BPCLCITY,BPCLOS,BPCLSTAT,BPCLZIP,BPCMCD,BPCMCDN,BPCMCR,BPCMIEN,BPCNAME,BPCNOW,BPCOPRV,BPCOPVST,BPCPARAM,BPCPHONE,BPCPI,BPCPID,BPCPIEN,BPCPRV,BPCPTYP,BPCPURP,BPCRFAC,BPCRIEN,BPCRNO
- +3 KILL BPCS1,BPCS2,BPCSEX,BPCSNDA,BPCSSN,BPCSTATE,BPCVIEN,BPCX,BPCY,BPCZIP
- +4 QUIT
