BPMXEDR ;IHS/OIT/NKD - SEND EDR MESSAGE - 6/26/12 ;
;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
;;
DESC ;----- ROUTINE DESCRIPTION
;;BPMXEDR:
;;THIS ROUTINE CONTAINS SUBROUTINES TO SEND AN EDR MESSAGE
;;
;;THIS ROUTINE IS CALLED BY THE SPECIAL MERGE ROUTINE DRIVER - ^BPMXDRV
;;
;;THE IHS PATIENT MERGE SOFTWARE ENTERS AT EN LINE LABEL. IT IS EXPECTED
;;THAT THE FOLLOWING GLOBAL WOULD HAVE BEEN SET UP BY THE PATIENT MERGE
;;SOFTWARE:
;; ^TMP("XDRFROM",$J,FROMIEN,TOIEN,FROMIEN_GLOBROOT,TOIEN_GLOBROOT)=FILE
;;EXAMPLE:
;; ^TMP("XDRFROM",2804,6364,1991,"6364;DPT(","1991;DPT(")=2
;;WHERE =2 IS THE PARENT FILE (VA PATIENT FILE).
;;
;;$$END
;
N I,X F I=1:1 S X=$P($T(DESC+I),";;",2) Q:X["$$END" D EN^DDIOL(X)
Q
EN(BPMRY) ;EP
;----- MAIN ENTRY POINT FROM DUPLICATE PATIENT MERGE SOFTWARE
;
; BPMRY = TEMP GLOBAL SET UP BY THE PATIENT MERGE SOFTWARE,
; I.E., "^TMP(""XDRFROM"",$J)"
;
Q:'$$PATCH^XPDUTL("BPM*1.0*1")!'$$PATCH^XPDUTL("BADE*1.0*1")
;
N BPMFR,BPMTO
S BPMFR=$O(@BPMRY@(0))
Q:'BPMFR
S BPMTO=$O(@BPMRY@(BPMFR,0))
Q:'BPMTO
;
D PROC(BPMFR,BPMTO)
Q
PROC(BPMFR,BPMTO) ;
; SEND A40 MESSAGE
N ERR
;
D A40^BADEMRG(BPMFR,BPMTO)
;
Q
;
BPMXEDR ;IHS/OIT/NKD - SEND EDR MESSAGE - 6/26/12 ;
+1 ;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
+2 ;;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;BPMXEDR:
+2 ;;THIS ROUTINE CONTAINS SUBROUTINES TO SEND AN EDR MESSAGE
+3 ;;
+4 ;;THIS ROUTINE IS CALLED BY THE SPECIAL MERGE ROUTINE DRIVER - ^BPMXDRV
+5 ;;
+6 ;;THE IHS PATIENT MERGE SOFTWARE ENTERS AT EN LINE LABEL. IT IS EXPECTED
+7 ;;THAT THE FOLLOWING GLOBAL WOULD HAVE BEEN SET UP BY THE PATIENT MERGE
+8 ;;SOFTWARE:
+9 ;; ^TMP("XDRFROM",$J,FROMIEN,TOIEN,FROMIEN_GLOBROOT,TOIEN_GLOBROOT)=FILE
+10 ;;EXAMPLE:
+11 ;; ^TMP("XDRFROM",2804,6364,1991,"6364;DPT(","1991;DPT(")=2
+12 ;;WHERE =2 IS THE PARENT FILE (VA PATIENT FILE).
+13 ;;
+14 ;;$$END
+15 ;
+16 NEW I,X
FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";;",2)
IF X["$$END"
QUIT
DO EN^DDIOL(X)
+17 QUIT
EN(BPMRY) ;EP
+1 ;----- MAIN ENTRY POINT FROM DUPLICATE PATIENT MERGE SOFTWARE
+2 ;
+3 ; BPMRY = TEMP GLOBAL SET UP BY THE PATIENT MERGE SOFTWARE,
+4 ; I.E., "^TMP(""XDRFROM"",$J)"
+5 ;
+6 IF '$$PATCH^XPDUTL("BPM*1.0*1")!'$$PATCH^XPDUTL("BADE*1.0*1")
QUIT
+7 ;
+8 NEW BPMFR,BPMTO
+9 SET BPMFR=$ORDER(@BPMRY@(0))
+10 IF 'BPMFR
QUIT
+11 SET BPMTO=$ORDER(@BPMRY@(BPMFR,0))
+12 IF 'BPMTO
QUIT
+13 ;
+14 DO PROC(BPMFR,BPMTO)
+15 QUIT
PROC(BPMFR,BPMTO) ;
+1 ; SEND A40 MESSAGE
+2 NEW ERR
+3 ;
+4 DO A40^BADEMRG(BPMFR,BPMTO)
+5 ;
+6 QUIT
+7 ;