AMERD ; IHS/ANMC/GIS - PRIMARY ROUTINE FOR ER DISCHARGE ;
;;3.0;ER VISIT SYSTEM;**4,5,6,8**;MAR 03, 2009;Build 23
;
CHECK ;
I '$D(^AMERADM("B")) W !!!,*7,"Sorry...I have no record of any current admissions to the ER.",!,"Session cancelled!",!!! H 2 Q
D EXIT1^AMER K ^TMP("AMER",$J,1),^(2),^(3),AMERQUIT,AMER
;
;Set up discharge flag
NEW AMERDSC
S AMERDSC=1
;
VAR ; ENTRY POINT FOR BATCH MODE
S %="",$P(%,"~",80)="",AMERLINE=%,AMERSTRT=1,AMERFIN=27,AMERQSEQ="" K %
S IOP=0 D ^%ZIS
I $D(AMERBCH) S AMERSTRT=20,%=+^TMP("AMER",$J,1,1),AMERDFN=%,^TMP("AMER",$J,2,1)=% G RUN
W @IOF
EDIT ; ENTRY POINT FROM AMER4 AND AMER
S AMERQSEQ=""
RUN F AMERRUN=AMERSTRT:1 Q:$D(AMERBFLG) Q:AMERRUN>AMERFIN Q:$D(AMERQUIT) D Q:$D(AMERQUIT)
. I '$D(^AMER(2.3,"B",("QD"_AMERRUN))) Q
. ;
. S AMERQNO=AMERRUN W $$LINE^AMER("QD"_AMERRUN)
. D OPT^AMER("QD"_AMERRUN)
. D TRG
. D @("QD"_AMERRUN_"^AMER"_$S(AMERRUN<10:2,AMERRUN<20:3,AMERRUN<30:"2A",AMERRUN<50:"2B",1:"2C"))
. ;
. D SET
. ;
. ;AMER*3.0*5;Log activity
. D
.. NEW ERIEN,AFIELD,ADMFLD
.. S AFIELD=""
.. S ERIEN=$O(^AMER(2.3,"B","QD"_AMERRUN,"")) Q:ERIEN=""
.. S ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.04,"I")
.. I ADMFLD]"" S AFIELD=$P($G(^DD(9009081,ADMFLD,0)),U)
.. I AFIELD="" D
... S ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.05,"I")
... I ADMFLD]"" S AFIELD=$P($G(^DD(9009080,ADMFLD,0)),U)
.. Q:AFIELD=""
.. ;
.. ;Now log the activity
.. NEW AUDDFN
.. S AUDDFN=$G(DFN) S:AUDDFN="" AUDDFN=$G(AUPNPAT)
.. D LOG^AMERBUSA("P","E","AMER","AMER: Entered Patient ER visit information - "_AFIELD_" ("_AUDDFN_")",AUDDFN)
.. KILL AUDDFN
. ;
. I $D(AMEREFLG),AMERRUN=9 S AMERRUN=98
. K DIR,DIC
. Q
;
I $D(AMERTFLG)!($D(AMEREFLG)) Q
I $D(AMERBFLG) Q
I $D(AMERQUIT) G EXIT
FIX D ^AMER4 I $D(AMERQUIT) K AMEREFLG G EXIT
ELOOP I $D(AMEREFLG) G FIX
I '$D(AMERBCH),$P($G(^AMER(3,+$G(^TMP("AMER",$J,2,14)),0)),U)="HOME" D PRINT I $D(AMERQUIT) G EXIT
I $D(AMERTRG) D TRGSET D G EXIT
. ;
. ;AMER*3.0*8;Update V EMERGENCY VISIT RECORD entry
. D VER^AMERVER(DFN,"")
;
D ^AMERSAV I $D(AMERQUIT) G EXIT
;
;AMER*3*5;Added auditing call
NEW AMERVIS
S AMERVIS=$$GET1^DIQ(9009080,AMERDA_",",.03,"I")
D LOG^AMERBUSA("P","E","AMERD","AMER: Patient Discharged from the ER ("_AMERVIS_")",DFN)
;
;AMER*3.0*8;Update V EMERGENCY VISIT RECORD entry
D VER^AMERVER(DFN,AMERVIS)
;
;AMER*3.0*4
;Supply information to BEDD application if loaded
;
;First see if RPMS patch has been loaded
I $$VERSION^XPDUTL("BEDD") D
. ;
. ;Check if XML portion has been loaded
. N X
. S X="BEDDUTW" X ^%ZOSF("TEST") Q:'$T
. ;
. ;Call routine to pass info to BEDD
. I $G(AMERDA)]"" D DISCH^BEDDUTW(AMERDA)
. ;
. ;AMER*3*5;Added auditing call
. D LOG^AMERBUSA("P","E","AMERD","AMER: Patient Discharged from the ED Dashboard ("_AMERVIS_")",DFN)
;
I $D(AMERBCH) Q
EXIT D EXIT^AMER
Q
;
SET K AMERMAND I $D(AMERQUIT) Q
I AMERRUN=98 Q
;IHS/OIT/SCR 10/15/08 try to catch a REGISTERED IN ERROR visit and stop processing
I ((AMERRUN=95)&$D(AMERBCH)) W !,"Session terminated..." S AMERQUIT="" Q
I ((AMERRUN=95)&'$D(AMRBCH)) D Q
.S AMERPCC=$$EXISTING^AMERPCC(AMERDFN)
.I AMERPCC>0 D
..S APCDVDLT=AMERPCC
..D EN^APCDVDLT
..K APCDVDLT
..W !,"PCC Visit deleted..."
..N AMERTIME
..S AMERTIME=$G(^TMP("AMER",$J,1,2))
..D CANCEL^AMERBSDU(AMERDFN,AMERTIME)
..;W !,"Scheduled Visit deleted..." - can't cancel a visit that has been checked in
..Q
.D KILLADM^AMERSAV
.S AMERQUIT=""
.S AMERRUN=98
.S AMERFIN=0 ;IHS/OIT/SCR 10/15/0 A GLOBAL VARIABLE THAT NEEDS TO BE SET TO STOP QUESTIONS
I X?2."^" W !,*7,"Session terminated..." S AMERQUIT="" Q
I $E(X)=U S X=U
I X=U,$D(AMERBCH),AMERQNO=20 S AMERBFLG="" Q ; BACKUP TO ADMISSION QUESTIONS IN BATCH MODE
I X=U,$G(AMERQNO)<2 W !,"Session terminated...",*7 S AMERQUIT="" Q
I Y=""!(Y=-1),'$D(AMEROPT),AMERRUN>1,X'=U D MAND^AMER Q
K AMEROPT
S AMERQSEQ=AMERQSEQ_AMERQNO_";"
I X=U D BACK^AMER Q
I Y=""!(Y=-1) Q
Q:AMERQNO=6
S ^TMP("AMER",$J,2,AMERQNO)=Y
Q
TRGSET ; SET TRIAGE INFO IN ER ADM FILE
N AMERPCC
D ^AMER0
S AMERTRGS=20
S DA=AMERDFN,DIE="^AMERADM("
F S AMERTRGS=$O(^TMP("AMER",$J,2,AMERTRGS)) Q:AMERTRGS'?1N.N D
.S DR=AMERTRGS-3_"////"_$P(^TMP("AMER",$J,2,AMERTRGS),U)
.D ^DIE
.Q
S AMERPCC=$$EXISTING^AMERPCC(AMERDFN)
I AMERPCC>0 D VPROVTRG^AMERPCC(AMERDFN,AMERPCC)
Q
TRG ; SET TRIAGE INFO IN TMP FILE
S AMERTRGS=20
F S AMERTRGS=$O(^TMP("AMER",$J,1,AMERTRGS)) Q:AMERTRGS'?1N.N D
.S:$G(^TMP("AMER",$J,2,AMERTRGS))="" ^TMP("AMER",$J,2,AMERTRGS)=^TMP("AMER",$J,1,AMERTRGS)
Q
;
PRINT ; PRINT PATIENT INSTRUCTIONS
S AMERRUN=98
W !,"Do you want to print patient instructions"
S %=2 D YN^DICN I %Y?2."^" S DIROUT=""
D OUT^AMER
I $D(AMERQUIT) Q
I "Nn"[$E(%Y) Q
S DIR(0)="N^1:10:0",DIR("A")="Enter the number of copies you would like to print"
D ^DIR
S AMERNUM=Y
I $D(^TMP("AMER",$J,2,15)) S %=+^(15) I %'=121,%'=86,%'=87 G P1
W !,"I will print a set of follow up instructions for the patient and provider."
W !,"You can also print patient education materials...",!
S ^TMP("AMER",$J,2,26,31)=""
P1 D ^AMER5
Q
;
REV ; ENTRY POINT FOR REVOLVING DOOR CALC
N N,Y,Z,%,X1,X2
S Z=0 F Y=0:0 S Y=$O(^AMERVSIT("AC",X,Y)) Q:'Y Q:Y=DA S %=+^AMERVSIT(Y,0) I %>Z S Z=%
I 'Z Q
S X2=Z,X1=DT,N=.5 D REV1 S $P(^AMERVSIT(DA,5),U,2)=N
Q
;
REV1 N X D ^%DTC
I X>0 S N=X
Q
;
KREV ; ENTRY POINT TO KILL REVOLVING DOOR
S $P(^AMERVSIT(DA,5),U,2)=""
Q
;
DNA ; ENTRY POINT FROM AMER DNA MENU
; PT LEFT WITHOUT BEING SEEN
S AMERDNA=""
D AMERD K AMERDNA
Q
;
DEMO ; ENTRY POINT FOR DEMO MODE
S AMERDEMO=1
D AMERD
K AMERDEMO
Q
;
DXCK(AUPNPAT) ; Entry point to check for valid Dx entry for visit
;
;Quit if DFN not passed in (used to retrieve visit)
I $G(AUPNPAT)="" Q "1"
;
NEW AMERDXLT,AMERDCNT
;
;Make call to get list of V POV entries
S AMERDCNT=+$$POV^AMERUTIL(AUPNPAT,"",.AMERDXLT)
;
;If no V POV entries, inform user and quit
I AMERDCNT=0 D
. D EN^DDIOL("**No Purpose of Visit (POV) information has been entered for this visit**","","!!")
. D EN^DDIOL("**Please use EHR/PCC to enter POV information then proceed with the discharge**","","!")
. H 3
;
Q AMERDCNT
AMERD ; IHS/ANMC/GIS - PRIMARY ROUTINE FOR ER DISCHARGE ;
+1 ;;3.0;ER VISIT SYSTEM;**4,5,6,8**;MAR 03, 2009;Build 23
+2 ;
CHECK ;
+1 IF '$DATA(^AMERADM("B"))
WRITE !!!,*7,"Sorry...I have no record of any current admissions to the ER.",!,"Session cancelled!",!!!
HANG 2
QUIT
+2 DO EXIT1^AMER
KILL ^TMP("AMER",$JOB,1),^(2),^(3),AMERQUIT,AMER
+3 ;
+4 ;Set up discharge flag
+5 NEW AMERDSC
+6 SET AMERDSC=1
+7 ;
VAR ; ENTRY POINT FOR BATCH MODE
+1 SET %=""
SET $PIECE(%,"~",80)=""
SET AMERLINE=%
SET AMERSTRT=1
SET AMERFIN=27
SET AMERQSEQ=""
KILL %
+2 SET IOP=0
DO ^%ZIS
+3 IF $DATA(AMERBCH)
SET AMERSTRT=20
SET %=+^TMP("AMER",$JOB,1,1)
SET AMERDFN=%
SET ^TMP("AMER",$JOB,2,1)=%
GOTO RUN
+4 WRITE @IOF
EDIT ; ENTRY POINT FROM AMER4 AND AMER
+1 SET AMERQSEQ=""
RUN FOR AMERRUN=AMERSTRT:1
IF $DATA(AMERBFLG)
QUIT
IF AMERRUN>AMERFIN
QUIT
IF $DATA(AMERQUIT)
QUIT
Begin DoDot:1
+1 IF '$DATA(^AMER(2.3,"B",("QD"_AMERRUN)))
QUIT
+2 ;
+3 SET AMERQNO=AMERRUN
WRITE $$LINE^AMER("QD"_AMERRUN)
+4 DO OPT^AMER("QD"_AMERRUN)
+5 DO TRG
+6 DO @("QD"_AMERRUN_"^AMER"_$SELECT(AMERRUN<10:2,AMERRUN<20:3,AMERRUN<30:"2A",AMERRUN<50:"2B",1:"2C"))
+7 ;
+8 DO SET
+9 ;
+10 ;AMER*3.0*5;Log activity
+11 Begin DoDot:2
+12 NEW ERIEN,AFIELD,ADMFLD
+13 SET AFIELD=""
+14 SET ERIEN=$ORDER(^AMER(2.3,"B","QD"_AMERRUN,""))
IF ERIEN=""
QUIT
+15 SET ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.04,"I")
+16 IF ADMFLD]""
SET AFIELD=$PIECE($GET(^DD(9009081,ADMFLD,0)),U)
+17 IF AFIELD=""
Begin DoDot:3
+18 SET ADMFLD=$$GET1^DIQ(9009082.3,ERIEN,.05,"I")
+19 IF ADMFLD]""
SET AFIELD=$PIECE($GET(^DD(9009080,ADMFLD,0)),U)
End DoDot:3
+20 IF AFIELD=""
QUIT
+21 ;
+22 ;Now log the activity
+23 NEW AUDDFN
+24 SET AUDDFN=$GET(DFN)
IF AUDDFN=""
SET AUDDFN=$GET(AUPNPAT)
+25 DO LOG^AMERBUSA("P","E","AMER","AMER: Entered Patient ER visit information - "_AFIELD_" ("_AUDDFN_")",AUDDFN)
+26 KILL AUDDFN
End DoDot:2
+27 ;
+28 IF $DATA(AMEREFLG)
IF AMERRUN=9
SET AMERRUN=98
+29 KILL DIR,DIC
+30 QUIT
End DoDot:1
IF $DATA(AMERQUIT)
QUIT
+31 ;
+32 IF $DATA(AMERTFLG)!($DATA(AMEREFLG))
QUIT
+33 IF $DATA(AMERBFLG)
QUIT
+34 IF $DATA(AMERQUIT)
GOTO EXIT
FIX DO ^AMER4
IF $DATA(AMERQUIT)
KILL AMEREFLG
GOTO EXIT
ELOOP IF $DATA(AMEREFLG)
GOTO FIX
+1 IF '$DATA(AMERBCH)
IF $PIECE($GET(^AMER(3,+$GET(^TMP("AMER",$JOB,2,14)),0)),U)="HOME"
DO PRINT
IF $DATA(AMERQUIT)
GOTO EXIT
+2 IF $DATA(AMERTRG)
DO TRGSET
Begin DoDot:1
+3 ;
+4 ;AMER*3.0*8;Update V EMERGENCY VISIT RECORD entry
+5 DO VER^AMERVER(DFN,"")
End DoDot:1
GOTO EXIT
+6 ;
+7 DO ^AMERSAV
IF $DATA(AMERQUIT)
GOTO EXIT
+8 ;
+9 ;AMER*3*5;Added auditing call
+10 NEW AMERVIS
+11 SET AMERVIS=$$GET1^DIQ(9009080,AMERDA_",",.03,"I")
+12 DO LOG^AMERBUSA("P","E","AMERD","AMER: Patient Discharged from the ER ("_AMERVIS_")",DFN)
+13 ;
+14 ;AMER*3.0*8;Update V EMERGENCY VISIT RECORD entry
+15 DO VER^AMERVER(DFN,AMERVIS)
+16 ;
+17 ;AMER*3.0*4
+18 ;Supply information to BEDD application if loaded
+19 ;
+20 ;First see if RPMS patch has been loaded
+21 IF $$VERSION^XPDUTL("BEDD")
Begin DoDot:1
+22 ;
+23 ;Check if XML portion has been loaded
+24 NEW X
+25 SET X="BEDDUTW"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+26 ;
+27 ;Call routine to pass info to BEDD
+28 IF $GET(AMERDA)]""
DO DISCH^BEDDUTW(AMERDA)
+29 ;
+30 ;AMER*3*5;Added auditing call
+31 DO LOG^AMERBUSA("P","E","AMERD","AMER: Patient Discharged from the ED Dashboard ("_AMERVIS_")",DFN)
End DoDot:1
+32 ;
+33 IF $DATA(AMERBCH)
QUIT
EXIT DO EXIT^AMER
+1 QUIT
+2 ;
SET KILL AMERMAND
IF $DATA(AMERQUIT)
QUIT
+1 IF AMERRUN=98
QUIT
+2 ;IHS/OIT/SCR 10/15/08 try to catch a REGISTERED IN ERROR visit and stop processing
+3 IF ((AMERRUN=95)&$DATA(AMERBCH))
WRITE !,"Session terminated..."
SET AMERQUIT=""
QUIT
+4 IF ((AMERRUN=95)&'$DATA(AMRBCH))
Begin DoDot:1
+5 SET AMERPCC=$$EXISTING^AMERPCC(AMERDFN)
+6 IF AMERPCC>0
Begin DoDot:2
+7 SET APCDVDLT=AMERPCC
+8 DO EN^APCDVDLT
+9 KILL APCDVDLT
+10 WRITE !,"PCC Visit deleted..."
+11 NEW AMERTIME
+12 SET AMERTIME=$GET(^TMP("AMER",$JOB,1,2))
+13 DO CANCEL^AMERBSDU(AMERDFN,AMERTIME)
+14 ;W !,"Scheduled Visit deleted..." - can't cancel a visit that has been checked in
+15 QUIT
End DoDot:2
+16 DO KILLADM^AMERSAV
+17 SET AMERQUIT=""
+18 SET AMERRUN=98
+19 ;IHS/OIT/SCR 10/15/0 A GLOBAL VARIABLE THAT NEEDS TO BE SET TO STOP QUESTIONS
SET AMERFIN=0
End DoDot:1
QUIT
+20 IF X?2."^"
WRITE !,*7,"Session terminated..."
SET AMERQUIT=""
QUIT
+21 IF $EXTRACT(X)=U
SET X=U
+22 ; BACKUP TO ADMISSION QUESTIONS IN BATCH MODE
IF X=U
IF $DATA(AMERBCH)
IF AMERQNO=20
SET AMERBFLG=""
QUIT
+23 IF X=U
IF $GET(AMERQNO)<2
WRITE !,"Session terminated...",*7
SET AMERQUIT=""
QUIT
+24 IF Y=""!(Y=-1)
IF '$DATA(AMEROPT)
IF AMERRUN>1
IF X'=U
DO MAND^AMER
QUIT
+25 KILL AMEROPT
+26 SET AMERQSEQ=AMERQSEQ_AMERQNO_";"
+27 IF X=U
DO BACK^AMER
QUIT
+28 IF Y=""!(Y=-1)
QUIT
+29 IF AMERQNO=6
QUIT
+30 SET ^TMP("AMER",$JOB,2,AMERQNO)=Y
+31 QUIT
TRGSET ; SET TRIAGE INFO IN ER ADM FILE
+1 NEW AMERPCC
+2 DO ^AMER0
+3 SET AMERTRGS=20
+4 SET DA=AMERDFN
SET DIE="^AMERADM("
+5 FOR
SET AMERTRGS=$ORDER(^TMP("AMER",$JOB,2,AMERTRGS))
IF AMERTRGS'?1N.N
QUIT
Begin DoDot:1
+6 SET DR=AMERTRGS-3_"////"_$PIECE(^TMP("AMER",$JOB,2,AMERTRGS),U)
+7 DO ^DIE
+8 QUIT
End DoDot:1
+9 SET AMERPCC=$$EXISTING^AMERPCC(AMERDFN)
+10 IF AMERPCC>0
DO VPROVTRG^AMERPCC(AMERDFN,AMERPCC)
+11 QUIT
TRG ; SET TRIAGE INFO IN TMP FILE
+1 SET AMERTRGS=20
+2 FOR
SET AMERTRGS=$ORDER(^TMP("AMER",$JOB,1,AMERTRGS))
IF AMERTRGS'?1N.N
QUIT
Begin DoDot:1
+3 IF $GET(^TMP("AMER",$JOB,2,AMERTRGS))=""
SET ^TMP("AMER",$JOB,2,AMERTRGS)=^TMP("AMER",$JOB,1,AMERTRGS)
End DoDot:1
+4 QUIT
+5 ;
PRINT ; PRINT PATIENT INSTRUCTIONS
+1 SET AMERRUN=98
+2 WRITE !,"Do you want to print patient instructions"
+3 SET %=2
DO YN^DICN
IF %Y?2."^"
SET DIROUT=""
+4 DO OUT^AMER
+5 IF $DATA(AMERQUIT)
QUIT
+6 IF "Nn"[$EXTRACT(%Y)
QUIT
+7 SET DIR(0)="N^1:10:0"
SET DIR("A")="Enter the number of copies you would like to print"
+8 DO ^DIR
+9 SET AMERNUM=Y
+10 IF $DATA(^TMP("AMER",$JOB,2,15))
SET %=+^(15)
IF %'=121
IF %'=86
IF %'=87
GOTO P1
+11 WRITE !,"I will print a set of follow up instructions for the patient and provider."
+12 WRITE !,"You can also print patient education materials...",!
+13 SET ^TMP("AMER",$JOB,2,26,31)=""
P1 DO ^AMER5
+1 QUIT
+2 ;
REV ; ENTRY POINT FOR REVOLVING DOOR CALC
+1 NEW N,Y,Z,%,X1,X2
+2 SET Z=0
FOR Y=0:0
SET Y=$ORDER(^AMERVSIT("AC",X,Y))
IF 'Y
QUIT
IF Y=DA
QUIT
SET %=+^AMERVSIT(Y,0)
IF %>Z
SET Z=%
+3 IF 'Z
QUIT
+4 SET X2=Z
SET X1=DT
SET N=.5
DO REV1
SET $PIECE(^AMERVSIT(DA,5),U,2)=N
+5 QUIT
+6 ;
REV1 NEW X
DO ^%DTC
+1 IF X>0
SET N=X
+2 QUIT
+3 ;
KREV ; ENTRY POINT TO KILL REVOLVING DOOR
+1 SET $PIECE(^AMERVSIT(DA,5),U,2)=""
+2 QUIT
+3 ;
DNA ; ENTRY POINT FROM AMER DNA MENU
+1 ; PT LEFT WITHOUT BEING SEEN
+2 SET AMERDNA=""
+3 DO AMERD
KILL AMERDNA
+4 QUIT
+5 ;
DEMO ; ENTRY POINT FOR DEMO MODE
+1 SET AMERDEMO=1
+2 DO AMERD
+3 KILL AMERDEMO
+4 QUIT
+5 ;
DXCK(AUPNPAT) ; Entry point to check for valid Dx entry for visit
+1 ;
+2 ;Quit if DFN not passed in (used to retrieve visit)
+3 IF $GET(AUPNPAT)=""
QUIT "1"
+4 ;
+5 NEW AMERDXLT,AMERDCNT
+6 ;
+7 ;Make call to get list of V POV entries
+8 SET AMERDCNT=+$$POV^AMERUTIL(AUPNPAT,"",.AMERDXLT)
+9 ;
+10 ;If no V POV entries, inform user and quit
+11 IF AMERDCNT=0
Begin DoDot:1
+12 DO EN^DDIOL("**No Purpose of Visit (POV) information has been entered for this visit**","","!!")
+13 DO EN^DDIOL("**Please use EHR/PCC to enter POV information then proceed with the discharge**","","!")
+14 HANG 3
End DoDot:1
+15 ;
+16 QUIT AMERDCNT
