- 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 Jan 18, 2025@02:53:18 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