EDPLPCE ;SLC/KCM - Create a Visit ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**2,12**;Feb 24, 2012;Build 2
;
; DBIA# SUPPORTED
; ----- --------- ------------------------------------
; 1894 Cont Sub ENCEVENT^PXAPI
; 1889 Cont Sub DATA2PCE^PXAPI
; 5747 Sup $$CODEC^ICDEX
; 10103 Sup $$NOW^XLFDT,$$FMADD^XLFDT
; 2053 Sup FILE^DIE
; 2263 Sup $$GET^XPAR,GETLST^XPAR
; 1890 Cont Sub $$DELVFILE^PXAPI
; 5679 Sup $$ONE^LEXU
; 1573 Sup $$CPTONE^LEXU
; 2028 Cont Sub ^AUPNVSIT(
; 10048 Sup ^DIC(9.4
; 2815 Sup ^ICPT("B"
;
UPDVISIT(LOG,PCE) ; Get / Create a Visit
; PCE is list of potential updates to the visit
; PCE(TYP,n)=type^ien^code^label^add^del^upd^prim^qty
N DFN,TS,LOC,X0,I,X,PRVVISIT
S X0=^EDP(230,LOG,0),DFN=$P(X0,U,6),TS=$P(X0,U,8),LOC=$P(X0,U,14)
I 'LOC S LOC=$$DFLTLOC(DFN)
I 'DFN!('TS)!('LOC) Q 0 ; not enough info
;
N EDPDATA,EDPVISIT,EDPPCHG
S EDPVISIT=$P(X0,U,12),EDPPCHG=0 S:'EDPVISIT TS=$$TS4VISIT(DFN,LOC,TS,.PRVVISIT)
;
; if closed record and no visit, bail
I $P(X0,U,7),'EDPVISIT Q 0
;
; if no visit, but diagnoses exist, xfer the diagnoses
I 'EDPVISIT D XFERDIAG(LOG,.PCE)
; remove current primary provider(s) if there is a new one
I $G(PCE("PRI")) D
. N IPRV,XPRV,OLDPRI,EDPLCSYS,EDPLCIEN,GETVISIT ; Begin EDP*2.0*2 changes
. S GETVISIT=0
. I $G(PRVVISIT) S GETVISIT=PRVVISIT ;if we have no current visit but there is a recent visit we'll link to.
. I $G(EDPVISIT) S GETVISIT=EDPVISIT ;we have a current visit
. I 'GETVISIT Q
. K ^TMP("PXKENC",$J)
. D ENCEVENT^PXAPI(GETVISIT)
. S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,GETVISIT,"PRV",IPRV)) Q:'IPRV D
.. S XPRV=^TMP("PXKENC",$J,GETVISIT,"PRV",IPRV,0)
.. Q:$P(XPRV,U,4)'="P"
.. I +XPRV'=$G(PCE("PRI")) S EDPDATA("PROVIDER",IPRV,"NAME")=+XPRV,EDPDATA("PROVIDER",IPRV,"PRIMARY")=0
; add any new providers that were entered
S I=0 F S I=$O(PCE("PRV",I)) Q:'I D
. S EDPDATA("PROVIDER",I,"NAME")=+PCE("PRV",I)
. I +PCE("PRV",I)=$G(PCE("PRI")) S EDPDATA("PROVIDER",I,"PRIMARY")=1,EDPPCHG=1
; update diagnoses
; DRP 04062012 Begin EDP*2.0*2 Changes
S I=0 F S I=$O(PCE("POV",I)) Q:'I D
. S X=PCE("POV",I)
. Q:'($P(X,U,5)!$P(X,U,6)!$P(X,U,7)) ; no updates for this diagnosis
. I $P(X,U,2) D
.. S EDPLCSYS=$$CSYS^EDPLEX(TS)
.. I EDPLCSYS="ICD" D
... N EDPLCIEN S EDPLCIEN=$$ONE^LEXU($P(X,U,2),TS,EDPLCSYS)
... Q:'$L(EDPLCIEN)
... S:$L(EDPLCIEN) $P(X,U,2)=$P($$ICDDATA^EDPLEX(EDPLCSYS,EDPLCIEN,TS,"E"),U,1) ;drp patch 2
...Q
.. N CODE S CODE=$$CODEC^ICDEX(80,$P(X,U,2))
.. S $P(X,U,3)=CODE
. Q:'$L($P(X,U,3)) ; not coded
. S EDPLCIEN=$P($$ICDDATA^EDPLEX("DIAG",$P(X,U,3),TS,"E"),U,1) Q:'EDPLCIEN
. S EDPDATA("DX/PL",I,"DIAGNOSIS")=EDPLCIEN
. ;DRP end EDP*2.0*2 changes
. S EDPDATA("DX/PL",I,"NARRATIVE")=$P(X,U,4)
. I $P(X,U,8) S EDPDATA("DX/PL",I,"PRIMARY")=1
. I $P(X,U,6) S EDPDATA("DX/PL",I,"DELETE")=1
; update procedures
S I=0 F S I=$O(PCE("CPT",I)) Q:'I D
. S X=PCE("CPT",I)
. Q:'($P(X,U,5)!$P(X,U,6)!$P(X,U,7)) ; no updates for this procedure
. I $P(X,U,2) D
.. N CODE S CODE=$$CPTONE^LEXU($P(X,U,2),TS)
.. S $P(X,U,3)=CODE
. Q:'$L($P(X,U,3)) ; not coded
. S IEN=+$O(^ICPT("B",$P(X,U,3),0))
. S EDPDATA("PROCEDURE",I,"PROCEDURE")=IEN
. S EDPDATA("PROCEDURE",I,"QTY")=$S($P(X,U,9):$P(X,U,9),1:1)
. S EDPDATA("PROCEDURE",I,"NARRATIVE")=$P(X,U,4)
. I $P(X,U,6) S EDPDATA("PROCEDURE",I,"DELETE")=1
; exit if no updates
Q:'$D(EDPDATA) 0
;
N EDPKG,EDPSRC,EDPERR,OK
S EDPKG=$O(^DIC(9.4,"B","EMERGENCY DEPARTMENT",0))
S EDPSRC="EDP TRACKING LOG"
S EDPDATA("ENCOUNTER",1,"PATIENT")=DFN
S EDPDATA("ENCOUNTER",1,"HOS LOC")=LOC
S EDPDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A"
S EDPDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
I 'EDPVISIT S EDPDATA("ENCOUNTER",1,"ENC D/T")=TS
;
S OK=$$DATA2PCE^PXAPI("EDPDATA",EDPKG,EDPSRC,.EDPVISIT,,,,EDPPCHG,.EDPERR)
I OK<1 D
. N NOW S NOW=$$NOW^XLFDT
. S ^XTMP("EDPERR-PCE-"_LOG,0)=$$FMADD^XLFDT(NOW,7)_U_NOW_U_"ED PCE Error"
. S ^XTMP("EDPERR-PCE-"_LOG,"VISIT")=EDPVISIT_U_OK
. M ^XTMP("EDPERR-PCE-"_LOG,"DATA")=EDPDATA
. M ^XTMP("EDPERR-PCE-"_LOG,"ERR")=EDPERR
;
; update the visit pointer in 230
I EDPVISIT,OK,($P(X0,U,12)'=EDPVISIT) D
. N FDA,DIERR,ERR
. S FDA(230,LOG_",",.12)=EDPVISIT
. D FILE^DIE("","FDA","ERR")
Q
XFERDIAG(LOG,PCE) ; Setup diagnosis list based on entries in 230
;DRP 04062012 Begin EDP*2.0*2 ICD10 CHANGES
N IEN,X0,CODE,EDPDOI,EDPLCIEN
K PCE("POV") ; not worried about adds & subtracts, so start over
S IEN=0 F S IEN=$O(^EDP(230,LOG,4,IEN)) Q:'IEN D
. S X0=$G(^EDP(230,LOG,4,IEN,0)),EDPDOI=$P(^EDP(230,LOG,0),U,8) ; GET DATE OF INTEREST
. S PCE("POV",IEN)="POV^^^^1",EDPLCIEN=$P(X0,U,2)
. S CODE=$P($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPDOI),U,2)
. ;DRP End EDP*2.0*2 Changes
. S $P(PCE("POV",IEN),U,3)=CODE ; code
. S $P(PCE("POV",IEN),U,4)=$P(X0,U) ; text
. S $P(PCE("POV",IEN),U,8)=$P(X0,U,3) ; primary
Q
DELVISIT(LOG) ; Delete visit for stub entry
N EDPVISIT S EDPVISIT=$P(^EDP(230,LOG,0),U,12)
Q:'EDPVISIT
;
N FDA,DIERR,ERR
S FDA(230,LOG_",",.12)="@"
D FILE^DIE("","FDA","ERR")
;
S OK=$$DELVFILE^PXAPI("ALL",EDPVISIT,"EMERGENCY DEPARTMENT","EDP TRACKING LOG")
Q
DFLTLOC(DFN) ; Return the default location for the ED
N EDPLST,I,LST,TM,BEG,END,LOCS
D GETLST^XPAR(.EDPLST,EDPSITE_";DIC(4,","EDPF LOCATION","Q")
S TM=$E($P($$NOW^XLFDT,".",2)_"0000",1,4)
; put time ranges first, then sequence
S I=0 F S I=$O(EDPLST(I)) Q:'I D
. ; put sequence at end of list
. I EDPLST(I)'["-" S LST(+EDPLST(I)*1000)=EDPLST(I),LOCS(+$P(EDPLST(I),U,2))="" Q
. ; put time ranges at top of list
. S BEG=+$P(EDPLST(I),"-"),END=+$P(EDPLST(I),"-",2)
. I (TM<BEG)!(TM>END) Q ; eliminating times that don't include NOW
. S LST(I)=EDPLST(I),LOCS(+$P(EDPLST(I),U,2))=""
;
; look for visits to ED locations within the last hour
N BACKTO,VTM,VLOC,LOC
S BACKTO=$$FMADD^XLFDT($$NOW^XLFDT,0,-1),LOC=0
I $G(DFN) D
. S VTM="" F S VTM=$O(^AUPNVSIT("AET",DFN,VTM),-1) Q:VTM<BACKTO D
.. S VLOC=0 F S VLOC=$O(^AUPNVSIT("AET",DFN,VTM,VLOC)) Q:'VLOC D Q:LOC
... I $D(LOCS(VLOC)) S LOC=VLOC
Q:LOC LOC
;
; otherwise, return the highest ranked location
S I=$O(LST(0)) S:I LOC=$P(LST(I),U,2)
Q LOC
;
TS4VISIT(DFN,LOC,TS,PRVVISIT) ; Return visit time if there is already a visit
N BACKTO,VTM,VLOC,VCAT,NEWTS
S BACKTO=$$FMADD^XLFDT($$NOW^XLFDT,0,-1),NEWTS=""
S VTM="" F S VTM=$O(^AUPNVSIT("AET",DFN,VTM),-1) Q:VTM<BACKTO D
. S VLOC=0 F S VLOC=$O(^AUPNVSIT("AET",DFN,VTM,VLOC)) Q:'VLOC Q:VLOC'=LOC D
.. S VCAT="" F S VCAT=$O(^AUPNVSIT("AET",DFN,VTM,VLOC,VCAT)) Q:VCAT'="P" D
... S NEWTS=VTM
... S PRVVISIT=$O(^AUPNVSIT("AET",DFN,VTM,VLOC,VCAT,""))
Q:NEWTS NEWTS
Q TS
;
TEST ; Test creation of encounter
N DFN S DFN=100679
S LOC=$$GET^XPAR(DUZ(2)_";DIC(4,","EDPF LOCATION")
;
N EDPKG,EDPSRC,OK
S EDPKG=$O(^DIC(9.4,"B","EMERGENCY DEPARTMENT",0))
S EDPSRC="EDP TRACKING LOG"
S EDPDATA("ENCOUNTER",1,"PATIENT")=DFN
S EDPDATA("ENCOUNTER",1,"HOS LOC")=LOC
S EDPDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A"
S EDPDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
S EDPDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
;
;S EDPDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
;S EDPDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99201",0))
S EDPDATA("PROVIDER",1,"NAME")=9066
;
S OK=$$DATA2PCE^PXAPI("EDPDATA",EDPKG,EDPSRC,.EDPVISIT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPLPCE 7610 printed Sep 02, 2024@18:37:24 Page 2
EDPLPCE ;SLC/KCM - Create a Visit ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**2,12**;Feb 24, 2012;Build 2
+2 ;
+3 ; DBIA# SUPPORTED
+4 ; ----- --------- ------------------------------------
+5 ; 1894 Cont Sub ENCEVENT^PXAPI
+6 ; 1889 Cont Sub DATA2PCE^PXAPI
+7 ; 5747 Sup $$CODEC^ICDEX
+8 ; 10103 Sup $$NOW^XLFDT,$$FMADD^XLFDT
+9 ; 2053 Sup FILE^DIE
+10 ; 2263 Sup $$GET^XPAR,GETLST^XPAR
+11 ; 1890 Cont Sub $$DELVFILE^PXAPI
+12 ; 5679 Sup $$ONE^LEXU
+13 ; 1573 Sup $$CPTONE^LEXU
+14 ; 2028 Cont Sub ^AUPNVSIT(
+15 ; 10048 Sup ^DIC(9.4
+16 ; 2815 Sup ^ICPT("B"
+17 ;
UPDVISIT(LOG,PCE) ; Get / Create a Visit
+1 ; PCE is list of potential updates to the visit
+2 ; PCE(TYP,n)=type^ien^code^label^add^del^upd^prim^qty
+3 NEW DFN,TS,LOC,X0,I,X,PRVVISIT
+4 SET X0=^EDP(230,LOG,0)
SET DFN=$PIECE(X0,U,6)
SET TS=$PIECE(X0,U,8)
SET LOC=$PIECE(X0,U,14)
+5 IF 'LOC
SET LOC=$$DFLTLOC(DFN)
+6 ; not enough info
IF 'DFN!('TS)!('LOC)
QUIT 0
+7 ;
+8 NEW EDPDATA,EDPVISIT,EDPPCHG
+9 SET EDPVISIT=$PIECE(X0,U,12)
SET EDPPCHG=0
if 'EDPVISIT
SET TS=$$TS4VISIT(DFN,LOC,TS,.PRVVISIT)
+10 ;
+11 ; if closed record and no visit, bail
+12 IF $PIECE(X0,U,7)
IF 'EDPVISIT
QUIT 0
+13 ;
+14 ; if no visit, but diagnoses exist, xfer the diagnoses
+15 IF 'EDPVISIT
DO XFERDIAG(LOG,.PCE)
+16 ; remove current primary provider(s) if there is a new one
+17 IF $GET(PCE("PRI"))
Begin DoDot:1
+18 ; Begin EDP*2.0*2 changes
NEW IPRV,XPRV,OLDPRI,EDPLCSYS,EDPLCIEN,GETVISIT
+19 SET GETVISIT=0
+20 ;if we have no current visit but there is a recent visit we'll link to.
IF $GET(PRVVISIT)
SET GETVISIT=PRVVISIT
+21 ;we have a current visit
IF $GET(EDPVISIT)
SET GETVISIT=EDPVISIT
+22 IF 'GETVISIT
QUIT
+23 KILL ^TMP("PXKENC",$JOB)
+24 DO ENCEVENT^PXAPI(GETVISIT)
+25 SET IPRV=0
FOR
SET IPRV=$ORDER(^TMP("PXKENC",$JOB,GETVISIT,"PRV",IPRV))
if 'IPRV
QUIT
Begin DoDot:2
+26 SET XPRV=^TMP("PXKENC",$JOB,GETVISIT,"PRV",IPRV,0)
+27 if $PIECE(XPRV,U,4)'="P"
QUIT
+28 IF +XPRV'=$GET(PCE("PRI"))
SET EDPDATA("PROVIDER",IPRV,"NAME")=+XPRV
SET EDPDATA("PROVIDER",IPRV,"PRIMARY")=0
End DoDot:2
End DoDot:1
+29 ; add any new providers that were entered
+30 SET I=0
FOR
SET I=$ORDER(PCE("PRV",I))
if 'I
QUIT
Begin DoDot:1
+31 SET EDPDATA("PROVIDER",I,"NAME")=+PCE("PRV",I)
+32 IF +PCE("PRV",I)=$GET(PCE("PRI"))
SET EDPDATA("PROVIDER",I,"PRIMARY")=1
SET EDPPCHG=1
End DoDot:1
+33 ; update diagnoses
+34 ; DRP 04062012 Begin EDP*2.0*2 Changes
+35 SET I=0
FOR
SET I=$ORDER(PCE("POV",I))
if 'I
QUIT
Begin DoDot:1
+36 SET X=PCE("POV",I)
+37 ; no updates for this diagnosis
if '($PIECE(X,U,5)!$PIECE(X,U,6)!$PIECE(X,U,7))
QUIT
+38 IF $PIECE(X,U,2)
Begin DoDot:2
+39 SET EDPLCSYS=$$CSYS^EDPLEX(TS)
+40 IF EDPLCSYS="ICD"
Begin DoDot:3
+41 NEW EDPLCIEN
SET EDPLCIEN=$$ONE^LEXU($PIECE(X,U,2),TS,EDPLCSYS)
+42 if '$LENGTH(EDPLCIEN)
QUIT
+43 ;drp patch 2
if $LENGTH(EDPLCIEN)
SET $PIECE(X,U,2)=$PIECE($$ICDDATA^EDPLEX(EDPLCSYS,EDPLCIEN,TS,"E"),U,1)
+44 QUIT
End DoDot:3
+45 NEW CODE
SET CODE=$$CODEC^ICDEX(80,$PIECE(X,U,2))
+46 SET $PIECE(X,U,3)=CODE
End DoDot:2
+47 ; not coded
if '$LENGTH($PIECE(X,U,3))
QUIT
+48 SET EDPLCIEN=$PIECE($$ICDDATA^EDPLEX("DIAG",$PIECE(X,U,3),TS,"E"),U,1)
if 'EDPLCIEN
QUIT
+49 SET EDPDATA("DX/PL",I,"DIAGNOSIS")=EDPLCIEN
+50 ;DRP end EDP*2.0*2 changes
+51 SET EDPDATA("DX/PL",I,"NARRATIVE")=$PIECE(X,U,4)
+52 IF $PIECE(X,U,8)
SET EDPDATA("DX/PL",I,"PRIMARY")=1
+53 IF $PIECE(X,U,6)
SET EDPDATA("DX/PL",I,"DELETE")=1
End DoDot:1
+54 ; update procedures
+55 SET I=0
FOR
SET I=$ORDER(PCE("CPT",I))
if 'I
QUIT
Begin DoDot:1
+56 SET X=PCE("CPT",I)
+57 ; no updates for this procedure
if '($PIECE(X,U,5)!$PIECE(X,U,6)!$PIECE(X,U,7))
QUIT
+58 IF $PIECE(X,U,2)
Begin DoDot:2
+59 NEW CODE
SET CODE=$$CPTONE^LEXU($PIECE(X,U,2),TS)
+60 SET $PIECE(X,U,3)=CODE
End DoDot:2
+61 ; not coded
if '$LENGTH($PIECE(X,U,3))
QUIT
+62 SET IEN=+$ORDER(^ICPT("B",$PIECE(X,U,3),0))
+63 SET EDPDATA("PROCEDURE",I,"PROCEDURE")=IEN
+64 SET EDPDATA("PROCEDURE",I,"QTY")=$SELECT($PIECE(X,U,9):$PIECE(X,U,9),1:1)
+65 SET EDPDATA("PROCEDURE",I,"NARRATIVE")=$PIECE(X,U,4)
+66 IF $PIECE(X,U,6)
SET EDPDATA("PROCEDURE",I,"DELETE")=1
End DoDot:1
+67 ; exit if no updates
+68 if '$DATA(EDPDATA)
QUIT 0
+69 ;
+70 NEW EDPKG,EDPSRC,EDPERR,OK
+71 SET EDPKG=$ORDER(^DIC(9.4,"B","EMERGENCY DEPARTMENT",0))
+72 SET EDPSRC="EDP TRACKING LOG"
+73 SET EDPDATA("ENCOUNTER",1,"PATIENT")=DFN
+74 SET EDPDATA("ENCOUNTER",1,"HOS LOC")=LOC
+75 SET EDPDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A"
+76 SET EDPDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
+77 IF 'EDPVISIT
SET EDPDATA("ENCOUNTER",1,"ENC D/T")=TS
+78 ;
+79 SET OK=$$DATA2PCE^PXAPI("EDPDATA",EDPKG,EDPSRC,.EDPVISIT,,,,EDPPCHG,.EDPERR)
+80 IF OK<1
Begin DoDot:1
+81 NEW NOW
SET NOW=$$NOW^XLFDT
+82 SET ^XTMP("EDPERR-PCE-"_LOG,0)=$$FMADD^XLFDT(NOW,7)_U_NOW_U_"ED PCE Error"
+83 SET ^XTMP("EDPERR-PCE-"_LOG,"VISIT")=EDPVISIT_U_OK
+84 MERGE ^XTMP("EDPERR-PCE-"_LOG,"DATA")=EDPDATA
+85 MERGE ^XTMP("EDPERR-PCE-"_LOG,"ERR")=EDPERR
End DoDot:1
+86 ;
+87 ; update the visit pointer in 230
+88 IF EDPVISIT
IF OK
IF ($PIECE(X0,U,12)'=EDPVISIT)
Begin DoDot:1
+89 NEW FDA,DIERR,ERR
+90 SET FDA(230,LOG_",",.12)=EDPVISIT
+91 DO FILE^DIE("","FDA","ERR")
End DoDot:1
+92 QUIT
XFERDIAG(LOG,PCE) ; Setup diagnosis list based on entries in 230
+1 ;DRP 04062012 Begin EDP*2.0*2 ICD10 CHANGES
+2 NEW IEN,X0,CODE,EDPDOI,EDPLCIEN
+3 ; not worried about adds & subtracts, so start over
KILL PCE("POV")
+4 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,LOG,4,IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 ; GET DATE OF INTEREST
SET X0=$GET(^EDP(230,LOG,4,IEN,0))
SET EDPDOI=$PIECE(^EDP(230,LOG,0),U,8)
+6 SET PCE("POV",IEN)="POV^^^^1"
SET EDPLCIEN=$PIECE(X0,U,2)
+7 SET CODE=$PIECE($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPDOI),U,2)
+8 ;DRP End EDP*2.0*2 Changes
+9 ; code
SET $PIECE(PCE("POV",IEN),U,3)=CODE
+10 ; text
SET $PIECE(PCE("POV",IEN),U,4)=$PIECE(X0,U)
+11 ; primary
SET $PIECE(PCE("POV",IEN),U,8)=$PIECE(X0,U,3)
End DoDot:1
+12 QUIT
DELVISIT(LOG) ; Delete visit for stub entry
+1 NEW EDPVISIT
SET EDPVISIT=$PIECE(^EDP(230,LOG,0),U,12)
+2 if 'EDPVISIT
QUIT
+3 ;
+4 NEW FDA,DIERR,ERR
+5 SET FDA(230,LOG_",",.12)="@"
+6 DO FILE^DIE("","FDA","ERR")
+7 ;
+8 SET OK=$$DELVFILE^PXAPI("ALL",EDPVISIT,"EMERGENCY DEPARTMENT","EDP TRACKING LOG")
+9 QUIT
DFLTLOC(DFN) ; Return the default location for the ED
+1 NEW EDPLST,I,LST,TM,BEG,END,LOCS
+2 DO GETLST^XPAR(.EDPLST,EDPSITE_";DIC(4,","EDPF LOCATION","Q")
+3 SET TM=$EXTRACT($PIECE($$NOW^XLFDT,".",2)_"0000",1,4)
+4 ; put time ranges first, then sequence
+5 SET I=0
FOR
SET I=$ORDER(EDPLST(I))
if 'I
QUIT
Begin DoDot:1
+6 ; put sequence at end of list
+7 IF EDPLST(I)'["-"
SET LST(+EDPLST(I)*1000)=EDPLST(I)
SET LOCS(+$PIECE(EDPLST(I),U,2))=""
QUIT
+8 ; put time ranges at top of list
+9 SET BEG=+$PIECE(EDPLST(I),"-")
SET END=+$PIECE(EDPLST(I),"-",2)
+10 ; eliminating times that don't include NOW
IF (TM<BEG)!(TM>END)
QUIT
+11 SET LST(I)=EDPLST(I)
SET LOCS(+$PIECE(EDPLST(I),U,2))=""
End DoDot:1
+12 ;
+13 ; look for visits to ED locations within the last hour
+14 NEW BACKTO,VTM,VLOC,LOC
+15 SET BACKTO=$$FMADD^XLFDT($$NOW^XLFDT,0,-1)
SET LOC=0
+16 IF $GET(DFN)
Begin DoDot:1
+17 SET VTM=""
FOR
SET VTM=$ORDER(^AUPNVSIT("AET",DFN,VTM),-1)
if VTM<BACKTO
QUIT
Begin DoDot:2
+18 SET VLOC=0
FOR
SET VLOC=$ORDER(^AUPNVSIT("AET",DFN,VTM,VLOC))
if 'VLOC
QUIT
Begin DoDot:3
+19 IF $DATA(LOCS(VLOC))
SET LOC=VLOC
End DoDot:3
if LOC
QUIT
End DoDot:2
End DoDot:1
+20 if LOC
QUIT LOC
+21 ;
+22 ; otherwise, return the highest ranked location
+23 SET I=$ORDER(LST(0))
if I
SET LOC=$PIECE(LST(I),U,2)
+24 QUIT LOC
+25 ;
TS4VISIT(DFN,LOC,TS,PRVVISIT) ; Return visit time if there is already a visit
+1 NEW BACKTO,VTM,VLOC,VCAT,NEWTS
+2 SET BACKTO=$$FMADD^XLFDT($$NOW^XLFDT,0,-1)
SET NEWTS=""
+3 SET VTM=""
FOR
SET VTM=$ORDER(^AUPNVSIT("AET",DFN,VTM),-1)
if VTM<BACKTO
QUIT
Begin DoDot:1
+4 SET VLOC=0
FOR
SET VLOC=$ORDER(^AUPNVSIT("AET",DFN,VTM,VLOC))
if 'VLOC
QUIT
if VLOC'=LOC
QUIT
Begin DoDot:2
+5 SET VCAT=""
FOR
SET VCAT=$ORDER(^AUPNVSIT("AET",DFN,VTM,VLOC,VCAT))
if VCAT'="P"
QUIT
Begin DoDot:3
+6 SET NEWTS=VTM
+7 SET PRVVISIT=$ORDER(^AUPNVSIT("AET",DFN,VTM,VLOC,VCAT,""))
End DoDot:3
End DoDot:2
End DoDot:1
+8 if NEWTS
QUIT NEWTS
+9 QUIT TS
+10 ;
TEST ; Test creation of encounter
+1 NEW DFN
SET DFN=100679
+2 SET LOC=$$GET^XPAR(DUZ(2)_";DIC(4,","EDPF LOCATION")
+3 ;
+4 NEW EDPKG,EDPSRC,OK
+5 SET EDPKG=$ORDER(^DIC(9.4,"B","EMERGENCY DEPARTMENT",0))
+6 SET EDPSRC="EDP TRACKING LOG"
+7 SET EDPDATA("ENCOUNTER",1,"PATIENT")=DFN
+8 SET EDPDATA("ENCOUNTER",1,"HOS LOC")=LOC
+9 SET EDPDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A"
+10 SET EDPDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
+11 SET EDPDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
+12 ;
+13 ;S EDPDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
+14 ;S EDPDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99201",0))
+15 SET EDPDATA("PROVIDER",1,"NAME")=9066
+16 ;
+17 SET OK=$$DATA2PCE^PXAPI("EDPDATA",EDPKG,EDPSRC,.EDPVISIT)
+18 QUIT
