- 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
