AMEREDTE ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of ER CONSULTANTS
;;3.0;ER VISIT SYSTEM;**1,6**;MAR 03, 2009;Build 30
;
; VARIABLES: The following variables are passed to multiple editing routines
; AMERDA : the IEN of the ER VISIT that is selected for editing
; AMERAIEN: The IEN of the ER AUDIT that is created when user begins editing a record
; AMEREDNO: An integer representing the number of multiple fields that have been edited
; for uniqueness in multiple field number in audit file
;
; Edit Auditing VARIABLES newed and used throughout edit routines:
; AMEROLD : original value of edited field
; AMERNEW : new value of edited field
; AMERSTRG : A ";" deliminated string of edit information for a field
;
EDTCNSLT(AMERDA,AMEREDNO,AMERAIEN) ;EP from AMEREDIT
; Called when "er consultants" is selected for editing
; INPUT:
; AMERDA : the IEN of the ER VISIT that is selected for editing
; AMEREDNO : an incremented number used for uniqueness in audit file
; AMERAIEN : The IEN of the ER AUDIT that is created when user begins editing a record
;
I '$D(^XUSEC("AMERZ9999",DUZ)) D EN^DDIOL("You are not authorized to use this option","","!!") Q 1 ;PROGRAMATICALLY LOCKING this option to holders of the coding key
N AMERCSLT,AMERCNO,AMERCTM,AMERDOC,AMERTIME,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
N AMERSKIP,AMERTIME,AMERNAME,AMERQUIT
N DIC,DIE,Y,Y1,DR,DIR
S (AMERNEW,AMEROLD,AMEREDTS,AMERSTRG,DR,AMERCSLT,AMERDOC,AMERTIME)=""
S AMERQUIT=0
I $P($G(^AMERVSIT(AMERDA,19,0)),U,4)'="" D
.Q:$P($G(^AMERVSIT(AMERDA,19,0)),U,4)=0
.S AMERCSLT=$O(^AMERVSIT(AMERDA,19,"B",0))
.I AMERCSLT'="" D
..S AMERDOC=$G(^AMER(2.9,AMERCSLT,0))
..D EN^DDIOL("The following ER CONSULTANT types and times have been entered","","!")
..D DSPCONS(AMERDA)
..Q
.Q
I $P($G(^AMERVSIT(AMERDA,19,0)),U,4)="" D
.D EN^DDIOL("There are currently no ER CONSULTANTS associated to this visit","","!!")
.S DIR(0)="Y",DIR("A")="Do you want to add an ER CONSULTANT",DIR("B")="NO"
.D ^DIR K DIR
.I Y=0 D
..I $P($G(^AMERVSIT(AMERDA,0)),U,22)=1 D SYNCH ;BUT first be sure flag is correct
..S AMERQUIT=1
..Q
.Q
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
Q:AMERQUIT 1 ;if user answered "NO", leave
D EN^DDIOL("","","!")
F Q:AMERQUIT=1 D
.K DIC("B")
.S DIC="^AMER(2.9,",DIC(0)="AMEQ",Y=""
.S DIC("S")="I $P(^(0),U,2)="""""
.;S DIC("A")="Edit/Enter "_$S(AMERDOC'="":"another ",1:"")_"ER CONSULTANT TYPE: "
.S DIC("A")="Edit/Enter ER CONSULTANT TYPE: "
.D ^DIC K DIC
.I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1 Q
.S AMERCSLT=$P($G(Y),U,1)
.I AMERCSLT>0 D
..S AMEREDNO=AMEREDNO+1
..;First look to see if that ER CONSULTANT has already been entered
..;if it has, we give the user a chance to delete it or edit it
..I '$$EDTCONS(AMERDA,AMERAIEN,AMERCSLT) D
...;returns 1 if record was found and either edited or deleted
...S AMERNEW=AMERCSLT
...S AMERSTRG=$$EDAUDIT^AMEREDAU("19-01"_"."_AMEREDNO,"",$$EDDISPL^AMEREDAU(AMERNEW,"E"),"ER CONSULTANTS")
...I AMERSTRG="^" S AMERQUIT=1 Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S DA(1)=AMERDA,DIC="^AMERVSIT(DA(1),19,",DIC(0)="L"
...S X="`"_AMERCSLT
...D ^DIC
...S DIE=DIC,DA(1)=AMERDA,DA=+Y
...S AMERCNO=+Y ;IHS/OIT/SCR 5/11/09
...K DIC
...K DIR("B")
...;IHS/OIT/SCR 11/21/08 - date should be optional
...;IHS/OIT/SCR 5/11/09 - date should NOT be optional
...;S DIR(0)="DO^::ER",DIR("A")="Date and time of ER CONSULTANT"
...S DIR(0)="D^::ET",DIR("A")="Date and time of ER CONSULTANT"
...S DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
...D ^DIR K DIR
...I $D(DUOUT)!$D(DTOUT) D Q
....S AMERQUIT=1
....D EN^DDIOL("No time identified","","!!")
....I $$DELETE(AMERDA,AMERCNO)
....D EN^DDIOL("Not adding consultant record","","!!")
....Q
...S AMERTIME=Y
...I AMERTIME'="" S DR=$S(DR'="":DR_";",1:""),DR=DR_".02////"_AMERTIME
...S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="ER CONSULTANT Name: "
...;screening so that only valid PCC providers identified
...S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
...D ^DIC
...I Y>0 S DR=$S(DR'="":DR_";",1:""),DR=DR_".03////"_+Y
...;IHS/OIT/SCR 05/11/09 - DELETE RECORD if no consultant is identified
...I +Y<0 D Q
....S DR=""
....D EN^DDIOL("No provider identified.","","!")
....I $$DELETE(AMERDA,AMERCNO)
....D EN^DDIOL("Not adding consultant record","","!!")
....Q
...;IHS/OIT/SCR 05/11/09 - DELETE RECORD if no consultant is identified
...I DR'="" D
....D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)
....Q
...D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN) ;only populate edit log with original record
...Q
..I AMERQUIT S (DR,AMEREDTS)="",AMERQUIT=0 Q
..Q
.E S AMERQUIT=1
.Q
D SYNCH ;be sure ER CONSULT flag is in synch with modifications
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
K AMERCSLT,AMERCNO,AMERCTM,AMERDOC,AMERTIME,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
Q 1
;
DSPCONS(AMERDA) ; EP from AMERTIME
; DISPLAYS the ER CONSULTANT data for an ER VIST
N AMERCNO,AMERTIME,AMERNAME,Y,Y1
S AMERCNO=0
F S AMERCNO=$O(^AMERVSIT(AMERDA,19,AMERCNO)) Q:AMERCNO="B" D
.S Y=$G(^AMERVSIT(AMERDA,19,AMERCNO,0)),Y1=$G(^AMER(2.9,$P(Y,U,1),0)) ;Y is the IEN, Y1 is the description
.S AMERTIME=$P(Y,U,2)
.S AMERNAME=$P(Y,U,3)
.S:AMERNAME'="" AMERNAME=$P($G(^VA(200,AMERNAME,0)),U,1)
.S Y=AMERTIME
.D DD^%DT
.D EN^DDIOL(Y1_" @ "_Y_" "_AMERNAME,"","!!")
.Q
Q
;
EDTCONS(AMERDA,AMERAIEN,AMERCSLT) ;
;RETURNS 1 IF CONSULTANT RECORD HAS BEEN EDITED OR DELETED
; 0 OTHERWISE
N AMERCNO,AMEROLD,AMERNEW,AMERNAME,AMERTIME,AMERSTRG,AMEREDTS,AMERQUIT,AMERFND
N DR
S (AMEREDTS,DR)=""
S (AMERCNO,AMERQUIT,AMERFND)=0,AMEROLD=AMERCSLT
F S AMERCNO=$O(^AMERVSIT(AMERDA,19,AMERCNO)) Q:AMERCNO="B"!(AMERCNO="") I $P($G(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,1)=AMERCSLT D
.S AMERFND=1
.S Y=$P($G(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,2)
.S AMERTIME=Y ; Keep time in original format for default
.D DD^%DT
.S AMERNAME=$P($G(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,3)
.S:AMERNAME'="" AMERNAME=$P($G(^VA(200,AMERNAME)),U,1)
.D EN^DDIOL("CONSULTANT TYPE : "_$G(^AMER(2.9,AMERCSLT,0))_" "_Y_" "_AMERNAME,"","!!")
.I $$DELCONS(AMERDA,AMERCNO) D ;ER CONSULTANT RECORD HAS BEEN DELETED
..S AMERSTRG=$$EDAUDIT^AMEREDAU("19-01"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"E"),"","ER CONSULTANTS")
..I AMERSTRG="^" S AMERQUIT=1 Q
..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
..Q
.E D ;ER CONSULTANT record has NOT been deleted
..;TIME or PERSON can be edited
..;IHS/OIT/SCR 11/21/08 time is not mandatory
..;S DIR(0)="D^::ER",DIR("A")="Date and time of ER CONSULTANT"
..S DIR(0)="DO^::ER",DIR("A")="Date and time of ER CONSULTANT"
..;IHS/OIT/SCR 5/11/09 time is mandatory
..S DIR(0)="D^::ER",DIR("A")="Date and time of ER CONSULTANT"
..S AMEROLD=AMERTIME
..I AMERTIME'="" S Y=AMERTIME D DD^%DT S DIR("B")=Y
..S DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
..D ^DIR K DIR
..;I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1 Q
..I $D(DUOUT)!$D(DTOUT) D Q
...S AMERQUIT=1
...S DR=""
...D EN^DDIOL("No time identified","","!!")
...I $$DELETE(AMERDA,AMERCNO)
...D EN^DDIOL("REMOVING consultant record","","!!")
...Q
..S (AMERTIME,AMERNEW)=Y
..I AMEROLD'=AMERNEW D
...S AMERSTRG=$$EDAUDIT^AMEREDAU("19-02"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"D"),$$EDDISPL^AMEREDAU(AMERNEW,"D"),"ER CONSULTANT TIME")
...I AMERSTRG="^" S AMERQUIT=1 Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S DR=$S(DR'="":DR_";",1:""),DR=DR_".02////"_AMERNEW
...Q
..;Now allow editing of NEW PERSON identified
..S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="ER CONSULTANT Name: "
..;screening so that only valid PCC providers identified
..S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
..S AMERNAME=$P($G(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,3)
..I AMERNAME'="" S (AMEROLD,DIC("B"))=AMERNAME
..E S AMEROLD=""
..D ^DIC
..I $D(DUOUT)!$D(DTOUT) S Y="^" Q
..I +Y>0 S (AMERNAME,AMERNEW)=+Y
..;IHS/OIT/SCR 05/11/09 - DELETE RECORD if no consultant is identified
..;E S AMERNEW=""
..I +Y<0 D Q
...S DR=""
...D EN^DDIOL("No provider identified.","","!")
...I $$DELETE(AMERDA,AMERCNO)
...D EN^DDIOL("Deleting Consultant record","","!!")
...Q
..;IHS/OIT/SCR 05/11/09 - DELETE RECORD if no consultant is identified
..I AMEROLD'=AMERNEW D
...S AMERSTRG=$$EDAUDIT^AMEREDAU("19-03"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"N"),$$EDDISPL^AMEREDAU(AMERNEW,"N"),"ER CONSULTANT NAME")
...I AMERSTRG="^" S AMERQUIT=1 Q
...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
...S DR=$S(DR'="":DR_";",1:""),DR=DR_".03////"_+Y
...Q
..Q
.S DIE="^AMERVSIT(DA(1),19,",DA(1)=AMERDA,DA=AMERCNO
.I DR'="" D
..D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)
..Q
.D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN) ;only populate edit log with original record
.S (DR,AMEREDTS)=""
.Q
Q AMERFND
;
DELCONS(IEN,SUBIEN) ;
N DIR,DIK
S DIR(0)="Y",DIR("A")="Do you want to delete this ER CONSULTANT",DIR("B")="NO"
D ^DIR K DIR
I $G(Y)>0 D
.S DA(1)=IEN,DA=SUBIEN
.S DIK="^AMERVSIT(DA(1),19,"
.D ^DIK,EN^DIK ;Delete identified entry
.K DIK
.Q
E Q 0
Q 1
;
SYNCH ;
;SYNCH "ER CONSULTANT NOTIFIED" WITH ER CONSULTANT MULTIPLE FIELD
I $P($G(^AMERVSIT(AMERDA,19,0)),U,4)>0 S DR=".22///1"
E S DR="22.///0"
D DIE^AMEREDIT(AMERDA,DR)
Q
DELETE(IEN,SUBIEN) ;
S DA(1)=IEN,DA=SUBIEN
S DIK="^AMERVSIT(DA(1),19,"
D ^DIK,EN^DIK ;Delete identified entry
K DIK
Q 1
AMEREDTE ; IHS/OIT/SCR - SUB-ROUTINE FOR ER VISIT EDIT of ER CONSULTANTS
+1 ;;3.0;ER VISIT SYSTEM;**1,6**;MAR 03, 2009;Build 30
+2 ;
+3 ; VARIABLES: The following variables are passed to multiple editing routines
+4 ; AMERDA : the IEN of the ER VISIT that is selected for editing
+5 ; AMERAIEN: The IEN of the ER AUDIT that is created when user begins editing a record
+6 ; AMEREDNO: An integer representing the number of multiple fields that have been edited
+7 ; for uniqueness in multiple field number in audit file
+8 ;
+9 ; Edit Auditing VARIABLES newed and used throughout edit routines:
+10 ; AMEROLD : original value of edited field
+11 ; AMERNEW : new value of edited field
+12 ; AMERSTRG : A ";" deliminated string of edit information for a field
+13 ;
EDTCNSLT(AMERDA,AMEREDNO,AMERAIEN) ;EP from AMEREDIT
+1 ; Called when "er consultants" is selected for editing
+2 ; INPUT:
+3 ; AMERDA : the IEN of the ER VISIT that is selected for editing
+4 ; AMEREDNO : an incremented number used for uniqueness in audit file
+5 ; AMERAIEN : The IEN of the ER AUDIT that is created when user begins editing a record
+6 ;
+7 ;PROGRAMATICALLY LOCKING this option to holders of the coding key
IF '$DATA(^XUSEC("AMERZ9999",DUZ))
DO EN^DDIOL("You are not authorized to use this option","","!!")
QUIT 1
+8 NEW AMERCSLT,AMERCNO,AMERCTM,AMERDOC,AMERTIME,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
+9 NEW AMERSKIP,AMERTIME,AMERNAME,AMERQUIT
+10 NEW DIC,DIE,Y,Y1,DR,DIR
+11 SET (AMERNEW,AMEROLD,AMEREDTS,AMERSTRG,DR,AMERCSLT,AMERDOC,AMERTIME)=""
+12 SET AMERQUIT=0
+13 IF $PIECE($GET(^AMERVSIT(AMERDA,19,0)),U,4)'=""
Begin DoDot:1
+14 IF $PIECE($GET(^AMERVSIT(AMERDA,19,0)),U,4)=0
QUIT
+15 SET AMERCSLT=$ORDER(^AMERVSIT(AMERDA,19,"B",0))
+16 IF AMERCSLT'=""
Begin DoDot:2
+17 SET AMERDOC=$GET(^AMER(2.9,AMERCSLT,0))
+18 DO EN^DDIOL("The following ER CONSULTANT types and times have been entered","","!")
+19 DO DSPCONS(AMERDA)
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF $PIECE($GET(^AMERVSIT(AMERDA,19,0)),U,4)=""
Begin DoDot:1
+23 DO EN^DDIOL("There are currently no ER CONSULTANTS associated to this visit","","!!")
+24 SET DIR(0)="Y"
SET DIR("A")="Do you want to add an ER CONSULTANT"
SET DIR("B")="NO"
+25 DO ^DIR
KILL DIR
+26 IF Y=0
Begin DoDot:2
+27 ;BUT first be sure flag is correct
IF $PIECE($GET(^AMERVSIT(AMERDA,0)),U,22)=1
DO SYNCH
+28 SET AMERQUIT=1
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+32 ;if user answered "NO", leave
IF AMERQUIT
QUIT 1
+33 DO EN^DDIOL("","","!")
+34 FOR
IF AMERQUIT=1
QUIT
Begin DoDot:1
+35 KILL DIC("B")
+36 SET DIC="^AMER(2.9,"
SET DIC(0)="AMEQ"
SET Y=""
+37 SET DIC("S")="I $P(^(0),U,2)="""""
+38 ;S DIC("A")="Edit/Enter "_$S(AMERDOC'="":"another ",1:"")_"ER CONSULTANT TYPE: "
+39 SET DIC("A")="Edit/Enter ER CONSULTANT TYPE: "
+40 DO ^DIC
KILL DIC
+41 IF $DATA(DUOUT)!$DATA(DTOUT)
SET AMERQUIT=1
QUIT
+42 SET AMERCSLT=$PIECE($GET(Y),U,1)
+43 IF AMERCSLT>0
Begin DoDot:2
+44 SET AMEREDNO=AMEREDNO+1
+45 ;First look to see if that ER CONSULTANT has already been entered
+46 ;if it has, we give the user a chance to delete it or edit it
+47 IF '$$EDTCONS(AMERDA,AMERAIEN,AMERCSLT)
Begin DoDot:3
+48 ;returns 1 if record was found and either edited or deleted
+49 SET AMERNEW=AMERCSLT
+50 SET AMERSTRG=$$EDAUDIT^AMEREDAU("19-01"_"."_AMEREDNO,"",$$EDDISPL^AMEREDAU(AMERNEW,"E"),"ER CONSULTANTS")
+51 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+52 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+53 SET DA(1)=AMERDA
SET DIC="^AMERVSIT(DA(1),19,"
SET DIC(0)="L"
+54 SET X="`"_AMERCSLT
+55 DO ^DIC
+56 SET DIE=DIC
SET DA(1)=AMERDA
SET DA=+Y
+57 ;IHS/OIT/SCR 5/11/09
SET AMERCNO=+Y
+58 KILL DIC
+59 KILL DIR("B")
+60 ;IHS/OIT/SCR 11/21/08 - date should be optional
+61 ;IHS/OIT/SCR 5/11/09 - date should NOT be optional
+62 ;S DIR(0)="DO^::ER",DIR("A")="Date and time of ER CONSULTANT"
+63 SET DIR(0)="D^::ET"
SET DIR("A")="Date and time of ER CONSULTANT"
+64 SET DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
+65 DO ^DIR
KILL DIR
+66 IF $DATA(DUOUT)!$DATA(DTOUT)
Begin DoDot:4
+67 SET AMERQUIT=1
+68 DO EN^DDIOL("No time identified","","!!")
+69 IF $$DELETE(AMERDA,AMERCNO)
+70 DO EN^DDIOL("Not adding consultant record","","!!")
+71 QUIT
End DoDot:4
QUIT
+72 SET AMERTIME=Y
+73 IF AMERTIME'=""
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".02////"_AMERTIME
+74 SET DIC="^VA(200,"
SET DIC(0)="AEQ"
SET DIC("A")="ER CONSULTANT Name: "
+75 ;screening so that only valid PCC providers identified
+76 SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
+77 DO ^DIC
+78 IF Y>0
SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".03////"_+Y
+79 ;IHS/OIT/SCR 05/11/09 - DELETE RECORD if no consultant is identified
+80 IF +Y<0
Begin DoDot:4
+81 SET DR=""
+82 DO EN^DDIOL("No provider identified.","","!")
+83 IF $$DELETE(AMERDA,AMERCNO)
+84 DO EN^DDIOL("Not adding consultant record","","!!")
+85 QUIT
End DoDot:4
QUIT
+86 ;IHS/OIT/SCR 05/11/09 - DELETE RECORD if no consultant is identified
+87 IF DR'=""
Begin DoDot:4
+88 DO MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)
+89 QUIT
End DoDot:4
+90 ;only populate edit log with original record
IF AMEREDTS'=""
DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+91 QUIT
End DoDot:3
+92 IF AMERQUIT
SET (DR,AMEREDTS)=""
SET AMERQUIT=0
QUIT
+93 QUIT
End DoDot:2
+94 IF '$TEST
SET AMERQUIT=1
+95 QUIT
End DoDot:1
+96 ;be sure ER CONSULT flag is in synch with modifications
DO SYNCH
+97 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+98 KILL AMERCSLT,AMERCNO,AMERCTM,AMERDOC,AMERTIME,AMERNEW,AMEROLD,AMEREDTS,AMERSTRG
+99 QUIT 1
+100 ;
DSPCONS(AMERDA) ; EP from AMERTIME
+1 ; DISPLAYS the ER CONSULTANT data for an ER VIST
+2 NEW AMERCNO,AMERTIME,AMERNAME,Y,Y1
+3 SET AMERCNO=0
+4 FOR
SET AMERCNO=$ORDER(^AMERVSIT(AMERDA,19,AMERCNO))
IF AMERCNO="B"
QUIT
Begin DoDot:1
+5 ;Y is the IEN, Y1 is the description
SET Y=$GET(^AMERVSIT(AMERDA,19,AMERCNO,0))
SET Y1=$GET(^AMER(2.9,$PIECE(Y,U,1),0))
+6 SET AMERTIME=$PIECE(Y,U,2)
+7 SET AMERNAME=$PIECE(Y,U,3)
+8 IF AMERNAME'=""
SET AMERNAME=$PIECE($GET(^VA(200,AMERNAME,0)),U,1)
+9 SET Y=AMERTIME
+10 DO DD^%DT
+11 DO EN^DDIOL(Y1_" @ "_Y_" "_AMERNAME,"","!!")
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
EDTCONS(AMERDA,AMERAIEN,AMERCSLT) ;
+1 ;RETURNS 1 IF CONSULTANT RECORD HAS BEEN EDITED OR DELETED
+2 ; 0 OTHERWISE
+3 NEW AMERCNO,AMEROLD,AMERNEW,AMERNAME,AMERTIME,AMERSTRG,AMEREDTS,AMERQUIT,AMERFND
+4 NEW DR
+5 SET (AMEREDTS,DR)=""
+6 SET (AMERCNO,AMERQUIT,AMERFND)=0
SET AMEROLD=AMERCSLT
+7 FOR
SET AMERCNO=$ORDER(^AMERVSIT(AMERDA,19,AMERCNO))
IF AMERCNO="B"!(AMERCNO="")
QUIT
IF $PIECE($GET(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,1)=AMERCSLT
Begin DoDot:1
+8 SET AMERFND=1
+9 SET Y=$PIECE($GET(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,2)
+10 ; Keep time in original format for default
SET AMERTIME=Y
+11 DO DD^%DT
+12 SET AMERNAME=$PIECE($GET(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,3)
+13 IF AMERNAME'=""
SET AMERNAME=$PIECE($GET(^VA(200,AMERNAME)),U,1)
+14 DO EN^DDIOL("CONSULTANT TYPE : "_$GET(^AMER(2.9,AMERCSLT,0))_" "_Y_" "_AMERNAME,"","!!")
+15 ;ER CONSULTANT RECORD HAS BEEN DELETED
IF $$DELCONS(AMERDA,AMERCNO)
Begin DoDot:2
+16 SET AMERSTRG=$$EDAUDIT^AMEREDAU("19-01"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"E"),"","ER CONSULTANTS")
+17 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+18 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+19 QUIT
End DoDot:2
+20 ;ER CONSULTANT record has NOT been deleted
IF '$TEST
Begin DoDot:2
+21 ;TIME or PERSON can be edited
+22 ;IHS/OIT/SCR 11/21/08 time is not mandatory
+23 ;S DIR(0)="D^::ER",DIR("A")="Date and time of ER CONSULTANT"
+24 SET DIR(0)="DO^::ER"
SET DIR("A")="Date and time of ER CONSULTANT"
+25 ;IHS/OIT/SCR 5/11/09 time is mandatory
+26 SET DIR(0)="D^::ER"
SET DIR("A")="Date and time of ER CONSULTANT"
+27 SET AMEROLD=AMERTIME
+28 IF AMERTIME'=""
SET Y=AMERTIME
DO DD^%DT
SET DIR("B")=Y
+29 SET DIR("?")="Enter date and time in the usual Fileman format (e.g. 1/1/2000@1PM)"
+30 DO ^DIR
KILL DIR
+31 ;I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1 Q
+32 IF $DATA(DUOUT)!$DATA(DTOUT)
Begin DoDot:3
+33 SET AMERQUIT=1
+34 SET DR=""
+35 DO EN^DDIOL("No time identified","","!!")
+36 IF $$DELETE(AMERDA,AMERCNO)
+37 DO EN^DDIOL("REMOVING consultant record","","!!")
+38 QUIT
End DoDot:3
QUIT
+39 SET (AMERTIME,AMERNEW)=Y
+40 IF AMEROLD'=AMERNEW
Begin DoDot:3
+41 SET AMERSTRG=$$EDAUDIT^AMEREDAU("19-02"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"D"),$$EDDISPL^AMEREDAU(AMERNEW,"D"),"ER CONSULTANT TIME")
+42 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+43 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+44 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".02////"_AMERNEW
+45 QUIT
End DoDot:3
+46 ;Now allow editing of NEW PERSON identified
+47 SET DIC="^VA(200,"
SET DIC(0)="AEQ"
SET DIC("A")="ER CONSULTANT Name: "
+48 ;screening so that only valid PCC providers identified
+49 SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y))"
+50 SET AMERNAME=$PIECE($GET(^AMERVSIT(AMERDA,19,AMERCNO,0)),U,3)
+51 IF AMERNAME'=""
SET (AMEROLD,DIC("B"))=AMERNAME
+52 IF '$TEST
SET AMEROLD=""
+53 DO ^DIC
+54 IF $DATA(DUOUT)!$DATA(DTOUT)
SET Y="^"
QUIT
+55 IF +Y>0
SET (AMERNAME,AMERNEW)=+Y
+56 ;IHS/OIT/SCR 05/11/09 - DELETE RECORD if no consultant is identified
+57 ;E S AMERNEW=""
+58 IF +Y<0
Begin DoDot:3
+59 SET DR=""
+60 DO EN^DDIOL("No provider identified.","","!")
+61 IF $$DELETE(AMERDA,AMERCNO)
+62 DO EN^DDIOL("Deleting Consultant record","","!!")
+63 QUIT
End DoDot:3
QUIT
+64 ;IHS/OIT/SCR 05/11/09 - DELETE RECORD if no consultant is identified
+65 IF AMEROLD'=AMERNEW
Begin DoDot:3
+66 SET AMERSTRG=$$EDAUDIT^AMEREDAU("19-03"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMEROLD,"N"),$$EDDISPL^AMEREDAU(AMERNEW,"N"),"ER CONSULTANT NAME")
+67 IF AMERSTRG="^"
SET AMERQUIT=1
QUIT
+68 SET AMEREDTS=$SELECT(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
+69 SET DR=$SELECT(DR'="":DR_";",1:"")
SET DR=DR_".03////"_+Y
+70 QUIT
End DoDot:3
+71 QUIT
End DoDot:2
+72 SET DIE="^AMERVSIT(DA(1),19,"
SET DA(1)=AMERDA
SET DA=AMERCNO
+73 IF DR'=""
Begin DoDot:2
+74 DO MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)
+75 QUIT
End DoDot:2
+76 ;only populate edit log with original record
IF AMEREDTS'=""
DO MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
+77 SET (DR,AMEREDTS)=""
+78 QUIT
End DoDot:1
+79 QUIT AMERFND
+80 ;
DELCONS(IEN,SUBIEN) ;
+1 NEW DIR,DIK
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to delete this ER CONSULTANT"
SET DIR("B")="NO"
+3 DO ^DIR
KILL DIR
+4 IF $GET(Y)>0
Begin DoDot:1
+5 SET DA(1)=IEN
SET DA=SUBIEN
+6 SET DIK="^AMERVSIT(DA(1),19,"
+7 ;Delete identified entry
DO ^DIK
DO EN^DIK
+8 KILL DIK
+9 QUIT
End DoDot:1
+10 IF '$TEST
QUIT 0
+11 QUIT 1
+12 ;
SYNCH ;
+1 ;SYNCH "ER CONSULTANT NOTIFIED" WITH ER CONSULTANT MULTIPLE FIELD
+2 IF $PIECE($GET(^AMERVSIT(AMERDA,19,0)),U,4)>0
SET DR=".22///1"
+3 IF '$TEST
SET DR="22.///0"
+4 DO DIE^AMEREDIT(AMERDA,DR)
+5 QUIT
DELETE(IEN,SUBIEN) ;
+1 SET DA(1)=IEN
SET DA=SUBIEN
+2 SET DIK="^AMERVSIT(DA(1),19,"
+3 ;Delete identified entry
DO ^DIK
DO EN^DIK
+4 KILL DIK
+5 QUIT 1
