BMCAPIS ; IHS/CAS/FS - REFERRED CARE INFO SYSTEM API FOR MU2 ;
;;4.0;REFERRED CARE INFO SYSTEM;**8**;JAN 09, 2006;Build 101
;4.0*8 IHS/ITSC/FS NEW ROUTINE
; RPC code for RCIS GUI Application
; Routines contains code for Reading data from RCIS REFERRAL, V REFERRAL, VENDOR and VISIT files
;
GETREFFV(RSLT,VISITS) ; search referral w.r.t Visit
;Input parameter is array as per following format
;S VISITS(1)="3707743"
;S VISITS(2)="3601325"
;D GETREFFV^BMCAPIS(.R,.VISITS) ZW @R
;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
K BMCOUT,BMCMSG,SCR,KBTOUT,^TMP("BMCDATA",$J)
N INDX,INDEX,VREFIEN,RREFIEN,VPATIEN,RRPURPOSE,RRSTATUS,RRVNDRIEN,VNDFAX,VNDPARYN,VNDEMAIL,RRVNDRNM
I $D(VISITS) D
. N INDX,U
. S INDX=$O(VISITS(""))
. I +INDX>0 F D Q:(+INDX'>0)
. . S VISIT=$G(VISITS(INDX))
. . S SCR="I $P($G("_"^"_"(0)),""^"",3)=$G(VISIT)"
. . D LIST^DIC(9000010.59,"","@;.01I;.02I;.06I","","*","","","B",SCR,"","BMCOUT","BMCMSG")
. . S INDEX=$O(BMCOUT("DILIST","ID",0))
. . I +INDEX>0 F D Q:(+INDEX'>0)
. . . S VREFIEN=$G(BMCOUT("DILIST",2,INDEX))
. . . S RREFIEN=$G(BMCOUT("DILIST","ID",INDEX,.06))
. . . S VPATIEN=$G(BMCOUT("DILIST","ID",INDEX,.02))
. . . ;Moving into RCIS REFERRAL file
. . . I $G(RREFIEN)'="" D
. . . . S RRPURPOSE=$$GET1^DIQ(90001,RREFIEN_",",1201)
. . . . S RRSTATUS=$$GET1^DIQ(90001,RREFIEN_",",.15)
. . . . S RRVNDRIEN=$$GET1^DIQ(90001,RREFIEN_",",.07,"I")
. . . . S RRNUMBER=$$GET1^DIQ(90001,RREFIEN_",",.02)
. . . . ;Moving into VENDOR file to get data from 1114(FAX), 2104 (DIRECT PARTICIPANT) and 2105 (DIRECT EMAIL ADDRESS)
. . . . I $G(RRVNDRIEN)'="" D
. . . . . S RRVNDRNM=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",.01)
. . . . . S VNDFAX=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",1114)
. . . . . S VNDPARYN=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",2104)
. . . . . S VNDEMAIL=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",2105)
. . . 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)
. . . S VREFIEN="",RREFIEN="",VPATIEN="",RRPURPOSE="",RRSTATUS="",RRVNDRIEN="",VNDFAX="",VNDPARYN="",VNDEMAIL="",RRVNDRNM=""
. . . S INDEX=$O(BMCOUT("DILIST","ID",INDEX))
. . S INDX=$O(VISITS(INDX))
S RSLT=$NA(^TMP("BMCDATA",$J))
Q
;
CRENTOCD(RSLT,RRIEN,PRTXDATE,PRTXBY,DOCTYPE,CCDADOCID) ; Create entry in 600 (TRANSITION OF CARE DOCUMENT) multiple of RCIS REFERRAL (90001) file
; D CRENTOCD^BMCAPIS(.R,"4","JAN 11, 2013","4","C32","Done") W @R
; RRIEN = RCIS Feferral IEN
; PRTXDATE = DATE TIME PRINTED OR TRANSMITTED FILE for example May 16, 2013
; PRTXBY = PRINTED-TRANSMITTED BY (IEN of NEW PERSON (200) File)
; DOCTYPE = Accept Set Of Code Internal Format only C32, CP or CT
; CCDADOCID = Free text
; RSLT=IEN of entry created in 600 (TRANSITION OF CARE DOCUMENT) multiple
K FDA,FDAMSG,FDAIEN
N FDADA
;
S FDA(42,90001.6,"+1,"_RRIEN_",",.01)=$$X2FM($G(PRTXDATE))
S FDA(42,90001.6,"+1,"_RRIEN_",",.02)=$G(PRTXBY)
S FDA(42,90001.6,"+1,"_RRIEN_",",.04)=$G(DOCTYPE)
S FDA(42,90001.6,"+1,"_RRIEN_",",.05)=$G(CCDADOCID)
D UPDATE^DIE("","FDA(42)","FDAIEN","FDAMSG")
S FDADA=+$G(FDAIEN(1))
I $D(FDAMSG) D
. W !!,"The following error message was returned:",!!
. S FDAMSG="" F S FDAMSG=$O(FDAMSG("DIERR",1,"TEXT",FDAMSG)) Q:FDAMSG="" W FDAMSG("DIERR",1,"TEXT",FDAMSG),!
I $G(FDADA)="" S RSLT=$G(FDAMSG) Q
S RSLT=$G(FDADA)
Q
;
X2FM(X) ; return FM date given relative date
N %DT S %DT="TS" D ^%DT
Q Y
;
CRENVREF(RSLT,SNOMEDCT,SNOMEDPT,PATIENT,VISIT,PROBLEM,RREFIEN,EVENTDT,OPROVIDER,CLINIC,ENCPROVIDER,PARENT,OUTSIDEPROV,ORDERINGLOC,ENTEREDBY) ;Create Entry in V Referral
; D CRENTOCD^BMCAPIS(.R,"4","JAN 11, 2013","4","C32","Done") W @R
; RRIEN = RCIS Feferral IEN
; PRTXDATE = DATE TIME PRINTED OR TRANSMITTED FILE for example May 16, 2013
; PRTXBY = PRINTED-TRANSMITTED BY (IEN of NEW PERSON (200) File)
; DOCTYPE = Accept Set Of Code Internal Format only C32, CP or CT
; CCDADOCID = Free text
; RSLT=IEN of entry created in 600 (TRANSITION OF CARE DOCUMENT) multiple
K FDA,FDAMSG,FDAIEN
N FDADA
;
S FDA(9000010.59,"+1,",.01)=$G(SNOMEDCT)
S FDA(9000010.59,"+1,",.02)=$G(PATIENT)
S FDA(9000010.59,"+1,",.03)=$G(VISIT)
S FDA(9000010.59,"+1,",.04)=$G(PROBLEM)
S FDA(9000010.59,"+1,",.06)=$G(RREFIEN)
S FDA(9000010.59,"+1,",1201)=$$X2FM($G(EVENTDT))
S FDA(9000010.59,"+1,",1202)=$G(OPROVIDER)
S FDA(9000010.59,"+1,",1203)=$G(CLINIC)
S FDA(9000010.59,"+1,",1204)=$G(ENCPROVIDER)
S FDA(9000010.59,"+1,",1208)=$G(PARENT)
S FDA(9000010.59,"+1,",1210)=$G(OUTSIDEPROV)
S FDA(9000010.59,"+1,",1215)=$G(ORDERINGLOC)
S %H=$H,%H=$S($P(%H,",",2):%H,1:%H-1)
S FDA(9000010.59,"+1,",1216)=$G(%)
S FDA(9000010.59,"+1,",1217)=$G(ENTEREDBY)
D UPDATE^DIE("","FDA","FDAIEN","FDAMSG")
S FDADA=+$G(FDAIEN(1))
I $D(FDAMSG) D
. W !!,"The following error message was returned:",!!
. S FDAMSG="" F S FDAMSG=$O(FDAMSG("DIERR",1,"TEXT",FDAMSG)) Q:FDAMSG="" W FDAMSG("DIERR",1,"TEXT",FDAMSG),!
I $G(FDADA)="" S RSLT=$G(FDAMSG) Q
S RSLT=$G(FDADA)
Q
;
BMCAPIS ; IHS/CAS/FS - REFERRED CARE INFO SYSTEM API FOR MU2 ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**8**;JAN 09, 2006;Build 101
+2 ;4.0*8 IHS/ITSC/FS NEW ROUTINE
+3 ; RPC code for RCIS GUI Application
+4 ; Routines contains code for Reading data from RCIS REFERRAL, V REFERRAL, VENDOR and VISIT files
+5 ;
GETREFFV(RSLT,VISITS) ; search referral w.r.t Visit
+1 ;Input parameter is array as per following format
+2 ;S VISITS(1)="3707743"
+3 ;S VISITS(2)="3601325"
+4 ;D GETREFFV^BMCAPIS(.R,.VISITS) ZW @R
+5 ;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
+6 KILL BMCOUT,BMCMSG,SCR,KBTOUT,^TMP("BMCDATA",$JOB)
+7 NEW INDX,INDEX,VREFIEN,RREFIEN,VPATIEN,RRPURPOSE,RRSTATUS,RRVNDRIEN,VNDFAX,VNDPARYN,VNDEMAIL,RRVNDRNM
+8 IF $DATA(VISITS)
Begin DoDot:1
+9 NEW INDX,U
+10 SET INDX=$ORDER(VISITS(""))
+11 IF +INDX>0
FOR
Begin DoDot:2
+12 SET VISIT=$GET(VISITS(INDX))
+13 SET SCR="I $P($G("_"^"_"(0)),""^"",3)=$G(VISIT)"
+14 DO LIST^DIC(9000010.59,"","@;.01I;.02I;.06I","","*","","","B",SCR,"","BMCOUT","BMCMSG")
+15 SET INDEX=$ORDER(BMCOUT("DILIST","ID",0))
+16 IF +INDEX>0
FOR
Begin DoDot:3
+17 SET VREFIEN=$GET(BMCOUT("DILIST",2,INDEX))
+18 SET RREFIEN=$GET(BMCOUT("DILIST","ID",INDEX,.06))
+19 SET VPATIEN=$GET(BMCOUT("DILIST","ID",INDEX,.02))
+20 ;Moving into RCIS REFERRAL file
+21 IF $GET(RREFIEN)'=""
Begin DoDot:4
+22 SET RRPURPOSE=$$GET1^DIQ(90001,RREFIEN_",",1201)
+23 SET RRSTATUS=$$GET1^DIQ(90001,RREFIEN_",",.15)
+24 SET RRVNDRIEN=$$GET1^DIQ(90001,RREFIEN_",",.07,"I")
+25 SET RRNUMBER=$$GET1^DIQ(90001,RREFIEN_",",.02)
+26 ;Moving into VENDOR file to get data from 1114(FAX), 2104 (DIRECT PARTICIPANT) and 2105 (DIRECT EMAIL ADDRESS)
+27 IF $GET(RRVNDRIEN)'=""
Begin DoDot:5
+28 SET RRVNDRNM=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",.01)
+29 SET VNDFAX=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",1114)
+30 SET VNDPARYN=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",2104)
+31 SET VNDEMAIL=$$GET1^DIQ(9999999.11,RRVNDRIEN_",",2105)
End DoDot:5
End DoDot:4
+32 SET ^TMP("BMCDATA",$JOB,INDX,INDEX)=$GET(VISIT)_"^"_$GET(RREFIEN)_"^"_$GET(VPATIEN)_"^"_$GET(RRPURPOSE)_"^"_$GET(RRSTATUS)_"^"_$GET(RRNUMBER)_"^"_$GET(VNDFAX)_"^"_$GET(VNDPARYN)_"^"_$GET(VNDEMAIL)_"^"_$GET(RRVNDR
NM)
+33 SET VREFIEN=""
SET RREFIEN=""
SET VPATIEN=""
SET RRPURPOSE=""
SET RRSTATUS=""
SET RRVNDRIEN=""
SET VNDFAX=""
SET VNDPARYN=""
SET VNDEMAIL=""
SET RRVNDRNM=""
+34 SET INDEX=$ORDER(BMCOUT("DILIST","ID",INDEX))
End DoDot:3
IF (+INDEX'>0)
QUIT
+35 SET INDX=$ORDER(VISITS(INDX))
End DoDot:2
IF (+INDX'>0)
QUIT
End DoDot:1
+36 SET RSLT=$NAME(^TMP("BMCDATA",$JOB))
+37 QUIT
+38 ;
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
+2 ; RRIEN = RCIS Feferral IEN
+3 ; PRTXDATE = DATE TIME PRINTED OR TRANSMITTED FILE for example May 16, 2013
+4 ; PRTXBY = PRINTED-TRANSMITTED BY (IEN of NEW PERSON (200) File)
+5 ; DOCTYPE = Accept Set Of Code Internal Format only C32, CP or CT
+6 ; CCDADOCID = Free text
+7 ; RSLT=IEN of entry created in 600 (TRANSITION OF CARE DOCUMENT) multiple
+8 KILL FDA,FDAMSG,FDAIEN
+9 NEW FDADA
+10 ;
+11 SET FDA(42,90001.6,"+1,"_RRIEN_",",.01)=$$X2FM($GET(PRTXDATE))
+12 SET FDA(42,90001.6,"+1,"_RRIEN_",",.02)=$GET(PRTXBY)
+13 SET FDA(42,90001.6,"+1,"_RRIEN_",",.04)=$GET(DOCTYPE)
+14 SET FDA(42,90001.6,"+1,"_RRIEN_",",.05)=$GET(CCDADOCID)
+15 DO UPDATE^DIE("","FDA(42)","FDAIEN","FDAMSG")
+16 SET FDADA=+$GET(FDAIEN(1))
+17 IF $DATA(FDAMSG)
Begin DoDot:1
+18 WRITE !!,"The following error message was returned:",!!
+19 SET FDAMSG=""
FOR
SET FDAMSG=$ORDER(FDAMSG("DIERR",1,"TEXT",FDAMSG))
IF FDAMSG=""
QUIT
WRITE FDAMSG("DIERR",1,"TEXT",FDAMSG),!
End DoDot:1
+20 IF $GET(FDADA)=""
SET RSLT=$GET(FDAMSG)
QUIT
+21 SET RSLT=$GET(FDADA)
+22 QUIT
+23 ;
X2FM(X) ; return FM date given relative date
+1 NEW %DT
SET %DT="TS"
DO ^%DT
+2 QUIT Y
+3 ;
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
+2 ; RRIEN = RCIS Feferral IEN
+3 ; PRTXDATE = DATE TIME PRINTED OR TRANSMITTED FILE for example May 16, 2013
+4 ; PRTXBY = PRINTED-TRANSMITTED BY (IEN of NEW PERSON (200) File)
+5 ; DOCTYPE = Accept Set Of Code Internal Format only C32, CP or CT
+6 ; CCDADOCID = Free text
+7 ; RSLT=IEN of entry created in 600 (TRANSITION OF CARE DOCUMENT) multiple
+8 KILL FDA,FDAMSG,FDAIEN
+9 NEW FDADA
+10 ;
+11 SET FDA(9000010.59,"+1,",.01)=$GET(SNOMEDCT)
+12 SET FDA(9000010.59,"+1,",.02)=$GET(PATIENT)
+13 SET FDA(9000010.59,"+1,",.03)=$GET(VISIT)
+14 SET FDA(9000010.59,"+1,",.04)=$GET(PROBLEM)
+15 SET FDA(9000010.59,"+1,",.06)=$GET(RREFIEN)
+16 SET FDA(9000010.59,"+1,",1201)=$$X2FM($GET(EVENTDT))
+17 SET FDA(9000010.59,"+1,",1202)=$GET(OPROVIDER)
+18 SET FDA(9000010.59,"+1,",1203)=$GET(CLINIC)
+19 SET FDA(9000010.59,"+1,",1204)=$GET(ENCPROVIDER)
+20 SET FDA(9000010.59,"+1,",1208)=$GET(PARENT)
+21 SET FDA(9000010.59,"+1,",1210)=$GET(OUTSIDEPROV)
+22 SET FDA(9000010.59,"+1,",1215)=$GET(ORDERINGLOC)
+23 SET %H=$HOROLOG
SET %H=$SELECT($PIECE(%H,",",2):%H,1:%H-1)
+24 SET FDA(9000010.59,"+1,",1216)=$GET(%)
+25 SET FDA(9000010.59,"+1,",1217)=$GET(ENTEREDBY)
+26 DO UPDATE^DIE("","FDA","FDAIEN","FDAMSG")
+27 SET FDADA=+$GET(FDAIEN(1))
+28 IF $DATA(FDAMSG)
Begin DoDot:1
+29 WRITE !!,"The following error message was returned:",!!
+30 SET FDAMSG=""
FOR
SET FDAMSG=$ORDER(FDAMSG("DIERR",1,"TEXT",FDAMSG))
IF FDAMSG=""
QUIT
WRITE FDAMSG("DIERR",1,"TEXT",FDAMSG),!
End DoDot:1
+31 IF $GET(FDADA)=""
SET RSLT=$GET(FDAMSG)
QUIT
+32 SET RSLT=$GET(FDADA)
+33 QUIT
+34 ;
