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

BMCAPIS.m

Go to the documentation of this file. 
  1. BMCAPIS ; IHS/CAS/FS - REFERRED CARE INFO SYSTEM API FOR MU2 ;     
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**8**;JAN 09, 2006;Build 101
  1.  ;4.0*8 IHS/ITSC/FS NEW ROUTINE 
  1.  ; RPC code for RCIS GUI Application
  1.  ; Routines contains code for Reading data from RCIS REFERRAL, V REFERRAL, VENDOR and VISIT files
  1.  ;
  1. GETREFFV(RSLT,VISITS) ; search referral w.r.t Visit
  1.  ;Input parameter is array as per following format
  1.  ;S VISITS(1)="3707743"
  1.  ;S VISITS(2)="3601325"
  1.  ;D GETREFFV^BMCAPIS(.R,.VISITS) ZW @R
  1.  ;S RSLT="VISIT^RCIS REFERRAL IEN^PATIENT IEN^RCIS REFERRAL PURPOSE^RCIS REFERRAL STATUS^RCIS REFERRAL#^VENDOR FAX^VENDOR EMAIL PARTICIPANT YES NO^VENDOR EMAIL ADDRESS^VENDOR NAME" Q
  1.  K BMCOUT,BMCMSG,SCR,KBTOUT,^TMP("BMCDATA",$J)
  1.  N INDX,INDEX,VREFIEN,RREFIEN,VPATIEN,RRPURPOSE,RRSTATUS,RRVNDRIEN,VNDFAX,VNDPARYN,VNDEMAIL,RRVNDRNM
  1.  I $D(VISITS)  D
  1.  . N INDX,U
  1.  . S INDX=$O(VISITS(""))
  1.  . I +INDX>0 F  D  Q:(+INDX'>0)
  1.  . . S VISIT=$G(VISITS(INDX))
  1.  . . S SCR="I $P($G("_"^"_"(0)),""^"",3)=$G(VISIT)"
  1.  . . D LIST^DIC(9000010.59,"","@;.01I;.02I;.06I","","*","","","B",SCR,"","BMCOUT","BMCMSG")
  1.  . . S INDEX=$O(BMCOUT("DILIST","ID",0))
  1.  . . I +INDEX>0 F  D  Q:(+INDEX'>0)
  1.  . . . S VREFIEN=$G(BMCOUT("DILIST",2,INDEX))
  1.  . . . S RREFIEN=$G(BMCOUT("DILIST","ID",INDEX,.06))
  1.  . . . S VPATIEN=$G(BMCOUT("DILIST","ID",INDEX,.02))
  1.  . . . ;Moving into RCIS REFERRAL file
  1.  . . . I $G(RREFIEN)'=""  D
  1.  . . . . S RRPURPOSE=$$GET1^DIQ(90001,RREFIEN_",",1201)
  1.  . . . . S RRSTATUS=$$GET1^DIQ(90001,RREFIEN_",",.15)
  1.  . . . . S RRVNDRIEN=$$GET1^DIQ(90001,RREFIEN_",",.07,"I")
  1.  . . . . S RRNUMBER=$$GET1^DIQ(90001,RREFIEN_",",.02)
  1.  . . . . ;Moving into VENDOR file to get data from 1114(FAX), 2104 (DIRECT PARTICIPANT) and 2105 (DIRECT EMAIL ADDRESS)
  1.  . . . . I $G(RRVNDRIEN)'=""  D
  1.  . . . . . S RRVNDRNM=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",.01)
  1.  . . . . . S VNDFAX=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",1114)
  1.  . . . . . S VNDPARYN=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",2104)
  1.  . . . . . S VNDEMAIL=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",2105)
  1.  . . . S ^TMP("BMCDATA",$J,INDX,INDEX)=$G(VISIT)_"^"_$G(RREFIEN)_"^"_$G(VPATIEN)_"^"_$G(RRPURPOSE)_"^"_$G(RRSTATUS)_"^"_$G(RRNUMBER)_"^"_$G(VNDFAX)_"^"_$G(VNDPARYN)_"^"_$G(VNDEMAIL)_"^"_$G(RRVNDRNM)
  1.  . . . S VREFIEN="",RREFIEN="",VPATIEN="",RRPURPOSE="",RRSTATUS="",RRVNDRIEN="",VNDFAX="",VNDPARYN="",VNDEMAIL="",RRVNDRNM=""
  1.  . . . S INDEX=$O(BMCOUT("DILIST","ID",INDEX))
  1.  . . S INDX=$O(VISITS(INDX))
  1.  S RSLT=$NA(^TMP("BMCDATA",$J))
  1.  Q
  1.  ;
  1. CRENTOCD(RSLT,RRIEN,PRTXDATE,PRTXBY,DOCTYPE,CCDADOCID) ; Create entry in 600 (TRANSITION OF CARE DOCUMENT) multiple of RCIS REFERRAL (90001) file
  1.  ; D CRENTOCD^BMCAPIS(.R,"4","JAN 11, 2013","4","C32","Done") W @R
  1.  ; RRIEN = RCIS Feferral IEN
  1.  ; PRTXDATE = DATE TIME PRINTED OR TRANSMITTED FILE for example May 16, 2013
  1.  ; PRTXBY = PRINTED-TRANSMITTED BY (IEN of NEW PERSON (200) File)
  1.  ; DOCTYPE = Accept Set Of Code Internal Format only C32, CP or CT
  1.  ; CCDADOCID = Free text
  1.  ; RSLT=IEN of entry created in 600 (TRANSITION OF CARE DOCUMENT) multiple
  1.  K FDA,FDAMSG,FDAIEN
  1.  N FDADA
  1.  ;
  1.  S FDA(42,90001.6,"+1,"_RRIEN_",",.01)=$$X2FM($G(PRTXDATE))
  1.  S FDA(42,90001.6,"+1,"_RRIEN_",",.02)=$G(PRTXBY)
  1.  S FDA(42,90001.6,"+1,"_RRIEN_",",.04)=$G(DOCTYPE)
  1.  S FDA(42,90001.6,"+1,"_RRIEN_",",.05)=$G(CCDADOCID)
  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. X2FM(X)       ; return FM date given relative date
  1.  N %DT S %DT="TS" D ^%DT
  1.  Q Y
  1.  ;
  1. CRENVREF(RSLT,SNOMEDCT,SNOMEDPT,PATIENT,VISIT,PROBLEM,RREFIEN,EVENTDT,OPROVIDER,CLINIC,ENCPROVIDER,PARENT,OUTSIDEPROV,ORDERINGLOC,ENTEREDBY) ;Create Entry in V Referral
  1.  ; D CRENTOCD^BMCAPIS(.R,"4","JAN 11, 2013","4","C32","Done") W @R
  1.  ; RRIEN = RCIS Feferral IEN
  1.  ; PRTXDATE = DATE TIME PRINTED OR TRANSMITTED FILE for example May 16, 2013
  1.  ; PRTXBY = PRINTED-TRANSMITTED BY (IEN of NEW PERSON (200) File)
  1.  ; DOCTYPE = Accept Set Of Code Internal Format only C32, CP or CT
  1.  ; CCDADOCID = Free text
  1.  ; RSLT=IEN of entry created in 600 (TRANSITION OF CARE DOCUMENT) multiple
  1.  K FDA,FDAMSG,FDAIEN
  1.  N FDADA
  1.  ;
  1.  S FDA(9000010.59,"+1,",.01)=$G(SNOMEDCT)
  1.  S FDA(9000010.59,"+1,",.02)=$G(PATIENT)
  1.  S FDA(9000010.59,"+1,",.03)=$G(VISIT)
  1.  S FDA(9000010.59,"+1,",.04)=$G(PROBLEM)
  1.  S FDA(9000010.59,"+1,",.06)=$G(RREFIEN)
  1.  S FDA(9000010.59,"+1,",1201)=$$X2FM($G(EVENTDT))
  1.  S FDA(9000010.59,"+1,",1202)=$G(OPROVIDER)
  1.  S FDA(9000010.59,"+1,",1203)=$G(CLINIC)
  1.  S FDA(9000010.59,"+1,",1204)=$G(ENCPROVIDER)
  1.  S FDA(9000010.59,"+1,",1208)=$G(PARENT)
  1.  S FDA(9000010.59,"+1,",1210)=$G(OUTSIDEPROV)
  1.  S FDA(9000010.59,"+1,",1215)=$G(ORDERINGLOC)
  1.  S %H=$H,%H=$S($P(%H,",",2):%H,1:%H-1)
  1.  S FDA(9000010.59,"+1,",1216)=$G(%)
  1.  S FDA(9000010.59,"+1,",1217)=$G(ENTEREDBY)
  1.  D UPDATE^DIE("","FDA","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.  ;