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

BMCRPC3.m

Go to the documentation of this file. 
  1. BMCRPC3 ;  IHS/CAS/AU - GUI-REFERRED CARE INFO SYSTEM (3/4);     
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**7,8,12,13**;JAN 09, 2006;Build 101
  1.  ;
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#8528: Alphabetize the Referral-to-SNOMED terms
  1.  ;GDIT/HS/BEE 10/19/17 - p12 - Address XINDEX/SAC issues
  1.  ;GDIT/HS/BEE 05/08/2018 - BMC*4.0*13 - Consult review - Time is now passed in and required
  1.  ;
  1.  ; RPC code for RCIS GUI Application
  1.  ; Routines contains code for Fetching Referral Templates
  1. GTTMPLST(RSLT) ;; Get RCIS Template List from RCIS ROUTINE REFERRAL DEF
  1.  N INDEX,OUT
  1.  S RSLT="~`"
  1.  D LIST^DIC(90001.32,"","@;.01","P","*",,,,,"","OUT")
  1.  S INDEX=$O(OUT("DILIST",0))
  1.  I +INDEX>0 F  D  Q:(+INDEX'>0)
  1.  .S RSLT=RSLT_$G(OUT("DILIST",INDEX,0))_"~"
  1.  .S INDEX=$O(OUT("DILIST",INDEX))
  1.  S RSLT=$E(RSLT,1,$L(RSLT)-1)
  1.  Q RSLT
  1. GETTMPLT(RSLT,TMPLTIEN) ;; Get Template Detail
  1.  ; D GETTMPLT^BMCRPC3(.R,8) W R
  1.  N INDEX,OUT,TYPE,INOROUT,ICDCAT,CPTCAT,PURPOSE,PRIORITY,TYPEEXT,FCLTYRFT,VISITS,NOTESCHD,HXCMNTS,OTHERTYPE,OTHERTYPETEXT,VREFSNOMED
  1.  ;GDIT/HS/BEE 10/19/17 - p12 - Address XINDEX/SAC issues
  1.  NEW BCMNTS
  1.  S TYPEEXT="",HXCMNTS="",FCLTYRFT=""
  1.  D GETS^DIQ(90001.32,TMPLTIEN_",","@;.04;.07;.08;.09;.11;.12;.13;.14;.32;1;2;1111;1201;1301;1303","I","OUT")
  1.  Q:'$D(OUT)
  1.  S TYPE=$G(OUT(90001.32,TMPLTIEN_",",.04,"I"))
  1.  ;; CHS - Vendor
  1.  I TYPE="C" S TYPEEXT=$G(OUT(90001.32,TMPLTIEN_",",.07,"I")) S FCLTYRFT=$$GET1^DIQ(9999999.11,TYPEEXT_",",.01,"") S OTHERTYPE=$G(OUT(90001.32,TMPLTIEN_",",.09,"I")) S OTHERTYPETEXT=$$GET1^DIQ(90001.53,OTHERTYPE_",",.01,"")
  1.  ;; OTHER - RCIS Specific provider
  1.  I TYPE="O" S TYPEEXT=$G(OUT(90001.32,TMPLTIEN_",",.07,"I")) S FCLTYRFT=$$GET1^DIQ(9999999.11,TYPEEXT_",",.01,"") S OTHERTYPE=$G(OUT(90001.32,TMPLTIEN_",",.09,"I")) S OTHERTYPETEXT=$$GET1^DIQ(90001.53,OTHERTYPE_",",.01,"")
  1.  I TYPE="N" S TYPEEXT="",FCLTYRFT="" ;; no field available in file (90001.32) for - IN-HOUSE - Clinic Stop
  1.  I TYPE="I" S TYPEEXT=$G(OUT(90001.32,TMPLTIEN_",",.08,"I")) S FCLTYRFT=$$GET1^DIQ(9999999.06,TYPEEXT_",",.01,"") ;; IHS (Another facility) - Location (TO IHS FACILITY)
  1.  S INOROUT=$G(OUT(90001.32,TMPLTIEN_",",.14,"I"))
  1.  S ICDCAT=$G(OUT(90001.32,TMPLTIEN_",",.12,"I"))
  1.  S CPTCAT=$G(OUT(90001.32,TMPLTIEN_",",.13,"I"))
  1.  S PURPOSE=$G(OUT(90001.32,TMPLTIEN_",",1201,"I"))
  1.  S PRIORITY=$G(OUT(90001.32,TMPLTIEN_",",.32,"I"))
  1.  S VISITS=$G(OUT(90001.32,TMPLTIEN_",",1111,"I"))
  1.  S NOTESCHD=$G(OUT(90001.32,TMPLTIEN_",",1301,"I"))
  1.  S HXCMNTS=""
  1.  S INDEX=$O(OUT(90001.32,TMPLTIEN_",",1,0))
  1.  I +INDEX>0 F  D  Q:(+INDEX'>0)
  1.  .S HXCMNTS=HXCMNTS_$G(OUT(90001.32,TMPLTIEN_",",1,INDEX))_"~"
  1.  .S INDEX=$O(OUT(90001.32,TMPLTIEN_",",1,INDEX))
  1.  S HXCMNTS=$E(HXCMNTS,1,$L(HXCMNTS)-1)
  1.  S BCMNTS=""
  1.  S INDEX=$O(OUT(90001.32,TMPLTIEN_",",2,0))
  1.  I +INDEX>0 F  D  Q:(+INDEX'>0)
  1.  .S BCMNTS=BCMNTS_$G(OUT(90001.32,TMPLTIEN_",",2,INDEX))_"~"
  1.  .S INDEX=$O(OUT(90001.32,TMPLTIEN_",",2,INDEX))
  1.  S BCMNTS=$E(BCMNTS,1,$L(BCMNTS)-1)
  1.  S VREFSNOMED=$G(OUT(90001.32,TMPLTIEN_",",1303,"I"))
  1.  S RSLT="~`"_TYPE_"^"_INOROUT_"^"_ICDCAT_"^"_CPTCAT_"^"_PURPOSE_"^"_PRIORITY_"^"_TYPEEXT_"^"_FCLTYRFT_"^"_VISITS_"^"_NOTESCHD_"^"_HXCMNTS_"^"_$G(BCMNTS)_"^"_$G(OTHERTYPE)_"^"_$G(OTHERTYPETEXT)_"^"_$G(VREFSNOMED)
  1.  Q RSLT
  1. ADDC32LG(RSLT,REFIEN,USERIEN,RRINTDT) ;;Add log entry for C32 print in 600 (C32 PRINTED) multiple of 90001(RCIS REFERRAL) file
  1.  I '$D(REFIEN) S RSLT="~`0^Referral IEN is not present" Q RSLT
  1.  N FDA,FDAIEN,ERR1
  1.  I '$D(USERIEN) S USERIEN=DUZ
  1.  I USERIEN="" S USERIEN=DUZ
  1.  I 'USERIEN S RSLT="~`0^USERIEN(DUZ) is not present" Q RSLT
  1.  I $D(RRINTDT) D DT^DILF("RS",RRINTDT,.RRINTDT,,"") I RRINTDT="-1" S RSLT="~`0^Date/Time format is MM/DD/YYYY@HHMM" Q RSLT
  1.  D NOW^%DTC
  1.  I (('$D(RRINTDT))!(RRINTDT="")!(RRINTDT>%)) S RRINTDT=%  ;;if date/time not provided, assume current date/time
  1.  S FDA(90001.6,"+1,"_REFIEN_",",.01)=RRINTDT
  1.  S FDA(90001.6,"+1,"_REFIEN_",",.02)=USERIEN
  1.  D UPDATE^DIE("","FDA","FDAIEN","ERR1")
  1.  I $D(ERR1("DIERR")) S RSLT="~`0^Error adding C32 printed log: "_$G(ERR1("DIERR","1","TEXT",1)) Q RSLT
  1.  S RSLT="~`1^"_FDAIEN(1) Q RSLT
  1.  Q
  1. SENDALRT(BMCRIEN)  ;;EP-ALERT FOR PHYS
  1.  ;GDIT/HS/BEE 10/19/17 - p12 - Address XINDEX/SAC issues
  1.  NEW BMCRHDR,XQADATA
  1.  Q:$G(BMCRIEN)=""
  1.  S BMCDFN=$$GET1^DIQ(90001,BMCRIEN_",",.03,"I")
  1.  S:$G(BMCDFN) BMCREC("PAT NAME")=$P(^DPT(BMCDFN,0),U)
  1.  N XQA
  1.  S BMCRHDR="New"
  1.  S XQADATA=BMCRIEN
  1.  I ($P($G(^BMCPARM(DUZ(2),4100)),U,9)="Y")!($P($G(^BMCPARM(DUZ(2),4100)),U,10)="Y") D PALRT1^BMCALERT
  1.  Q
  1. SENDXM(BMCRIEN,BMCMODE)  ;;Send mailman message for add/update referral
  1.  ;GDIT/HS/BEE 10/19/17 - p12 - Address XINDEX/SAC issues
  1.  NEW BMCGRP,BMCGRP1,BMCGRPS,I
  1.  S BMCDFN=$$GET1^DIQ(90001,BMCRIEN_",",.03,"I"),BMCRDATE=$$GET1^DIQ(90001,BMCRIEN_",",.01,"I")
  1.  S:$G(BMCDFN) BMCREC("PAT NAME")=$P(^DPT(BMCDFN,0),U)
  1.  S BMCREC("REF DATE")=$$GET1^DIQ(90001,BMCRIEN_",",.01,"E"),BMCRNUMB=$$GET1^DIQ(90001,BMCRIEN_",",.02,"E"),BMCDTYPE=15
  1.  I BMCMODE="A" D
  1.  .I $D(^BMCMSG("C",BMCRIEN)) K BMCRIEN,BMCDFN,BMCRDATE,BMCMODE,BMCREC,BMCRNUMB,BMCDTYPE Q
  1.  .S BMCGRP="BMC",Y=0
  1.  .F  S BMCGRP=$O(^XMB(3.8,"B",BMCGRP)) Q:$E(BMCGRP,1,3)'="BMC"  D
  1.  ..S BMCGRP1=0 S BMCGRP1=$O(^XMB(3.8,"B",BMCGRP,BMCGRP1))
  1.  ..S Y=Y+1,BMCGRP(Y)=BMCGRP_U_BMCGRP1
  1.  .K XMB,XMY
  1.  .F I=1:1 Q:$P(Y,",",I)'?1N.N  S XMY("G."_$P(BMCGRP($P(Y,",",I)),U))="",BMCGRPS($P(BMCGRP($P(Y,",",I)),U,2))=""
  1.  .D MSGGRP^BMCMM
  1.  I BMCMODE="M" D
  1.  .D MPER^BMCMM,MSGPRV^BMCMM
  1.  D SND^BMCMM
  1.  D EXT^BMCMM
  1.  K BMCRIEN,BMCDFN,BMCRDATE,BMCMODE,BMCREC,BMCRNUMB,BMCDTYPE
  1.  Q
  1. STATIC(PATIEN,REFIEN) ;;EP - STORE STATIC DATA OF REFERRAL
  1.  N BMCREC,Y,%
  1.  S BMCREC=^BMCREF(REFIEN,0)
  1.  S Y=^DPT(PATIEN,0)
  1.  S DR="5101///"_$P(Y,U) ; name
  1.  S DR=DR_";5103///"_$P(Y,U,3) ;dob
  1.  S DR=DR_";5104///"_$P(Y,U,9) ;ssn
  1.  S DR=DR_";5107///"_$P(Y,U,2) ;sex
  1.  S %=$P(BMCREC,U,5)
  1.  I % D
  1.  .S DR=DR_";5102///"_$P($G(^AUPNPAT(PATIEN,41,%,0)),U,2) ;chart #
  1.  .S DR=DR_";5113///"_$P($G(^DIC(4,%,0)),U) ;facility
  1.  .S DR=DR_";5114///"_$P($G(^AUTTLOC(%,0)),U,10) ;asufac
  1.  S Y=$G(^AUPNPAT(PATIEN,51))
  1.  I $P(Y,U,18)'="" S DR=DR_";5105///"_$P(Y,U,18) ;comm
  1.  I $P(Y,U,8) S DR=DR_";5106///"_$P($G(^AUTTTRI($P(Y,U,8),0)),U,2) ;tribe
  1.  S %=$P(BMCREC,U,7)
  1.  I % D
  1.  .S DR=DR_";5108///"_$P($G(^AUTTVNDR(%,0)),U) ;vendor
  1.  .S DR=DR_";5109///"_$P($G(^AUTTVNDR(%,51)),U)  ;ein
  1.  S %=$P(BMCREC,U)
  1.  S DR=DR_";5110///"_$$MCR^AUPNPAT(PATIEN,%)  ;medicare
  1.  S DR=DR_";5111///"_$$MCD^AUPNPAT(PATIEN,%) ;medicaid
  1.  S DR=DR_";5112///"_$$PI^AUPNPAT(PATIEN,%) ;private insurance
  1.  S DIE="^BMCREF(",DA=REFIEN
  1.  D DIE^BMCFMC
  1.  K DA,DIE,DR
  1.  Q
  1. SETMEDHX(RSLT,CMNTSX,PATIEN,REFIEN,TYPE)  ;;Add Medical History comments into RCIS COMMENTS file
  1.  ;S BMCDFN=PATIEN,BMCRIEN=REFIEN,BMCCTYP=$G(TYPE)
  1.  ;D COMMENTS^BMCADD1
  1.  I (('$D(REFIEN))!('$D(PATIEN))!('$D(CMNTSX))) S RSLT="~`0^Required data not provided" Q RSLT
  1.  N INDEX,FDA,FDAIENP,ERR1,WP,ERR2,RET
  1.  S INDEX=1
  1.  S FDA(90001.03,"+1,",.01)=DT
  1.  S FDA(90001.03,"+1,",.02)=PATIEN
  1.  S FDA(90001.03,"+1,",.03)=REFIEN
  1.  S FDA(90001.03,"+1,",.04)=DUZ
  1.  S FDA(90001.03,"+1,",.05)=$G(TYPE)
  1.  D UPDATE^DIE("","FDA","FDAIENP","ERR1")
  1.  I $D(ERR1("DIERR")) S RSLT="~`0^Error adding Med Hx/Business Comments: "_$G(ERR1("DIERR","1","TEXT",1)) Q RSLT
  1.  ;I $P(CMNTSX,"~",INDEX)'="" F  D  Q:($P(CMNTSX,"~",INDEX)="")
  1.  ;.;S WP(INDEX)=$P(CMNTSX,"~",INDEX)
  1.  ;.;S INDEX=INDEX+1 
  1.  ;I (($D(WP))&(FDAIENP(1)>0)) D WP^DIE(90001.03,FDAIENP(1)_",",1,"","WP","ERR2")
  1.  ;I $D(ERR2("DIERR")) N FDAK S FDAK(90001.03,FDAIENP(1)_",",.01)="@" D UPDATE^DIE("","FDAK","FDAIENP","ERR1") S RSLT="~`0^Error adding Med Hx/Business Comments text: "_$G(ERR2("DIERR","1","TEXT",1)) Q RSLT
  1.  I (($D(CMNTSX))&(FDAIENP(1)>0)) S RET=$$SETWP^BMCRPC5(90001.03,1,FDAIENP(1),CMNTSX,1,0)
  1.  I $G(RET)'=1 S RSLT="~`0^Error adding Med Hx/Business Comments text: "_$G(RET) Q RSLT
  1.  S RSLT="~`1^"_FDAIENP(1)
  1.  Q RSLT
  1.  ;
  1. GTREFTYP(RSLT) ;;Get Purpose Of Referrals
  1.  ;BMC GET PURPOSE OF REF API
  1.  ;D GTREFTYP^BMCRPC3(.R) ZW @R
  1.  K ^TMP($J,"REFPURPOSE")
  1.  ;GDIT/HS/BEE 10/19/17 - p12 CR#8528: Reworked next section of code to sort results
  1.  ;N OUT,INDEX
  1.  ;S OUT="VAR"
  1.  ;D SUBLST^BSTSAPI(OUT,"EHR REFERRAL TYPE^^1")
  1.  ;S INDEX=$O(VAR(""))
  1.  ;I +INDEX>0 F  D  Q:(+INDEX'>0)
  1.  ;.S ^TMP($J,"REFPURPOSE",1)=$G(^TMP($J,"REFPURPOSE",1))_$G(VAR(INDEX))_"~"
  1.  ;.S INDEX=$O(VAR(INDEX)) 
  1.  N INDEX,VAR,TMP,ND,TRM
  1.  D SUBLST^BSTSAPI("VAR","EHR REFERRAL TYPE^^1")
  1.  S INDEX="" F  S INDEX=$O(VAR(INDEX)) Q:'INDEX  S ND=$G(VAR(INDEX)),TRM=$P(ND,U,3) I TRM]"" S TMP(TRM)=ND
  1.  S (INDEX,TMP)="" F  S INDEX=$O(TMP(INDEX)) Q:INDEX=""  S TMP=TMP_$S(TMP]"":"~",1:"")_TMP(INDEX)
  1.  I TMP]"" S ^TMP($J,"REFPURPOSE",1)=TMP
  1.  ;End of CR#8528 Changes
  1.  S ^TMP($J,"REFPURPOSE",2)=""
  1.  S RSLT=$NA(^TMP($J,"REFPURPOSE"))
  1.  Q
  1. UPDTSTRF(RSLT,REFIEN,STATUS) ;;Update Status Of Referral against Ref IEN return 0 or 1
  1.  ; Not in Use
  1.  ;TUS)  ADTLINFO=0 ;;ADDITIONAL INFO flag
  1.  I '$D(REFIEN) S RSLT="~`0^Referral Ien is not provided" Q RSLT
  1.  I '$D(STATUS) S RSLT="~`0^Referral Status is not provided" Q RSLT
  1.  I REFIEN'>0 S RSLT="~`0^Referral Ien is not provided" Q RSLT
  1.  S FDA(90001,REFIEN_",",.15)=$G(STATUS)
  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.  ;D SENDXM^BMCRPC3(REFIEN,"M") ;;Send mailman message
  1.  S RSLT="1"
  1.  Q
  1.  ;
  1. UPCNRINF(RSLT,REFIEN,CONSULTBY,CONSULTDT,CONSULTSTATUS) ;;Updates new Multiple Consulted By
  1.  ; S REFIEN="113248"
  1.  ; S CONSULTBY="3039"
  1.  ; GDIT/HS/BEE 05/08/2018 - BMC*4.0*13 - Time is passed in and required
  1.  ; OLD: S CONSULTDT="8/12/2013"
  1.  ; S CONSULTDT="8/12/2013@10:30"
  1.  ; S CONSULTSTATUS="R"
  1.  ; D UPCNRINF^BMCRPC3(.R,REFIEN,CONSULTBY,CONSULTDT,CONSULTSTATUS) W R
  1.  ; S ^TMP("FAR",12)=$G(REFIEN)_"^"_$G(CONSULTBY)_"^"_$G(CONSULTDT)_"^"_$G(CONSULTSTATUS)
  1.  N OUT,FDA,ERR1,PATIEN,ADTLINFO,MSG
  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.  I $$GET1^DIQ(90001,REFIEN_",",1308,"")'=""  D
  1.  . I $$GET1^DIQ(90001,REFIEN_",",1307,"")'=""  D
  1.  . . I $$GET1^DIQ(90001,REFIEN_",",1306,"I")=$G(CONSULTSTATUS)  D
  1.  . . . S MSG=$$GET1^DIQ(90001,REFIEN_",",.03,"")_" has already been reviewed by "_$$GET1^DIQ(90001,REFIEN_",",1308,"")_" on "_$$GET1^DIQ(90001,REFIEN_",",1307,"")_"."
  1.  I $G(MSG)'="" S RSLT="~`1^"_$G(MSG) Q RSLT
  1.  ; GDIT/HS/BEE 05/08/2018 - BMC*4.0*13 - Time is passed in and required
  1.  ;D DT^DILF("",CONSULTDT,.CONSULTDT) I CONSULTDT="-1" S RSLT="~`0^Review Date is not in mm/dd/yyyy fromat" Q RSLT
  1.  D DT^DILF("RT",CONSULTDT,.CONSULTDT) I CONSULTDT="-1" S RSLT="~`0^Review Date is not in mm/dd/yyyy format" Q RSLT
  1.  S FDA(90001,REFIEN_",",1308)=$G(CONSULTBY)
  1.  S FDA(90001,REFIEN_",",1307)=$G(CONSULTDT)
  1.  S FDA(90001,REFIEN_",",1306)=$G(CONSULTSTATUS)
  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.  D CRENSCCT^BMCRPC3("",REFIEN,"371530004")
  1.  S RSLT="~`1^"
  1.  Q
  1.  ;
  1. CRENSCCT(RSLT,RRIEN,TERM) ; Create entry in 2300 (SNOMED CLOSED CLINICAL TERM) multiple of RCIS REFERRAL (90001) file
  1.  ; D CRENSCCT^BMCRPC3(.R,"113255","371530004") W @R
  1.  ; RRIEN = RCIS Feferral IEN
  1.  ; TERM = Free text
  1.  ; RSLT=IEN of entry created in  2300 (SNOMED CLOSED CLINICAL TERM) multiple
  1.  K FDA,FDAMSG,FDAIEN
  1.  N FDADA
  1.  ;
  1.  S FDA(42,90001.23,"+1,"_RRIEN_",",.01)=$G(TERM)
  1.  D UPDATE^DIE("","FDA(42)","FDAIEN","FDAMSG")
  1.  S FDADA=+$G(FDAIEN(1))
  1.  I $D(FDAMSG) D
  1.  . W !!,"The following error message was returned:",!!
  1.  . S FDAMSG="" F  S FDAMSG=$O(FDAMSG("DIERR",1,"TEXT",FDAMSG)) Q:FDAMSG=""  W FDAMSG("DIERR",1,"TEXT",FDAMSG),!
  1.  I $G(FDADA)=""  S RSLT=$G(FDAMSG) Q
  1.  S RSLT=$G(FDADA)
  1.  Q
  1.  ;
  1. CRENSCT(RSLT,RRIEN,TERM) ; Create entry in 2200 (SNOMED CLINICAL TERM) multiple of RCIS REFERRAL (90001) file
  1.  ; D CRENSCT^BMCRPC3(.R,"113255","371530004") W @R
  1.  ; RRIEN = RCIS Feferral IEN
  1.  ; TERM = Free text
  1.  ; RSLT=IEN of entry created in  2200 (SNOMED CLINICAL TERM) multiple
  1.  K FDA,FDAMSG,FDAIEN
  1.  N FDADA
  1.  ;
  1.  S FDA(42,90001.22,"+1,"_RRIEN_",",.01)=$G(TERM)
  1.  D UPDATE^DIE("","FDA(42)","FDAIEN","FDAMSG")
  1.  S FDADA=+$G(FDAIEN(1))
  1.  I $D(FDAMSG) D
  1.  . W !!,"The following error message was returned:",!!
  1.  . S FDAMSG="" F  S FDAMSG=$O(FDAMSG("DIERR",1,"TEXT",FDAMSG)) Q:FDAMSG=""  W FDAMSG("DIERR",1,"TEXT",FDAMSG),!
  1.  I $G(FDADA)=""  S RSLT=$G(FDAMSG) Q
  1.  S RSLT=$G(FDADA)
  1.  Q
  1.  ;