AMERPCC ; IHS/OIT/SCR - PRIMARY ROUTINE FOR PCC VISIT CREATION AND EDITING
;;3.0;ER VISIT SYSTEM;**1,2,5,6,8,10**;MAR 03, 2009;Build 23
;
; PCC vists are created with a call that includes an interface to the scheduling package
; IF a
; clinic code has been set up in ERS that identifies the Emergency
; Clinic for the user's current logon location (DUZ(2)) has been identified
; this visit is scheduled and can be "viewed" through EHR
;
; ELSE
; the visit is created and updated entirely through the ERS interface and is not "viewable" to EHR
;
;AMER*3.0*6;Turned off all V POV updates
;
; CURRENTLY: Only V POV and V PROVIDER support is provided by the ERS interface
;
VISIT(AMERPAT,AMERDATE) ; EP from AMER1 when patient is admitted W/O PIMS interface CHEKIN^AMERBSDU
; If site has indicated a CLINIC in paramaters, a scheduled walk-in visit is created
; and a PCC VISIT record is created by PIMS SCHEDULING (BSDU) pacage
; If not a PCC VISIT record created by ERS PACKAGE
; 1. Look for VISIT created at checkin
; 2. Create a VISIT if none exists for this patient on this date from this location
; 3. Return VISIT IEN if successful, 0 otherwise
N IN,AMERVSIT,OUT,X,AMERVDR,AMEROPT,CLIN,HLOC
;
;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Pull default ER clinic and use
S CLIN=$$GET1^DIQ(9009082.5,DUZ(2)_",",.06,"I")
;
;If no clinic, get first one with a 30 mnemonic
I CLIN="" S CLIN=$O(^AMER(3,"B",30,""))
;
S CLIN=$$GCLIN^AMERBSD(CLIN)
S HLOC=$P(CLIN,U,2),CLIN=$P(CLIN,U)
;
I HLOC="" D Q ""
. W !,"SITE PARAMETERS have not been set up in the ERS PARAMETER option"
. W !,"No entry for EMERGENCY MEDICINE could be located"
;
;Set up for BSD
S IN("HOS LOC")=HLOC
S IN("CLINIC CODE")=CLIN
;
;End of CR#10213 Changes
;
S (AMERVSIT,AMERVDR)=""
S IN("PAT")=AMERPAT
S IN("VISIT DATE")=AMERDATE
S IN("SITE")=$G(DUZ(2))
;To determine "visit type" for this visit, look in "PCC MASTER CONTROL" file
;get the "type of visit" that is set there
S IN("VISIT TYPE")=$P($G(^APCCCTRL(DUZ(2),0)),U,4)
S IN("USR")=DUZ
;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Now being set above
;S IN("HOS LOC")=$G(^AMER(2.5,DUZ(2),"SD"))
S:IN("HOS LOC")'="" IN("APPT DATE")=AMERDATE ; Setting IN("APPT DATE") will create an appoinment for this time
S IN("SRV CAT")="A" ; ER VISITS are "ambulatory"
S IN("TIME RANGE")=3 ; Only find a visit for a time that is close to time or ER VISIT
;
D GETVISIT^APCDAPI4(.IN,.OUT)
I $P(OUT(0),U,1)=0 D
.D EN^DDIOL("NO VISIT FOUND OR CREATED!!!","","!!")
.S AMERVSIT=-1_"^"_$P(OUT(0),U,2)
.Q
Q:+AMERVSIT<0 AMERVSIT
S AMERTEMP=0
I $P(OUT(0),U,1)>1 D
.F S AMERTEMP=$O(OUT(AMERTEMP)) Q:AMERTEMP="" D
..D EN^DDIOL("Multiple VISIT matches FOUND: "_AMERTEMP,"","!!")
..S AMERVSIT=AMERTEMP
..Q
.Q
I $P(OUT(0),U,1)=1 S AMERVSIT=$O(OUT(AMERTEMP))
; IF "Option use to create" is blank (no PIMS interface) update it with DIE call
I AMERVSIT>0 D
.Q:$$GETVOPTN^AMERVSIT(AMERVSIT)'=""
.S AMEROPT=$$GETOPIEN^AMERVSIT("AMER IHS PCC LINK")
.S:+AMEROPT>0 AMERVDR=".24///"_+AMEROPT
.D:AMERVDR'="" VSITDIE^AMERVSIT(AMERVSIT,AMERVDR)
.Q
Q AMERVSIT
;
EXISTING(AMERDFN) ; EP FROM TRGSET^AMERD
; RETURNS VISIT IEN for patient that has not yet been discharged
N IN,OUT,DIC,Y,AMERTEMP,AMERVSIT
S DIC="^AMERADM(",X=AMERDFN,DIC(0)="NXZ"
D ^DIC
K DIC
I Y<0 Q -1
S AMERVSIT=$P($G(^AMERADM(AMERDFN,0)),U,3)
Q AMERVSIT
SCHEDULD(AMERPAT,AMERDATE,AMERSCHD) ; EP from ERCHCKIN^AMERBDSU
; Called when user has selected to check-in ER patient for scheduled visit
; INPUT: AMERPAT - ien of PATIENT
; AMERDATE - the date and time of ER ADMISSION
; AMERSCHD - the date and time of scheduled ER APPOINTMENT
;
; Return VISIT IEN if check-in is successful, 0 otherwise
;
N IN,AMERVSIT,OUT,X,AMERDIFF
S AMERVSIT=""
S AMERDIFF=AMERDATE-AMERSCHD
I AMERDIFF<0 S AMERDIFF=+AMERDIFF
S IN("PAT")=AMERPAT
S IN("VISIT DATE")=AMERDATE
S IN("SITE")=$G(DUZ(2))
;know the appointment date and want to check-in for this visit
S IN("APPT DATE")=AMERSCHD
; To determine "visit type" for this visit, look in the "PCC MASTER CONTROL" file
; and get the "type of visit" that is set there
S IN("VISIT TYPE")=$P($G(^APCCCTRL(DUZ(2),0)),U,4)
S IN("USR")=DUZ
S IN("HOS LOC")=$G(^AMER(2.5,DUZ(2),"SD"))
S IN("SRV CAT")="A" ; ER VISITS are "ambulatory"
S IN("TIME RANGE")=AMERDIFF+10 ; LOOK FOR A VISIT AROUND DIFFERENCE BETWEEN SCHEDULED AND VISIT TIME
D GETVISIT^APCDAPI4(.IN,.OUT)
I $P(OUT(0),U,1)=0 D
.D EN^DDIOL("NO VISIT FOUND OR CREATED!!!","","!!")
.S AMERVSIT=-1_"^"_$P(OUT(0),U,2)
.Q
Q:+AMERVSIT<0 AMERVSIT
S AMERTEMP=0
I $P(OUT(0),U,1)>1 D
.F S AMERTEMP=$O(OUT(AMERTEMP)) Q:AMERTEMP="" D
..D EN^DDIOL("Multiple VISIT matches FOUND: "_AMERTEMP,"","!!")
..S AMERVSIT=AMERTEMP
..Q
.Q
I $P(OUT(0),U,1)=1 S AMERVSIT=$O(OUT(AMERTEMP))
Q AMERVSIT
;
FINDVSIT(AMERDA) ; EP FROM AMEREDTA,AMERVSIT,AMERSAV
; AMERDA-VISIT IEN FOR THIS ER VISIT
;
; RETURNS VISIT IEN for patient that has been discharged from ER IF SUCCESSFUL
; -1 IF NOT
N IN,OUT,DIC,Y,AMERTEMP,AMERVSIT
N AMERDFN,AMERDR
S AMERVSIT=$P($G(^AMERVSIT(AMERDA,0)),U,3)
I AMERVSIT="" S AMERVSIT=-1
Q AMERVSIT
;
VPROVTRG(AMERDFN,AMERPCC) ; EP From TRGSET^AMERD
; Updates VISIT information when entered through TRI option before discharge
; Update CLINIC code if needed in VISIT entry
; and add ADMITTING providers to V PROVIDER before discharge
; AMERDFN:patient ien
; AMERPCC:VISIT ien
N AMERPROV,AMERPIEN,AMERTIME,DIC,Y,AMERVVAL,AMERCLNC,AMERVDR
S AMERVDR=""
; UPDATE PRESENTING COMPLAINT IF IT IS NOT THE SAME AS WHAT IS ALREADY IN VISIT FILE
S DIC="^AMERADM(",X=AMERDFN,DIC(0)="NXZ"
D ^DIC
K DIC
Q:Y<0
S AMERVVAL=$G(^AUPNVSIT(AMERPCC,14))
S AMERCOMP=$P($G(Y(0)),U,10) ; PRESENTING COMPLAINT
I AMERVVAL'=AMERCOMP S AMERVDR="1401///"_AMERCOMP
;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Clinic (and Location) now set in AMER2A
;UPDATE CLINIC IF IT IS NOT THE SAME AS WHAT IS ALREADY THERE
;S AMERVVAL=$P($G(^AUPNVSIT(AMERPCC,0)),U,8)
;S:AMERVVAL>0 AMERVVAL=$P($G(^DIC(40.7,AMERVVAL,0)),U,1)
;S AMERCLNC=$P($G(^TMP("AMER",$J,2,20)),U,2)
;I (AMERCLNC'="URGENT CARE") S AMERCLNC="EMERGENCY MEDICINE"
;I AMERVVAL'=AMERCLNC S AMERVDR=$S(AMERVDR'="":AMERVDR_";",1:""),AMERVDR=AMERVDR_".08///"_AMERCLNC
; NOW ADD V PROVIDER INFO
S AMERPIEN=$P($G(Y(0)),U,19) ; TRIAGE NURSE
S AMERTIME=$P($G(Y(0)),U,21) ; TRIAGE TIME
I AMERTIME="" S AMERTIME=$P($G(Y(0)),U,2) ; Use admission time if not supplied
;IHS/OIT/SCR 12/16/08 - IF THE PROVIDER THAT WE ARE ABOUT TO ADD IS ALREADY ASSOCIATED TO THE VISIT THROUGH EHR, DON'T ADD AGAIN
I '$$PRVTHERE^AMERPCC1(AMERPIEN,AMERPCC) D
.I $$ADDPRV^AMERPCC1(AMERPCC,AMERPIEN,AMERTIME,AMERDFN,"S","")<1 D EN^DDIOL("UNABLE TO ADD V PROVIDER FOR TRIAGE NURSE","","!!") ; TRIAGE NURSE
.Q
; IF CLINIC OR PRESENTING COMPLAINT HAS BEEN MODIFIED, UPDATE IT THROUGH DIE
D:AMERVDR'="" VSITDIE^AMERVSIT(AMERPCC,AMERVDR)
Q
VISITIN(AMERDFN,AMERPCC) ; EP From SAVE^AMER0
; Updates exisiting VISIT with admit information
; AMERDFN - PATIENT IEN TO IDENTIFY PATIENT IN ER ADMISSIONS FILE
; AMERPCC - PCC VISIT IEN FOR UPDATING VISIT FILE CHIEF COMPLAINT
N DIC,Y,AMERCOMP,AMERVDR
S DIC="^AMERADM(",X=AMERDFN,DIC(0)="NXZ"
D ^DIC
K DIC
Q:Y<0
;AMER*3.0*8;Pull from new field
;S AMERCOMP=$P($G(Y(0)),U,10) ; PRESENTING COMPLAINT
S AMERCOMP=$G(^AMERADM(AMERDFN,23)) ; PRESENTING COMPLAINT
S AMERVDR="1401///"_AMERCOMP
D VSITDIE^AMERVSIT(AMERPCC,AMERVDR)
;
;AMER*3*5;Added auditing call
;D LOG^AMERBUSA("P","E","AMERPCC","AMER: Updated ER visit presenting complaint ("_AMERDFN_")",AMERDFN)
;
Q
SYNCHPCC(AMERDA) ; EP from UPDATE^AMERSAV, AMEREDPC, AND AMEREDTA
; This routine will:
; 0. Get the current patient DOB and chart number from patient reg APIs and use them to update the ER VISIT file if different
; 1. Identify an exisisting visit or make a new one
; 2. Update VISIT entry with
; 2a."CHIEF COMPLAINT" if different from ER VISIT Presenting Complaint
; 2b."CHECKOUT DAY AND TIME" if different from ER VISIT departure time
; 2C."OPTION USED TO CREATE" to "AMER IHS PCC LINK" if empty
;
; 3. Look for V PROVIDER entries and be sure identified "admitting" providers are in
; the ER VISIT file and that the times are the same
; 3a. Add admitting providers to V PROVIDER if they are not there
; 3b. Remove V PROVIDER entries if provider is not identified as admitting provider in ER VISIT file
; 3c. Modify V PROVIDER times if admitting provider time is not the same
;
; 4. Add V PROVIDER entries for discharge providers and ER CONSULANTS
;AMER*3.0*6;No longer add V POV entries
; 5. Add V POV entries for each valid ICD9 DX code in ER VISIT
;
; RETURNS VISIT IEN IF SUCCESFUL, 0 IF NOT
;
N AMERCLN,AMERPCC,AMRSTRG,AMERQUIT,AMERDATE,AMERDEPT,AMERPAT,AMERDOC
N AMEREVAL,AMERVVAL,AMERETIM,AMERVTIM,AMERFND,AMERVIEN,AMERVDR,AMERNEW
N AMERVOPT,AMERPNTR,AMERDR,AMERDOB,AMERHRN,AMERETIM,AMERVTIM
Q:$G(^AMERVSIT(AMERDA,0))="" 0 ; DON'T TRY TO SYNCH A VISIT UP IF THE VISIT DOESN'T EXIST
; The value in the ER VISIT, the value in the VISIT file, the associated ER VISIT time and the associated VISIT time
S (AMERCLN,AMERDATE,AMERPAT,AMERVDR)=""
S AMERDATE=$P($G(^AMERVSIT(AMERDA,0)),U,1) ; AMERDATE IS THE TIME OF VISIT
I AMERDATE="" Q 0
S AMERPAT=$P($G(^AMERVSIT(AMERDA,0)),U,2) ; AMERPAT IS THE IEN OF PATIENT
I AMERPAT="" Q 0
;IHS/OIT/SCR 01/09/09 - NOW LOOK AT PATIENT REG INFO AND UPDATE ERS IF NEEDED
D SYNCHERP^AMERERS(AMERPAT,AMERDA)
I $G(^AMERVSIT(AMERDA,6))'="" S AMERDEPT=$P(^AMERVSIT(AMERDA,6),U,2)
S AMERPCC=$$FINDVSIT^AMERPCC(AMERDA)
I AMERPCC<0 Q 0 ;IHS/OIT/SCR 05/07/09 patch 1
;
;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Sync clinic and hospital location
D SYNCCL^AMER2A(AMERDA,AMERPCC)
;
; Compare ER "Presenting Complaint" to VISIT "Chief Complaint"
S AMEREVAL=$G(^AMERVSIT(AMERDA,1))
S AMERVVAL=$G(^AUPNVSIT(AMERPCC,14))
S AMERVVAL=$TR(AMERVVAL,";","~") ;IHS/OIT/SCR 05/07/09 patch 1
I AMERVVAL="" S AMERVDR=$S(AMERVDR'="":AMERVDR_";",1:""),AMERVDR=AMERVDR_"1401///"_AMEREVAL
ELSE I (AMEREVAL'=AMERVVAL) D
.;IHS/OIT/SCR 12/18 - if the values are different, user needs to choose
.D EN^DDIOL("**The value for CHIEF COMPLAINT in the PCC visit file is different from ERS PRESENTING COMPLAINT**","","!!?3")
.D EN^DDIOL("PCC CHIEF COMPLAINT: "_$G(^AUPNVSIT(AMERPCC,14)),"","!?3")
.D EN^DDIOL("ERS PRESENTING COMPLAINT: "_AMEREVAL,"","!?3")
.S DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"
.S DIR("A")="Which would you like to do"
.D ^DIR K DIR
.S AMERANS=+Y
.I Y=""!(Y="^")!(AMERANS=2) D
..;KEEP THE PCC VISIT INFO - PUT IT INTO THE AMER VISIT
..S AMERDR="1////"_AMERVVAL
..D DIE^AMEREDIT(AMERDA,AMERDR)
..Q
.I AMERANS=1 D
..;UPDATE THE PCC VISIT
..S AMERVDR=$S(AMERVDR'="":AMERVDR_";",1:""),AMERVDR=AMERVDR_"1401///"_AMEREVAL
..Q
.Q
; GET THE DEPARTURE OUT TIME FROM VISIT AND COMPARE TO CHECK OUT TIME IN ER VISIT
S AMEREVAL=$P($G(^AMERVSIT(AMERDA,6)),U,2) ; AMERDEPT IS DEPARTURE TIME
S AMERVVAL=$P(^AUPNVSIT(AMERPCC,0),"^",18) ;CHECKOUT TIME
I (AMEREVAL'=AMERVVAL) D
.I AMERVVAL'="" D
..;IHS/OIT/SCR 12/18 - if the values are different, user needs to choose
..S AMERVTIM=$$EDDISPL^AMEREDAU(AMERVVAL,"D")
..S AMERETIM=$$EDDISPL^AMEREDAU(AMEREVAL,"D")
..D EN^DDIOL("**The value for DEPARTURE DATE in the PCC visit file is different from ERS CHECKOUT DAY**","","!!?3")
..D EN^DDIOL("PCC VISIT DEPARTURE DATE: "_AMERVTIM,"","!?3")
..D EN^DDIOL("ERS CHECKOUT DATE: "_AMERETIM,"","!?3")
..S DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"
..S DIR("A")="Which would you like to do"
..D ^DIR K DIR
..S AMERANS=+Y
..I Y=""!(Y="^")!(AMERANS=2) D
...;KEEP THE PCC VISIT INFO - PUT IT INTO THE AMER VISIT
...S AMERDR="6.2////"_AMERVVAL
...D DIE^AMEREDIT(AMERDA,AMERDR)
...Q
..I AMERANS=1 D
...;UPDATE THE PCC VISIT WITH WHAT USER JUST ENTERED
...S AMERVDR=$S(AMERVDR'="":AMERVDR_";",1:""),AMERVDR=AMERVDR_".18///"_AMEREVAL ; patch 2
...Q
..Q
.E S AMERVDR=$S(AMERVDR'="":AMERVDR_";",1:""),AMERVDR=AMERVDR_".18////"_AMEREVAL
.Q
; GET OPTION USED TO CREATE VISIT - IF NOT THERE, IDENTIFY "AMER IHS PCC LINK" OPTION
S AMERVVAL=$P($G(^AUPNVSIT(AMERPCC,0)),U,24) ; IEN OF OPTION THAT CREATED VISIT
I AMERVVAL="" S AMERVDR=$S(AMERVDR'="":AMERVDR_";",1:""),AMERVDR=AMERVDR_".24///"_$$GETOPIEN^AMERVSIT("AMER IHS PCC LINK")
D:AMERVDR'="" VSITDIE^AMERVSIT(AMERPCC,AMERVDR) ; update VISIT file with identified changes
K AMERVVAL,AMEREVAL,AMERVDR
D SYNCHPRV^AMERPCC1(AMERDA,AMERPCC,AMERPAT)
S AMERDOC=$P($G(^AMERVSIT(AMERDA,6)),U,3)
;
;AMER*3.0*6;No longer update V POV
;D SYNCHPOV^AMERPCC2(AMERDA,AMERPCC,AMERPAT,AMERDATE,AMERDOC,AMERCLN)
Q
;
SAVPCCA(AMERPCC,AMERDFN) ; EP FROM AMER WHEN AN ADMISSION AND PCC VISIT HAS JUST BEEN CREATED
; UPDATES THE ER ADMISSION FILE WITH THE PCC VISIT IEN ASSOCIATED WITH IT
; INPUT AMERPCC - THE IEN OF THE PCC VISIT
; AMERDFN - THE IEN OF THE PATIENT
N DIE,DA,DR
S DR="1.1////"_AMERPCC
S DIE="^AMERADM(",DA=AMERDFN
L +^FILE(9009081):2
I $T D
.D ^DIE
.L -^FILE(9009081)
.Q
E D EN^DDIOL("Unable to update ER ADMISSION file","","!!")
Q
SAVPCCO(AMERPCC,AMERDA) ; EP FROM AMER CHANGPAT^AMERVSIT
; WHEN AN ADMISSION AND PCC VISIT HAS JUST BEEN CREATED OR WHEN PATIENT IS BEING CHANGED AND A NEW PCC VISIT IS CREATED
; UPDATES THE ER ADMISSION FILE WITH THE PCC VISIT IEN ASSOCIATED TO IT
; INPUT AMERPCC - THE IEN OF THE PCC VISIT FILE ENTRY
; AMERDATE - THE DATE/TIME OF ADMISSION
N DIE,DA,DR
S DR=".03////"_AMERPCC
S DIE="^AMERVSIT(",DA=AMERDA
L +^FILE(9009080):2
I $T D
.D ^DIE
.L -^FILE(9009080)
.Q
E D EN^DDIOL("Unable to update ER VISIT file","","!!")
Q
AMERPCC ; IHS/OIT/SCR - PRIMARY ROUTINE FOR PCC VISIT CREATION AND EDITING
+1 ;;3.0;ER VISIT SYSTEM;**1,2,5,6,8,10**;MAR 03, 2009;Build 23
+2 ;
+3 ; PCC vists are created with a call that includes an interface to the scheduling package
+4 ; IF a
+5 ; clinic code has been set up in ERS that identifies the Emergency
+6 ; Clinic for the user's current logon location (DUZ(2)) has been identified
+7 ; this visit is scheduled and can be "viewed" through EHR
+8 ;
+9 ; ELSE
+10 ; the visit is created and updated entirely through the ERS interface and is not "viewable" to EHR
+11 ;
+12 ;AMER*3.0*6;Turned off all V POV updates
+13 ;
+14 ; CURRENTLY: Only V POV and V PROVIDER support is provided by the ERS interface
+15 ;
VISIT(AMERPAT,AMERDATE) ; EP from AMER1 when patient is admitted W/O PIMS interface CHEKIN^AMERBSDU
+1 ; If site has indicated a CLINIC in paramaters, a scheduled walk-in visit is created
+2 ; and a PCC VISIT record is created by PIMS SCHEDULING (BSDU) pacage
+3 ; If not a PCC VISIT record created by ERS PACKAGE
+4 ; 1. Look for VISIT created at checkin
+5 ; 2. Create a VISIT if none exists for this patient on this date from this location
+6 ; 3. Return VISIT IEN if successful, 0 otherwise
+7 NEW IN,AMERVSIT,OUT,X,AMERVDR,AMEROPT,CLIN,HLOC
+8 ;
+9 ;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Pull default ER clinic and use
+10 SET CLIN=$$GET1^DIQ(9009082.5,DUZ(2)_",",.06,"I")
+11 ;
+12 ;If no clinic, get first one with a 30 mnemonic
+13 IF CLIN=""
SET CLIN=$ORDER(^AMER(3,"B",30,""))
+14 ;
+15 SET CLIN=$$GCLIN^AMERBSD(CLIN)
+16 SET HLOC=$PIECE(CLIN,U,2)
SET CLIN=$PIECE(CLIN,U)
+17 ;
+18 IF HLOC=""
Begin DoDot:1
+19 WRITE !,"SITE PARAMETERS have not been set up in the ERS PARAMETER option"
+20 WRITE !,"No entry for EMERGENCY MEDICINE could be located"
End DoDot:1
QUIT ""
+21 ;
+22 ;Set up for BSD
+23 SET IN("HOS LOC")=HLOC
+24 SET IN("CLINIC CODE")=CLIN
+25 ;
+26 ;End of CR#10213 Changes
+27 ;
+28 SET (AMERVSIT,AMERVDR)=""
+29 SET IN("PAT")=AMERPAT
+30 SET IN("VISIT DATE")=AMERDATE
+31 SET IN("SITE")=$GET(DUZ(2))
+32 ;To determine "visit type" for this visit, look in "PCC MASTER CONTROL" file
+33 ;get the "type of visit" that is set there
+34 SET IN("VISIT TYPE")=$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4)
+35 SET IN("USR")=DUZ
+36 ;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Now being set above
+37 ;S IN("HOS LOC")=$G(^AMER(2.5,DUZ(2),"SD"))
+38 ; Setting IN("APPT DATE") will create an appoinment for this time
IF IN("HOS LOC")'=""
SET IN("APPT DATE")=AMERDATE
+39 ; ER VISITS are "ambulatory"
SET IN("SRV CAT")="A"
+40 ; Only find a visit for a time that is close to time or ER VISIT
SET IN("TIME RANGE")=3
+41 ;
+42 DO GETVISIT^APCDAPI4(.IN,.OUT)
+43 IF $PIECE(OUT(0),U,1)=0
Begin DoDot:1
+44 DO EN^DDIOL("NO VISIT FOUND OR CREATED!!!","","!!")
+45 SET AMERVSIT=-1_"^"_$PIECE(OUT(0),U,2)
+46 QUIT
End DoDot:1
+47 IF +AMERVSIT<0
QUIT AMERVSIT
+48 SET AMERTEMP=0
+49 IF $PIECE(OUT(0),U,1)>1
Begin DoDot:1
+50 FOR
SET AMERTEMP=$ORDER(OUT(AMERTEMP))
IF AMERTEMP=""
QUIT
Begin DoDot:2
+51 DO EN^DDIOL("Multiple VISIT matches FOUND: "_AMERTEMP,"","!!")
+52 SET AMERVSIT=AMERTEMP
+53 QUIT
End DoDot:2
+54 QUIT
End DoDot:1
+55 IF $PIECE(OUT(0),U,1)=1
SET AMERVSIT=$ORDER(OUT(AMERTEMP))
+56 ; IF "Option use to create" is blank (no PIMS interface) update it with DIE call
+57 IF AMERVSIT>0
Begin DoDot:1
+58 IF $$GETVOPTN^AMERVSIT(AMERVSIT)'=""
QUIT
+59 SET AMEROPT=$$GETOPIEN^AMERVSIT("AMER IHS PCC LINK")
+60 IF +AMEROPT>0
SET AMERVDR=".24///"_+AMEROPT
+61 IF AMERVDR'=""
DO VSITDIE^AMERVSIT(AMERVSIT,AMERVDR)
+62 QUIT
End DoDot:1
+63 QUIT AMERVSIT
+64 ;
EXISTING(AMERDFN) ; EP FROM TRGSET^AMERD
+1 ; RETURNS VISIT IEN for patient that has not yet been discharged
+2 NEW IN,OUT,DIC,Y,AMERTEMP,AMERVSIT
+3 SET DIC="^AMERADM("
SET X=AMERDFN
SET DIC(0)="NXZ"
+4 DO ^DIC
+5 KILL DIC
+6 IF Y<0
QUIT -1
+7 SET AMERVSIT=$PIECE($GET(^AMERADM(AMERDFN,0)),U,3)
+8 QUIT AMERVSIT
SCHEDULD(AMERPAT,AMERDATE,AMERSCHD) ; EP from ERCHCKIN^AMERBDSU
+1 ; Called when user has selected to check-in ER patient for scheduled visit
+2 ; INPUT: AMERPAT - ien of PATIENT
+3 ; AMERDATE - the date and time of ER ADMISSION
+4 ; AMERSCHD - the date and time of scheduled ER APPOINTMENT
+5 ;
+6 ; Return VISIT IEN if check-in is successful, 0 otherwise
+7 ;
+8 NEW IN,AMERVSIT,OUT,X,AMERDIFF
+9 SET AMERVSIT=""
+10 SET AMERDIFF=AMERDATE-AMERSCHD
+11 IF AMERDIFF<0
SET AMERDIFF=+AMERDIFF
+12 SET IN("PAT")=AMERPAT
+13 SET IN("VISIT DATE")=AMERDATE
+14 SET IN("SITE")=$GET(DUZ(2))
+15 ;know the appointment date and want to check-in for this visit
+16 SET IN("APPT DATE")=AMERSCHD
+17 ; To determine "visit type" for this visit, look in the "PCC MASTER CONTROL" file
+18 ; and get the "type of visit" that is set there
+19 SET IN("VISIT TYPE")=$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4)
+20 SET IN("USR")=DUZ
+21 SET IN("HOS LOC")=$GET(^AMER(2.5,DUZ(2),"SD"))
+22 ; ER VISITS are "ambulatory"
SET IN("SRV CAT")="A"
+23 ; LOOK FOR A VISIT AROUND DIFFERENCE BETWEEN SCHEDULED AND VISIT TIME
SET IN("TIME RANGE")=AMERDIFF+10
+24 DO GETVISIT^APCDAPI4(.IN,.OUT)
+25 IF $PIECE(OUT(0),U,1)=0
Begin DoDot:1
+26 DO EN^DDIOL("NO VISIT FOUND OR CREATED!!!","","!!")
+27 SET AMERVSIT=-1_"^"_$PIECE(OUT(0),U,2)
+28 QUIT
End DoDot:1
+29 IF +AMERVSIT<0
QUIT AMERVSIT
+30 SET AMERTEMP=0
+31 IF $PIECE(OUT(0),U,1)>1
Begin DoDot:1
+32 FOR
SET AMERTEMP=$ORDER(OUT(AMERTEMP))
IF AMERTEMP=""
QUIT
Begin DoDot:2
+33 DO EN^DDIOL("Multiple VISIT matches FOUND: "_AMERTEMP,"","!!")
+34 SET AMERVSIT=AMERTEMP
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
+37 IF $PIECE(OUT(0),U,1)=1
SET AMERVSIT=$ORDER(OUT(AMERTEMP))
+38 QUIT AMERVSIT
+39 ;
FINDVSIT(AMERDA) ; EP FROM AMEREDTA,AMERVSIT,AMERSAV
+1 ; AMERDA-VISIT IEN FOR THIS ER VISIT
+2 ;
+3 ; RETURNS VISIT IEN for patient that has been discharged from ER IF SUCCESSFUL
+4 ; -1 IF NOT
+5 NEW IN,OUT,DIC,Y,AMERTEMP,AMERVSIT
+6 NEW AMERDFN,AMERDR
+7 SET AMERVSIT=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,3)
+8 IF AMERVSIT=""
SET AMERVSIT=-1
+9 QUIT AMERVSIT
+10 ;
VPROVTRG(AMERDFN,AMERPCC) ; EP From TRGSET^AMERD
+1 ; Updates VISIT information when entered through TRI option before discharge
+2 ; Update CLINIC code if needed in VISIT entry
+3 ; and add ADMITTING providers to V PROVIDER before discharge
+4 ; AMERDFN:patient ien
+5 ; AMERPCC:VISIT ien
+6 NEW AMERPROV,AMERPIEN,AMERTIME,DIC,Y,AMERVVAL,AMERCLNC,AMERVDR
+7 SET AMERVDR=""
+8 ; UPDATE PRESENTING COMPLAINT IF IT IS NOT THE SAME AS WHAT IS ALREADY IN VISIT FILE
+9 SET DIC="^AMERADM("
SET X=AMERDFN
SET DIC(0)="NXZ"
+10 DO ^DIC
+11 KILL DIC
+12 IF Y<0
QUIT
+13 SET AMERVVAL=$GET(^AUPNVSIT(AMERPCC,14))
+14 ; PRESENTING COMPLAINT
SET AMERCOMP=$PIECE($GET(Y(0)),U,10)
+15 IF AMERVVAL'=AMERCOMP
SET AMERVDR="1401///"_AMERCOMP
+16 ;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Clinic (and Location) now set in AMER2A
+17 ;UPDATE CLINIC IF IT IS NOT THE SAME AS WHAT IS ALREADY THERE
+18 ;S AMERVVAL=$P($G(^AUPNVSIT(AMERPCC,0)),U,8)
+19 ;S:AMERVVAL>0 AMERVVAL=$P($G(^DIC(40.7,AMERVVAL,0)),U,1)
+20 ;S AMERCLNC=$P($G(^TMP("AMER",$J,2,20)),U,2)
+21 ;I (AMERCLNC'="URGENT CARE") S AMERCLNC="EMERGENCY MEDICINE"
+22 ;I AMERVVAL'=AMERCLNC S AMERVDR=$S(AMERVDR'="":AMERVDR_";",1:""),AMERVDR=AMERVDR_".08///"_AMERCLNC
+23 ; NOW ADD V PROVIDER INFO
+24 ; TRIAGE NURSE
SET AMERPIEN=$PIECE($GET(Y(0)),U,19)
+25 ; TRIAGE TIME
SET AMERTIME=$PIECE($GET(Y(0)),U,21)
+26 ; Use admission time if not supplied
IF AMERTIME=""
SET AMERTIME=$PIECE($GET(Y(0)),U,2)
+27 ;IHS/OIT/SCR 12/16/08 - IF THE PROVIDER THAT WE ARE ABOUT TO ADD IS ALREADY ASSOCIATED TO THE VISIT THROUGH EHR, DON'T ADD AGAIN
+28 IF '$$PRVTHERE^AMERPCC1(AMERPIEN,AMERPCC)
Begin DoDot:1
+29 ; TRIAGE NURSE
IF $$ADDPRV^AMERPCC1(AMERPCC,AMERPIEN,AMERTIME,AMERDFN,"S","")<1
DO EN^DDIOL("UNABLE TO ADD V PROVIDER FOR TRIAGE NURSE","","!!")
+30 QUIT
End DoDot:1
+31 ; IF CLINIC OR PRESENTING COMPLAINT HAS BEEN MODIFIED, UPDATE IT THROUGH DIE
+32 IF AMERVDR'=""
DO VSITDIE^AMERVSIT(AMERPCC,AMERVDR)
+33 QUIT
VISITIN(AMERDFN,AMERPCC) ; EP From SAVE^AMER0
+1 ; Updates exisiting VISIT with admit information
+2 ; AMERDFN - PATIENT IEN TO IDENTIFY PATIENT IN ER ADMISSIONS FILE
+3 ; AMERPCC - PCC VISIT IEN FOR UPDATING VISIT FILE CHIEF COMPLAINT
+4 NEW DIC,Y,AMERCOMP,AMERVDR
+5 SET DIC="^AMERADM("
SET X=AMERDFN
SET DIC(0)="NXZ"
+6 DO ^DIC
+7 KILL DIC
+8 IF Y<0
QUIT
+9 ;AMER*3.0*8;Pull from new field
+10 ;S AMERCOMP=$P($G(Y(0)),U,10) ; PRESENTING COMPLAINT
+11 ; PRESENTING COMPLAINT
SET AMERCOMP=$GET(^AMERADM(AMERDFN,23))
+12 SET AMERVDR="1401///"_AMERCOMP
+13 DO VSITDIE^AMERVSIT(AMERPCC,AMERVDR)
+14 ;
+15 ;AMER*3*5;Added auditing call
+16 ;D LOG^AMERBUSA("P","E","AMERPCC","AMER: Updated ER visit presenting complaint ("_AMERDFN_")",AMERDFN)
+17 ;
+18 QUIT
SYNCHPCC(AMERDA) ; EP from UPDATE^AMERSAV, AMEREDPC, AND AMEREDTA
+1 ; This routine will:
+2 ; 0. Get the current patient DOB and chart number from patient reg APIs and use them to update the ER VISIT file if different
+3 ; 1. Identify an exisisting visit or make a new one
+4 ; 2. Update VISIT entry with
+5 ; 2a."CHIEF COMPLAINT" if different from ER VISIT Presenting Complaint
+6 ; 2b."CHECKOUT DAY AND TIME" if different from ER VISIT departure time
+7 ; 2C."OPTION USED TO CREATE" to "AMER IHS PCC LINK" if empty
+8 ;
+9 ; 3. Look for V PROVIDER entries and be sure identified "admitting" providers are in
+10 ; the ER VISIT file and that the times are the same
+11 ; 3a. Add admitting providers to V PROVIDER if they are not there
+12 ; 3b. Remove V PROVIDER entries if provider is not identified as admitting provider in ER VISIT file
+13 ; 3c. Modify V PROVIDER times if admitting provider time is not the same
+14 ;
+15 ; 4. Add V PROVIDER entries for discharge providers and ER CONSULANTS
+16 ;AMER*3.0*6;No longer add V POV entries
+17 ; 5. Add V POV entries for each valid ICD9 DX code in ER VISIT
+18 ;
+19 ; RETURNS VISIT IEN IF SUCCESFUL, 0 IF NOT
+20 ;
+21 NEW AMERCLN,AMERPCC,AMRSTRG,AMERQUIT,AMERDATE,AMERDEPT,AMERPAT,AMERDOC
+22 NEW AMEREVAL,AMERVVAL,AMERETIM,AMERVTIM,AMERFND,AMERVIEN,AMERVDR,AMERNEW
+23 NEW AMERVOPT,AMERPNTR,AMERDR,AMERDOB,AMERHRN,AMERETIM,AMERVTIM
+24 ; DON'T TRY TO SYNCH A VISIT UP IF THE VISIT DOESN'T EXIST
IF $GET(^AMERVSIT(AMERDA,0))=""
QUIT 0
+25 ; The value in the ER VISIT, the value in the VISIT file, the associated ER VISIT time and the associated VISIT time
+26 SET (AMERCLN,AMERDATE,AMERPAT,AMERVDR)=""
+27 ; AMERDATE IS THE TIME OF VISIT
SET AMERDATE=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,1)
+28 IF AMERDATE=""
QUIT 0
+29 ; AMERPAT IS THE IEN OF PATIENT
SET AMERPAT=$PIECE($GET(^AMERVSIT(AMERDA,0)),U,2)
+30 IF AMERPAT=""
QUIT 0
+31 ;IHS/OIT/SCR 01/09/09 - NOW LOOK AT PATIENT REG INFO AND UPDATE ERS IF NEEDED
+32 DO SYNCHERP^AMERERS(AMERPAT,AMERDA)
+33 IF $GET(^AMERVSIT(AMERDA,6))'=""
SET AMERDEPT=$PIECE(^AMERVSIT(AMERDA,6),U,2)
+34 SET AMERPCC=$$FINDVSIT^AMERPCC(AMERDA)
+35 ;IHS/OIT/SCR 05/07/09 patch 1
IF AMERPCC<0
QUIT 0
+36 ;
+37 ;GDIT/HS/BEE 05/10/2018;CR#10213 - AMER*3.0*10 - Sync clinic and hospital location
+38 DO SYNCCL^AMER2A(AMERDA,AMERPCC)
+39 ;
+40 ; Compare ER "Presenting Complaint" to VISIT "Chief Complaint"
+41 SET AMEREVAL=$GET(^AMERVSIT(AMERDA,1))
+42 SET AMERVVAL=$GET(^AUPNVSIT(AMERPCC,14))
+43 ;IHS/OIT/SCR 05/07/09 patch 1
SET AMERVVAL=$TRANSLATE(AMERVVAL,";","~")
+44 IF AMERVVAL=""
SET AMERVDR=$SELECT(AMERVDR'="":AMERVDR_";",1:"")
SET AMERVDR=AMERVDR_"1401///"_AMEREVAL
+45 IF '$TEST
IF (AMEREVAL'=AMERVVAL)
Begin DoDot:1
+46 ;IHS/OIT/SCR 12/18 - if the values are different, user needs to choose
+47 DO EN^DDIOL("**The value for CHIEF COMPLAINT in the PCC visit file is different from ERS PRESENTING COMPLAINT**","","!!?3")
+48 DO EN^DDIOL("PCC CHIEF COMPLAINT: "_$GET(^AUPNVSIT(AMERPCC,14)),"","!?3")
+49 DO EN^DDIOL("ERS PRESENTING COMPLAINT: "_AMEREVAL,"","!?3")
+50 SET DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"
+51 SET DIR("A")="Which would you like to do"
+52 DO ^DIR
KILL DIR
+53 SET AMERANS=+Y
+54 IF Y=""!(Y="^")!(AMERANS=2)
Begin DoDot:2
+55 ;KEEP THE PCC VISIT INFO - PUT IT INTO THE AMER VISIT
+56 SET AMERDR="1////"_AMERVVAL
+57 DO DIE^AMEREDIT(AMERDA,AMERDR)
+58 QUIT
End DoDot:2
+59 IF AMERANS=1
Begin DoDot:2
+60 ;UPDATE THE PCC VISIT
+61 SET AMERVDR=$SELECT(AMERVDR'="":AMERVDR_";",1:"")
SET AMERVDR=AMERVDR_"1401///"_AMEREVAL
+62 QUIT
End DoDot:2
+63 QUIT
End DoDot:1
+64 ; GET THE DEPARTURE OUT TIME FROM VISIT AND COMPARE TO CHECK OUT TIME IN ER VISIT
+65 ; AMERDEPT IS DEPARTURE TIME
SET AMEREVAL=$PIECE($GET(^AMERVSIT(AMERDA,6)),U,2)
+66 ;CHECKOUT TIME
SET AMERVVAL=$PIECE(^AUPNVSIT(AMERPCC,0),"^",18)
+67 IF (AMEREVAL'=AMERVVAL)
Begin DoDot:1
+68 IF AMERVVAL'=""
Begin DoDot:2
+69 ;IHS/OIT/SCR 12/18 - if the values are different, user needs to choose
+70 SET AMERVTIM=$$EDDISPL^AMEREDAU(AMERVVAL,"D")
+71 SET AMERETIM=$$EDDISPL^AMEREDAU(AMEREVAL,"D")
+72 DO EN^DDIOL("**The value for DEPARTURE DATE in the PCC visit file is different from ERS CHECKOUT DAY**","","!!?3")
+73 DO EN^DDIOL("PCC VISIT DEPARTURE DATE: "_AMERVTIM,"","!?3")
+74 DO EN^DDIOL("ERS CHECKOUT DATE: "_AMERETIM,"","!?3")
+75 SET DIR(0)="SO^1:Correct PCC data using ERS data;2:Correct ERS data using PCC data"
+76 SET DIR("A")="Which would you like to do"
+77 DO ^DIR
KILL DIR
+78 SET AMERANS=+Y
+79 IF Y=""!(Y="^")!(AMERANS=2)
Begin DoDot:3
+80 ;KEEP THE PCC VISIT INFO - PUT IT INTO THE AMER VISIT
+81 SET AMERDR="6.2////"_AMERVVAL
+82 DO DIE^AMEREDIT(AMERDA,AMERDR)
+83 QUIT
End DoDot:3
+84 IF AMERANS=1
Begin DoDot:3
+85 ;UPDATE THE PCC VISIT WITH WHAT USER JUST ENTERED
+86 ; patch 2
SET AMERVDR=$SELECT(AMERVDR'="":AMERVDR_";",1:"")
SET AMERVDR=AMERVDR_".18///"_AMEREVAL
+87 QUIT
End DoDot:3
+88 QUIT
End DoDot:2
+89 IF '$TEST
SET AMERVDR=$SELECT(AMERVDR'="":AMERVDR_";",1:"")
SET AMERVDR=AMERVDR_".18////"_AMEREVAL
+90 QUIT
End DoDot:1
+91 ; GET OPTION USED TO CREATE VISIT - IF NOT THERE, IDENTIFY "AMER IHS PCC LINK" OPTION
+92 ; IEN OF OPTION THAT CREATED VISIT
SET AMERVVAL=$PIECE($GET(^AUPNVSIT(AMERPCC,0)),U,24)
+93 IF AMERVVAL=""
SET AMERVDR=$SELECT(AMERVDR'="":AMERVDR_";",1:"")
SET AMERVDR=AMERVDR_".24///"_$$GETOPIEN^AMERVSIT("AMER IHS PCC LINK")
+94 ; update VISIT file with identified changes
IF AMERVDR'=""
DO VSITDIE^AMERVSIT(AMERPCC,AMERVDR)
+95 KILL AMERVVAL,AMEREVAL,AMERVDR
+96 DO SYNCHPRV^AMERPCC1(AMERDA,AMERPCC,AMERPAT)
+97 SET AMERDOC=$PIECE($GET(^AMERVSIT(AMERDA,6)),U,3)
+98 ;
+99 ;AMER*3.0*6;No longer update V POV
+100 ;D SYNCHPOV^AMERPCC2(AMERDA,AMERPCC,AMERPAT,AMERDATE,AMERDOC,AMERCLN)
+101 QUIT
+102 ;
SAVPCCA(AMERPCC,AMERDFN) ; EP FROM AMER WHEN AN ADMISSION AND PCC VISIT HAS JUST BEEN CREATED
+1 ; UPDATES THE ER ADMISSION FILE WITH THE PCC VISIT IEN ASSOCIATED WITH IT
+2 ; INPUT AMERPCC - THE IEN OF THE PCC VISIT
+3 ; AMERDFN - THE IEN OF THE PATIENT
+4 NEW DIE,DA,DR
+5 SET DR="1.1////"_AMERPCC
+6 SET DIE="^AMERADM("
SET DA=AMERDFN
+7 LOCK +^FILE(9009081):2
+8 IF $TEST
Begin DoDot:1
+9 DO ^DIE
+10 LOCK -^FILE(9009081)
+11 QUIT
End DoDot:1
+12 IF '$TEST
DO EN^DDIOL("Unable to update ER ADMISSION file","","!!")
+13 QUIT
SAVPCCO(AMERPCC,AMERDA) ; EP FROM AMER CHANGPAT^AMERVSIT
+1 ; WHEN AN ADMISSION AND PCC VISIT HAS JUST BEEN CREATED OR WHEN PATIENT IS BEING CHANGED AND A NEW PCC VISIT IS CREATED
+2 ; UPDATES THE ER ADMISSION FILE WITH THE PCC VISIT IEN ASSOCIATED TO IT
+3 ; INPUT AMERPCC - THE IEN OF THE PCC VISIT FILE ENTRY
+4 ; AMERDATE - THE DATE/TIME OF ADMISSION
+5 NEW DIE,DA,DR
+6 SET DR=".03////"_AMERPCC
+7 SET DIE="^AMERVSIT("
SET DA=AMERDA
+8 LOCK +^FILE(9009080):2
+9 IF $TEST
Begin DoDot:1
+10 DO ^DIE
+11 LOCK -^FILE(9009080)
+12 QUIT
End DoDot:1
+13 IF '$TEST
DO EN^DDIOL("Unable to update ER VISIT file","","!!")
+14 QUIT
