AMERXMB ; IHS/OIT/SCR - PRIMARY ROUTINE TO SUPPORT GENERATING AND SENDING BULLETINS
;;3.0;ER VISIT SYSTEM;**1**;FEB 23, 2009
;
PATMRG1(AMERODFN,AMERONAM,AMEROPCC,AMERNDFN,AMERNNAM,AMERNPCC,AMERTIME) ; EP from AMERVSIT
; Sent when an existing patient associated to an ER VISIT
; is identified as a different existing patient
N AMERRTRN
K XMTEXT
S XMB="AMER ERS PATIENT MERGE" ; Bulletin name
S XMB(1)=AMERODFN ; Original patient dfn
S XMB(2)=AMERONAM ; Original patient name
S XMB(3)=AMERNDFN ; New patient dfn
S XMB(4)=AMERNNAM ; New patient name
S XMB(5)=AMEROPCC ; Old VISIT ien
S XMB(6)=AMERNPCC ; New VISIT ien
S XMB(7)=DUZ ; New Person ien who made the changes
S XMB(9)=$P($G(^VA(200,DUZ,0)),U,1) ; New Person Name who made the changes
S XMB(10)=AMERTIME ; TIME OF VISIT (both old and new are the same)
S XMY="B.AMER ER PATIENT MERGE ALERTS"
S XMY(1)="",XMY(DUZ)=""
D EN^XMB
I $D(XMB) D EN^DDIOL("bulletin set up not complete - Please contact your site manager","","")
S AMERRTRN=XMZ
K XMZ
Q AMERRTRN
EDITGRP ; EP from OPTION "AMER ER ALERTS MAIL GROUP EDIT"
N AMERUSER,AMERGRP,AMERDUZ,AMERERR,Y,DIC,DIR,AMERY,AMERQUIT,AMERTYPE,AMERSELF,AMERORG,AMERQUT
S AMERQUIT=0
F Q:AMERQUIT D
.S DIC="^VA(200,",DIC(0)="AEQM"
.D ^DIC K DIC
.I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT S AMERQUIT=1 Q
.I +Y<0!(Y="") S AMERQUIT=1 Q
.S AMERDUZ=+Y
.S AMERGRP=0,AMERGRP=$O(^XMB(3.8,"B","AMER ER PATIENT MERGE ALERTS",AMERGRP))
.I AMERGRP="" D
..D EN^DDIOL("AMER ER ALERTS MAIL GROUP IS MISSING!!","","!!")
..S AMERQUIT=1
..Q
.Q:AMERQUIT
.S AMERFND=$$CHKUSER(AMERDUZ,AMERGRP)
.I AMERFND D
..D EN^DDIOL("This user is already in the AMER ER PATIENT MERGE ALERTS Mail Group","","!!")
..S DIR(0)="Y"
..S DIR("A")="Would you like to REMOVE this user from the Mail Group"
..S DIR("B")="YES"
..D ^DIR
..D:Y=1
...S AMERY(AMERDUZ)=""
...S AMERQUT=1
...;S AMERERR=$$DM^XMBGRP(AMERGRP,AMERY,AMERQUT)
...S AMERERR=$$DM^XMBGRP(AMERGRP,.AMERY,AMERQUT) ;IHS/OIT/SCR 05/05/09 patch 1
...Q
..Q
.E D
..S DIR(0)="Y"
..S DIR("A")="Would you like to ADD this user to the Mail Group"
..S DIR("B")="YES"
..D ^DIR
..D:Y=1
...S AMERY(AMERDUZ)=""
...S AMERQUT=0
...S AMERTYPE=""
...S AMERORG=""
...S AMERSELF=""
...S AMERDESC=""
...S AMERGRP=$$MG^XMBGRP(AMERGRP,AMERTYPE,AMERORG,AMERSELF,.AMERY,AMERDESC,AMERQUT)
..Q
.Q
Q
CHKUSER(AMERDUZ,XMGROUP) ;
N Y,XMDUZ,AMERFND
S AMERFND=0
S Y=XMGROUP
S XMDUZ=AMERDUZ
D CHK^XMA21
I $T S AMERFND=1
Q AMERFND
AMERXMB ; IHS/OIT/SCR - PRIMARY ROUTINE TO SUPPORT GENERATING AND SENDING BULLETINS
+1 ;;3.0;ER VISIT SYSTEM;**1**;FEB 23, 2009
+2 ;
PATMRG1(AMERODFN,AMERONAM,AMEROPCC,AMERNDFN,AMERNNAM,AMERNPCC,AMERTIME) ; EP from AMERVSIT
+1 ; Sent when an existing patient associated to an ER VISIT
+2 ; is identified as a different existing patient
+3 NEW AMERRTRN
+4 KILL XMTEXT
+5 ; Bulletin name
SET XMB="AMER ERS PATIENT MERGE"
+6 ; Original patient dfn
SET XMB(1)=AMERODFN
+7 ; Original patient name
SET XMB(2)=AMERONAM
+8 ; New patient dfn
SET XMB(3)=AMERNDFN
+9 ; New patient name
SET XMB(4)=AMERNNAM
+10 ; Old VISIT ien
SET XMB(5)=AMEROPCC
+11 ; New VISIT ien
SET XMB(6)=AMERNPCC
+12 ; New Person ien who made the changes
SET XMB(7)=DUZ
+13 ; New Person Name who made the changes
SET XMB(9)=$PIECE($GET(^VA(200,DUZ,0)),U,1)
+14 ; TIME OF VISIT (both old and new are the same)
SET XMB(10)=AMERTIME
+15 SET XMY="B.AMER ER PATIENT MERGE ALERTS"
+16 SET XMY(1)=""
SET XMY(DUZ)=""
+17 DO EN^XMB
+18 IF $DATA(XMB)
DO EN^DDIOL("bulletin set up not complete - Please contact your site manager","","")
+19 SET AMERRTRN=XMZ
+20 KILL XMZ
+21 QUIT AMERRTRN
EDITGRP ; EP from OPTION "AMER ER ALERTS MAIL GROUP EDIT"
+1 NEW AMERUSER,AMERGRP,AMERDUZ,AMERERR,Y,DIC,DIR,AMERY,AMERQUIT,AMERTYPE,AMERSELF,AMERORG,AMERQUT
+2 SET AMERQUIT=0
+3 FOR
IF AMERQUIT
QUIT
Begin DoDot:1
+4 SET DIC="^VA(200,"
SET DIC(0)="AEQM"
+5 DO ^DIC
KILL DIC
+6 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
SET AMERQUIT=1
QUIT
+7 IF +Y<0!(Y="")
SET AMERQUIT=1
QUIT
+8 SET AMERDUZ=+Y
+9 SET AMERGRP=0
SET AMERGRP=$ORDER(^XMB(3.8,"B","AMER ER PATIENT MERGE ALERTS",AMERGRP))
+10 IF AMERGRP=""
Begin DoDot:2
+11 DO EN^DDIOL("AMER ER ALERTS MAIL GROUP IS MISSING!!","","!!")
+12 SET AMERQUIT=1
+13 QUIT
End DoDot:2
+14 IF AMERQUIT
QUIT
+15 SET AMERFND=$$CHKUSER(AMERDUZ,AMERGRP)
+16 IF AMERFND
Begin DoDot:2
+17 DO EN^DDIOL("This user is already in the AMER ER PATIENT MERGE ALERTS Mail Group","","!!")
+18 SET DIR(0)="Y"
+19 SET DIR("A")="Would you like to REMOVE this user from the Mail Group"
+20 SET DIR("B")="YES"
+21 DO ^DIR
+22 IF Y=1
Begin DoDot:3
+23 SET AMERY(AMERDUZ)=""
+24 SET AMERQUT=1
+25 ;S AMERERR=$$DM^XMBGRP(AMERGRP,AMERY,AMERQUT)
+26 ;IHS/OIT/SCR 05/05/09 patch 1
SET AMERERR=$$DM^XMBGRP(AMERGRP,.AMERY,AMERQUT)
+27 QUIT
End DoDot:3
+28 QUIT
End DoDot:2
+29 IF '$TEST
Begin DoDot:2
+30 SET DIR(0)="Y"
+31 SET DIR("A")="Would you like to ADD this user to the Mail Group"
+32 SET DIR("B")="YES"
+33 DO ^DIR
+34 IF Y=1
Begin DoDot:3
+35 SET AMERY(AMERDUZ)=""
+36 SET AMERQUT=0
+37 SET AMERTYPE=""
+38 SET AMERORG=""
+39 SET AMERSELF=""
+40 SET AMERDESC=""
+41 SET AMERGRP=$$MG^XMBGRP(AMERGRP,AMERTYPE,AMERORG,AMERSELF,.AMERY,AMERDESC,AMERQUT)
End DoDot:3
+42 QUIT
End DoDot:2
+43 QUIT
End DoDot:1
+44 QUIT
CHKUSER(AMERDUZ,XMGROUP) ;
+1 NEW Y,XMDUZ,AMERFND
+2 SET AMERFND=0
+3 SET Y=XMGROUP
+4 SET XMDUZ=AMERDUZ
+5 DO CHK^XMA21
+6 IF $TEST
SET AMERFND=1
+7 QUIT AMERFND
