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

BMCRPC2.m

Go to the documentation of this file. 
  1. BMCRPC2 ;IHS/CAS/AU - GUI REFERRED CARE INFO SYSTEM (2/4) ;     
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**7,8,12**;JAN 09, 2006;Build 101
  1.  ;
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#8106: Put in code to set up correct OPTION USED
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#8779: Send correct provider to V REFERRAL
  1.  ;GDIT/HS/BEE 10/19/17 - p12 - Address XINDEX/SAC issues
  1.  ;
  1.  ; RPC code for RCIS GUI Application
  1.  ; Routines contains code for adding/updating data into RCIS files
  1. SETREFRL(RSLT,RFDT,PTIEN,TYPE,IORO,ICDCAT,CPTCAT,PURPOS,PRORTY,TYPEX,VSTS,NOTESCHD,HXCMT,RQPR,SCHWIDAY,ICSRP,IFSHT,IHLSM,IHSPH,IEKG,ILBRP,IPCC,IPRNL,ITUBL,ICLNT,IXRYR,IXRYF,TMIEN,SITE,BCMT,PRVDR,LOC,VST,RPNM,SNMDCT,SNMDPT,PROB,SNMDST,OTHRTYP) ;
  1.  K ^TMP($J)
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#8106:Added OXQY0
  1.  ;GDIT/HS/BEE 10/19/17 - p12 - XINDEX finding:Added SECNSFX,Y
  1.  ;N OUT,FDA,ERR1,X,REFNMBR,REFSTATS,RQSTFAC,PRIMPYR,CHSSTATS,CASEMGR,RS,BMCPDRG,BMCECOST,BMCIHSCT,BMCINLOS,ADTLINFO,YEAR,NREFIEN,PRIMREF,EXPSCHDT,VREFIEN
  1.  N OUT,FDA,ERR1,X,REFNMBR,REFSTATS,RQSTFAC,PRIMPYR,CHSSTATS,CASEMGR,RS,BMCPDRG,BMCECOST,BMCIHSCT,BMCINLOS,ADTLINFO,YEAR,NREFIEN,PRIMREF,EXPSCHDT,VREFIEN,OXQY0,SECNSFX,Y
  1.  S ADTLINFO=0 ;;ADDITIONAL INFO flag
  1.  ;; convert date to internal fileman format 
  1.  I $G(DUZ(2))="" S RSLT="~`0^Site selection is Mandatory" Q RSLT
  1.  S YEAR=$$GET1^DIQ(90001.31,$G(DUZ(2))_",",.02)
  1.  ;I ($E(DT,2,3)'=$G(YEAR)) S RSLT="~`0^RCIS SITE PARAMETER file REFERRAL YEAR does not match current FISCAL YEAR" Q RSLT
  1.  I $G(YEAR)="" S RSLT="~`0^RCIS SITE PARAMETER file REFERRAL YEAR field missing or invalid." Q RSLT
  1.  I $P(RFDT,"^",2)'=""  D
  1.  . S PRIMREF=$P(RFDT,"^",2)
  1.  . S RFDT=$P(RFDT,"^",1)
  1.  . I $G(PTIEN)="" S PTIEN=$$GET1^DIQ(90001,PRIMREF_",",.03,"I")
  1.  I $P($G(SCHWIDAY),"^",2)'="" D
  1.  . S EXPSCHDT=$P($P($G(SCHWIDAY),"^",2),"@",1)
  1.  . D DT^DILF("",EXPSCHDT,.EXPSCHDT) I EXPSCHDT="-1" S EXPSCHDT=""
  1.  . ;GDIT/HS/BEE 10/19/17 - p12 - Fixed SAC issue - changed $REPLACE to $TR()
  1.  . ;I $G(EXPSCHDT)'="" S EXPSCHDT=$G(EXPSCHDT)_"."_$REPLACE($P($P($G(SCHWIDAY),"^",2),"@",2),":","")
  1.  . I $G(EXPSCHDT)'="" S EXPSCHDT=$G(EXPSCHDT)_"."_$TR($P($P($G(SCHWIDAY),"^",2),"@",2),":","")
  1.  ;;. . S SCHWIDAY=$P($G(SCHWIDAY),"^",1)
  1.  S SCHWIDAY=$P($G(SCHWIDAY),"^",1)
  1.  D DT^DILF("",RFDT,.RFDT) I RFDT="-1" S RSLT="~`0^Referral Date is not in mm/dd/yyyy fromat" Q RSLT
  1.  ;; check for duplication of record
  1.  I PTIEN'>0 S RSLT="~`0^Patient Ien not provided" Q RSLT
  1.  ;I $D(^BMCREF("AA",PTIEN,RFDT)) S RSLT="~`0^A referral already exists for this patient on this date" Q RSLT
  1.  S REFSTATS="A" ;; Setting status to ACTIVE
  1.  S PRIMPYR="1"  ;; Setting Primary Payor to 'IHS'
  1.  S:'$G(RQPR) RQPR=DUZ   ;; default to logged in user ien
  1.  S RQSTFAC=DUZ(2) ;;default to facility where user is logged onto
  1.  S CHSSTATS="P"  ;; Setting CHS APPROVAL STATUS to 'PENDING'
  1.  S CASEMGR=$$GET1^DIQ(90001.31,RQSTFAC_",",.12,"I") ;;set default case manager if not provided
  1.  S X=$$REFN^BMC  ;;generate Referral Number - will return 13 digit number in variable X
  1.  Q:'X
  1.  X $P(^DD(90001,.02,0),U,5,99) ;; Perform input transport check
  1.  S REFNMBR=$G(X)
  1.  I $G(PRIMREF)'=""  D
  1.  . S REFNMBR=$$GET1^DIQ(90001,PRIMREF_",",.02,"") ;;
  1.  . I PTIEN="" S PTIEN=$$GET1^DIQ(90001,PRIMREF_",",.03,"I")
  1.  . N Y1,Y2,Y3
  1.  . ;; Copied from BMCADDS routine - Begin  - to calculate suffix and visits
  1.  . S (Y1,Y2,Y3)=0
  1.  . I '$D(^BMCREF("S",REFNMBR)) S Y1=0
  1.  . E  S Y="" F  S Y=$O(^BMCREF("S",REFNMBR,Y)) Q:Y=""  D
  1.  . . S Y3=$E(Y,2,$L(Y)),Y2=Y2+1
  1.  . . S:Y3>Y1 Y1=Y3
  1.  . S Y1=Y1+1,Y2=Y2+1,SECNSFX="A"_Y1
  1.  . ;VISTS REMAINING
  1.  . S VSTS=($P(^BMCREF(PRIMREF,11),U,11)-Y2)
  1.  . S:VSTS<0 VSTS=0
  1.  . ;; Copied code from BMCADDS routine - End
  1.  . K Y1,Y2,Y3
  1.  I ((RFDT="")!(PTIEN="")!(RQSTFAC="")!(IORO="")!(PURPOS="")!(PRORTY="")!(VSTS="")!($G(SNMDCT)="")!(SNMDPT="")) S RSLT="~`0^Required field missing" Q RSLT
  1.  S:$D(TMIEN) TMIEN=""
  1.  S:'$D(TYPE) TYPE=""
  1.  S:'$D(TYPEX) TYPEX=""
  1.  S:'$D(OTHRTYP) OTHRTYP=""
  1.  S:'$D(ICDCAT) ICDCAT=""
  1.  S:'$D(CPTCAT) CPTCAT=""
  1.  I $G(PRIMREF)'=""  D
  1.  . S FDA(90001,"+1,",101)=SECNSFX
  1.  . S FDA(90001,"+1,",102)=PRIMREF
  1.  S FDA(90001,"+1,",.01)=RFDT
  1.  S FDA(90001,"+1,",.02)=REFNMBR
  1.  S FDA(90001,"+1,",.03)=PTIEN
  1.  S FDA(90001,"+1,",.04)=TYPE
  1.  S FDA(90001,"+1,",.05)=RQSTFAC
  1.  S FDA(90001,"+1,",.14)=IORO
  1.  S FDA(90001,"+1,",.06)=RQPR
  1.  S FDA(90001,"+1,",.11)=PRIMPYR
  1.  S:ICDCAT'="" FDA(90001,"+1,",.12)=ICDCAT
  1.  S:CPTCAT'="" FDA(90001,"+1,",.13)=CPTCAT
  1.  S FDA(90001,"+1,",1201)=PURPOS
  1.  S FDA(90001,"+1,",.32)=PRORTY
  1.  I ((TYPE="C")) S FDA(90001,"+1,",.07)=$S(TYPEX'="":TYPEX,TYPEX="":$$FIND1^DIC(9999999.11,"","BQX","UNSPECIFIED","B"),1:"") ;;CHS - Vendor
  1.  I ((TYPE="C")&(OTHRTYP'="")) S FDA(90001,"+1,",.09)=OTHRTYP ;;CHS - Vendor and Other can be set at the same time
  1.  I ((TYPE="O")&(OTHRTYP'="")) S FDA(90001,"+1,",.09)=OTHRTYP ;;OTHER - RCIS Specific provider
  1.  I ((TYPE="O")) S FDA(90001,"+1,",.07)=$S(TYPEX'="":TYPEX,TYPEX="":$$FIND1^DIC(9999999.11,"","BQX","UNSPECIFIED","B"),1:"") ;;CHS - Vendor and Other can be set at the same time
  1.  I ((TYPE="N")&(TYPEX'="")) S FDA(90001,"+1,",.23)=TYPEX ;;IN-HOUSE - Clinic Stop
  1.  I ((TYPE="I")&(TYPEX'="")) S FDA(90001,"+1,",.08)=TYPEX ;;IHS (Another facility) - Location (TO IHS FACILITY)
  1.  S:VSTS'="" FDA(90001,"+1,",1111)=VSTS
  1.  S:CHSSTATS'="" FDA(90001,"+1,",1112)=CHSSTATS
  1.  S:NOTESCHD'="" FDA(90001,"+1,",1301)=NOTESCHD
  1.  S:CASEMGR'="" FDA(90001,"+1,",.19)=CASEMGR
  1.  S:SCHWIDAY'="" FDA(90001,"+1,",1302)=SCHWIDAY ;;Schedule With In days
  1.  S:$G(EXPSCHDT)'="" FDA(90001,"+1,",1105)=$G(EXPSCHDT) ;;Expected Schedule DOS
  1.  S:"YN"[IPCC FDA(90001,"+1,",401)=IPCC ;;INCLUDE PCC VISIT FORM
  1.  S:"YN"[ICLNT FDA(90001,"+1,",402)=ICLNT ;;INCLUDE SPECIALTY CLINIC NOTES
  1.  S:"YN"[IPRNL FDA(90001,"+1,",403)=IPRNL ;;INCLUDE PRENATAL RECORD(S)
  1.  S:"YN"[ITUBL FDA(90001,"+1,",404)=ITUBL ;;INCLUDE SIGNED TUBAL CONSENT
  1.  S:"YN"[IFSHT FDA(90001,"+1,",405)=IFSHT ;;INCLUDE FACE SHEET
  1.  S:"YN"[IHLSM FDA(90001,"+1,",406)=IHLSM ;;INCLUDE HEALTH SUMMARY
  1.  S:"YN"[IEKG FDA(90001,"+1,",407)=IEKG ;;INCLUDE MOST RECENT EKG
  1.  S:"YN"[IHSPH FDA(90001,"+1,",408)=IHSPH ;;INCLUDE HISTORY AND PHYSICAL
  1.  S:"YN"[IXRYR FDA(90001,"+1,",409)=IXRYR ;;INCLUDE X-RAY / REPORT
  1.  S:"YN"[IXRYF FDA(90001,"+1,",410)=IXRYF ;;INCLUDE X-RAY FILM
  1.  S:"YN"[ICSRP FDA(90001,"+1,",411)=ICSRP ;;INCLUDE CONSULTATION REPORT
  1.  S:"YN"[ILBRP FDA(90001,"+1,",412)=ILBRP ;;INCLUDE MOST RECENT LAB REPORT
  1.  S:IPCC_ICLNT_IPRNL_ITUBL_IFSHT_IHLSM_IEKG_IHSPH_IXRYR_IXRYF_ICSRP_ILBRP["Y" ADTLINFO=1
  1.  S FDA(90001,"+1,",.34)=ADTLINFO
  1.  S FDA(90001,"+1,",.15)=REFSTATS
  1.  S FDA(90001,"+1,",.25)=DUZ
  1.  S FDA(90001,"+1,",.26)=DT
  1.  S FDA(90001,"+1,",.27)=DT
  1.  S FDA(90001,"+1,",1304)="P"
  1.  S:$G(VST)'="" FDA(90001,"+1,",1309)=$G(VST)
  1.  I TMIEN>0 D  ;;If Template was used for this 'Add Referral'; fetch extra info for that template
  1.  .S BMCPDRG=$$GET1^DIQ(90001.32,TMIEN_",",.21,"I") S:BMCPDRG'="" FDA(90001,"+1,",.21)=BMCPDRG
  1.  .S BMCECOST=$$GET1^DIQ(90001.32,TMIEN_",",1101,"") S:BMCECOST'="" FDA(90001,"+1,",1101)=BMCECOST
  1.  .S BMCIHSCT=$$GET1^DIQ(90001.32,TMIEN_",",1103,"") S:BMCIHSCT'="" FDA(90001,"+1,",1103)=BMCIHSCT
  1.  .S BMCINLOS=$$GET1^DIQ(90001.32,TMIEN_",",1109,"") S:BMCINLOS'="" FDA(90001,"+1,",1109)=BMCINLOS
  1.  N FDAIEN S FDAIEN=""
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#8106;Replace next line with three lines, XQY0 is already defined
  1.  ;D UPDATE^DIE("","FDA","FDAIEN","ERR1")
  1.  S OXQY0=$G(XQY0),XQY0="CIAV VUECENTRIC"
  1.  D UPDATE^DIE("","FDA","FDAIEN","ERR1")
  1.  S XQY0=OXQY0  ;Return to original value
  1.  ;End of CR#8106 changes
  1.  I $D(ERR1("DIERR")) S RSLT="~`0^Error adding referral: "_$G(ERR1("DIERR","1","TEXT",1)) Q RSLT
  1.  ;S ^TMP("FAR4",1)="SNOW 980"_"^PAT "_$G(PTIEN)_"^VST "_$G(VST)_"^REF IEN "_$G(FDAIEN(1))_"^DATE "_DT_"."_$REPLACE($ZT($H),":","")_"^PROV "
  1.  ;_$G(PRVDR)_"^LOC "_$G(LOC)_"^ PROV"_$G(PRVDR)_"^ REF PROV "_$G(RPNM)_"^LOC "_$G(LOC)_"^DUZ "_$G(DUZ)_"^B COmments"_$G(BCMT)
  1.  ;S ^TMP("FAR4",1)="980"_"^"_$G(PTIEN)_"^"_$G(VST)_"^"_$G(FDAIEN(1))_"^"_DT_"."_$REPLACE($ZT($H),":","")_"^"_$G(PRVDR)_"^"_$G(LOC)_"^"_$G(PRVDR)_"^"_$G(RQPR)_"^"_$G(LOC)_"^"_$G(DUZ)
  1.  S NREFIEN=$G(FDAIEN(1))
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#8779: Change to pass requesting provider into call, set outside provider to null
  1.  ;S VREFIEN=$$CRENVREF^BMCRPC4(.OUT,SNMDCT,SNMDPT,PTIEN,$G(VST),$G(PROB),NREFIEN,$$NOW^XLFDT,PRVDR,LOC,PRVDR,"",RPNM,LOC,$$NOW^XLFDT,DUZ)
  1.  S VREFIEN=$$CRENVREF^BMCRPC4(.OUT,SNMDCT,SNMDPT,PTIEN,$G(VST),$G(PROB),NREFIEN,$$NOW^XLFDT,RPNM,LOC,PRVDR,"","",LOC,$$NOW^XLFDT,DUZ)  ;GDIT/HS/BEE 10/19/17 - p12 CR#8779
  1.  I $G(SNMDST)'="" D CRENSCT^BMCRPC3("",NREFIEN,$G(SNMDST))
  1.  I ($G(NREFIEN)'="")&($G(VREFIEN)'="")&('$D(ERR1("DIERR")))  D
  1.  .K FDA,ERR1
  1.  .N FDA,ERR1
  1.  .S FDA(90001,NREFIEN_",",1303)=$G(VREFIEN)
  1.  .D FILE^DIE("","FDA","ERR1")
  1.  I $D(ERR1("DIERR")) S RSLT="~`0^Error updating V Referral IEN:"_$G(ERR1("DIERR","1","TEXT",1)) Q RSLT
  1.  ;
  1.  ;
  1.  D SENDALRT^BMCRPC3(NREFIEN) ;; EP-ALERT FOR PHYS
  1.  D SENDXM^BMCRPC3(NREFIEN,"A") ;; Send mailman message
  1.  D STATIC^BMCRPC3(PTIEN,NREFIEN) ;; fill in EXP (5101 - 5114) fields in RCIS REF file...
  1.  I $D(HXCMT) D
  1.  .I HXCMT'="" D SETMEDHX^BMCRPC3(.RS,HXCMT,PTIEN,NREFIEN,"M")
  1.  I $D(BCMT) D
  1.  .I BCMT'="" D SETMEDHX^BMCRPC3(.RS,BCMT,PTIEN,NREFIEN,"B")
  1.  I $P($G(RS),"^")="~`0" S RSLT=RS Q RSLT
  1.  S RSLT="~`1^"_NREFIEN
  1.  Q RSLT
  1.  ;
  1. UPDREFRL(RSLT,REFIEN,TYPE,INOROUT,ICDCAT,CPTCAT,PURPOSE,PRIORITY,TYPEEXT,VISITS,NOTESCHD,HXCMNTS,SCHWIDAY,ICSRP,IFSHT,IHLSM,IHSPH,IEKG,ILBRP,IPCC,IPRNL,ITUBL,ICLNT,IXRYR,IXRYF,BCMNTS,OTHRTYP,SNMDCT,PROB,SNMDST) ;;update referral data
  1.  K ^TMP($J)
  1.  N OUT,FDA,ERR1,PATIEN,ADTLINFO,EXPSCHDT,VREFIEN
  1.  ;S ^TMP("FAR12",2)=REFIEN_"~"_SCHWIDAY
  1.  S ADTLINFO=0 ;;ADDITIONAL INFO flag
  1.  I '$D(REFIEN) S RSLT="~`0^Referral Ien is not provided" Q RSLT
  1.  I REFIEN'>0 S RSLT="~`0^Referral Ien is not provided" Q RSLT
  1.  S:'$D(TYPE) TYPE=""
  1.  S:'$D(TYPEEXT) TYPEEXT=""
  1.  S:'$D(OTHRTYP) OTHRTYP=""
  1.  S:'$D(ICDCAT) ICDCAT=""
  1.  S:'$D(CPTCAT) CPTCAT=""
  1.  I $P($G(SCHWIDAY),"^",2)'="" D
  1.  . S EXPSCHDT=$P($P($G(SCHWIDAY),"^",2),"@",1)
  1.  . D DT^DILF("",EXPSCHDT,.EXPSCHDT) I EXPSCHDT="-1" S EXPSCHDT=""
  1.  . ;GDIT/HS/BEE 10/19/17 - p12 - Fixed SAC issue - changed $REPLACE to $TR()
  1.  . ;I $G(EXPSCHDT)'="" S EXPSCHDT=$G(EXPSCHDT)_"."_$REPLACE($P($P($G(SCHWIDAY),"^",2),"@",2),":","")
  1.  . I $G(EXPSCHDT)'="" S EXPSCHDT=$G(EXPSCHDT)_"."_$TR($P($P($G(SCHWIDAY),"^",2),"@",2),":","")
  1.  . S SCHWIDAY=$P($G(SCHWIDAY),"^",1)
  1.  S SCHWIDAY=$P($G(SCHWIDAY),"^",1)
  1.  S:TYPE'="" FDA(90001,REFIEN_",",.04)=TYPE
  1.  S:INOROUT'="" FDA(90001,REFIEN_",",.14)=INOROUT
  1.  S:ICDCAT'="" FDA(90001,REFIEN_",",.12)=ICDCAT
  1.  S:CPTCAT'="" FDA(90001,REFIEN_",",.13)=CPTCAT
  1.  S:PURPOSE'="" FDA(90001,REFIEN_",",1201)=PURPOSE
  1.  S:PRIORITY'="" FDA(90001,REFIEN_",",.32)=PRIORITY
  1.  I (TYPE="C") D  ;; CHS - Set Vendor - leave specific provider as is - delete To IHS FAC and Clinic Stop
  1.  .S FDA(90001,REFIEN_",",.23)="@",FDA(90001,REFIEN_",",.08)="@",FDA(90001,REFIEN_",",.07)="@",FDA(90001,REFIEN_",",.09)="@"
  1.  .S FDA(90001,REFIEN_",",.07)=$S(TYPEEXT'="":TYPEEXT,TYPEEXT="":$$FIND1^DIC(9999999.11,"","BQX","UNSPECIFIED","B"),1:"")
  1.  .S:(OTHRTYP'="") FDA(90001,REFIEN_",",.09)=OTHRTYP
  1.  I (TYPE="O") D  ;; OTHER - set Specific provider - leave Vendor as is - delete To IHS FAC and Clinic Stop
  1.  .S FDA(90001,REFIEN_",",.23)="@",FDA(90001,REFIEN_",",.08)="@",FDA(90001,REFIEN_",",.07)="@",FDA(90001,REFIEN_",",.09)="@"
  1.  .S FDA(90001,REFIEN_",",.07)=$S(TYPEEXT'="":TYPEEXT,TYPEEXT="":$$FIND1^DIC(9999999.11,"","BQX","UNSPECIFIED","B"),1:"")
  1.  .S:(OTHRTYP'="") FDA(90001,REFIEN_",",.09)=OTHRTYP
  1.  I (TYPE="N") D  ;; IN-HOUSE - set Clinic Stop - delete Specific provider - Vendor - To IHS FAC
  1.  .S FDA(90001,REFIEN_",",.07)="@",FDA(90001,REFIEN_",",.09)="@",FDA(90001,REFIEN_",",.08)="@",FDA(90001,REFIEN_",",.23)="@"
  1.  .S:(TYPEEXT'="") FDA(90001,REFIEN_",",.23)=TYPEEXT
  1.  I (TYPE="I") D  ;IHS(Another facility)-Set Location(FACILITY)-delete SpecificProvider-Vendor-ClinicStop
  1.  .S FDA(90001,REFIEN_",",.07)="@",FDA(90001,REFIEN_",",.09)="@",FDA(90001,REFIEN_",",.23)="@",FDA(90001,REFIEN_",",.08)="@"
  1.  .S:(TYPEEXT'="") FDA(90001,REFIEN_",",.08)=TYPEEXT
  1.  S:VISITS'="" FDA(90001,REFIEN_",",1111)=VISITS
  1.  S:NOTESCHD'="" FDA(90001,REFIEN_",",1301)=NOTESCHD
  1.  S:SCHWIDAY'="" FDA(90001,REFIEN_",",1302)=SCHWIDAY ;; Schedule With In days
  1.  S:$G(EXPSCHDT)'="" FDA(90001,REFIEN_",",1105)=$G(EXPSCHDT) ;;Expected Schedule DOS
  1.  S:$G(EXPSCHDT)="" FDA(90001,REFIEN_",",1105)="@" ;;Expected Schedule DOS
  1.  S:"YN"[IPCC FDA(90001,REFIEN_",",401)=IPCC ;; INCLUDE PCC VISIT FORM
  1.  S:"YN"[ICLNT FDA(90001,REFIEN_",",402)=ICLNT ;; INCLUDE SPECIALTY CLINIC NOTES
  1.  S:"YN"[IPRNL FDA(90001,REFIEN_",",403)=IPRNL ;;INCLUDE PRENATAL RECORD(S)
  1.  S:"YN"[ITUBL FDA(90001,REFIEN_",",404)=ITUBL ;;INCLUDE SIGNED TUBAL CONSENT
  1.  S:"YN"[IFSHT FDA(90001,REFIEN_",",405)=IFSHT ;;INCLUDE FACE SHEET
  1.  S:"YN"[IHLSM FDA(90001,REFIEN_",",406)=IHLSM ;;INCLUDE HEALTH SUMMARY
  1.  S:"YN"[IEKG FDA(90001,REFIEN_",",407)=IEKG ;; INCLUDE MOST RECENT EKG
  1.  S:"YN"[IHSPH FDA(90001,REFIEN_",",408)=IHSPH ;; INCLUDE HISTORY AND PHYSICAL
  1.  S:"YN"[IXRYR FDA(90001,REFIEN_",",409)=IXRYR ;;INCLUDE X-RAY / REPORT
  1.  S:"YN"[IXRYF FDA(90001,REFIEN_",",410)=IXRYF ;; INCLUDE X-RAY FILM
  1.  S:"YN"[ICSRP FDA(90001,REFIEN_",",411)=ICSRP ;;INCLUDE CONSULTATION REPORT
  1.  S:"YN"[ILBRP FDA(90001,REFIEN_",",412)=ILBRP ;;INCLUDE MOST RECENT LAB REPORT
  1.  S:IPCC_ICLNT_IPRNL_ITUBL_IFSHT_IHLSM_IEKG_IHSPH_IXRYR_IXRYF_ICSRP_ILBRP["Y" ADTLINFO=1
  1.  S FDA(90001,REFIEN_",",.34)=ADTLINFO
  1.  S FDA(90001,REFIEN_",",.27)=DT ;; Date last updated - set to current system date
  1.  D FILE^DIE("","FDA","ERR1")
  1.  I $D(ERR1("DIERR")) S RSLT="~`0^Error updating referral:"_$G(ERR1("DIERR","1","TEXT",1)) Q RSLT
  1.  K ^BMCREF(REFIEN,22)
  1.  I $G(SNMDST)'="" D CRENSCT^BMCRPC3("",REFIEN,$G(SNMDST))
  1.  S VREFIEN=$$GET1^DIQ(90001,REFIEN_",",1303,"I") ;
  1.  ;S ^TMP("1221")=$G(VREFIEN)_"^"_$G(SNMDCT)_"^"_$G(DUZ)_"^"_$G(PROB)
  1.  I $G(VREFIEN)'="" S RSLT=$$UPENVREF^BMCRPC4(VREFIEN,$G(SNMDCT),$G(DUZ),$G(PROB))
  1.  I $G(VREFIEN)="" S RSLT="~`1^"
  1.  I $G(RSLT)'="~`1^" Q RSLT
  1.  D SENDXM^BMCRPC3(REFIEN,"M") ;;Send mailman message
  1.  I $D(HXCMNTS) D
  1.  .I HXCMNTS'="" S PATIEN=$$GET1^DIQ(90001,REFIEN_",",.03,"I") D SETMEDHX^BMCRPC3(.RS,HXCMNTS,PATIEN,REFIEN,"M")
  1.  I $D(BCMNTS) D
  1.  .I BCMNTS'="" S PATIEN=$$GET1^DIQ(90001,REFIEN_",",.03,"I") D SETMEDHX^BMCRPC3(.RS,BCMNTS,PATIEN,REFIEN,"B")
  1.  I $P($G(RS),"^")="~`0" S RSLT=RS Q RSLT
  1.  S RSLT="~`1"
  1.  Q RSLT
  1.  ;
  1. CHKYEAR(RSLT,SITE) ;BMC CHK YEAR SITE PARAM
  1.  ;S SITE="2011 DEMO HOSPITAL"
  1.  I $G(DUZ(2))="" S RSLT="0" Q RSLT
  1.  S YEAR=$$GET1^DIQ(90001.31,$G(DUZ(2))_",",.02)
  1.  I $G(YEAR)="" S RSLT="0" Q RSLT
  1.  S RSLT=$G(YEAR)
  1.  Q RSLT
  1.  ;