Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EDPLPCE

EDPLPCE.m

Go to the documentation of this file.
  1. EDPLPCE ;SLC/KCM - Create a Visit ;2/28/12 08:33am
  1. ;;2.0;EMERGENCY DEPARTMENT;**2,12**;Feb 24, 2012;Build 2
  1. ;
  1. ; DBIA# SUPPORTED
  1. ; ----- --------- ------------------------------------
  1. ; 1894 Cont Sub ENCEVENT^PXAPI
  1. ; 1889 Cont Sub DATA2PCE^PXAPI
  1. ; 5747 Sup $$CODEC^ICDEX
  1. ; 10103 Sup $$NOW^XLFDT,$$FMADD^XLFDT
  1. ; 2053 Sup FILE^DIE
  1. ; 2263 Sup $$GET^XPAR,GETLST^XPAR
  1. ; 1890 Cont Sub $$DELVFILE^PXAPI
  1. ; 5679 Sup $$ONE^LEXU
  1. ; 1573 Sup $$CPTONE^LEXU
  1. ; 2028 Cont Sub ^AUPNVSIT(
  1. ; 10048 Sup ^DIC(9.4
  1. ; 2815 Sup ^ICPT("B"
  1. ;
  1. UPDVISIT(LOG,PCE) ; Get / Create a Visit
  1. ; PCE is list of potential updates to the visit
  1. ; PCE(TYP,n)=type^ien^code^label^add^del^upd^prim^qty
  1. N DFN,TS,LOC,X0,I,X,PRVVISIT
  1. S X0=^EDP(230,LOG,0),DFN=$P(X0,U,6),TS=$P(X0,U,8),LOC=$P(X0,U,14)
  1. I 'LOC S LOC=$$DFLTLOC(DFN)
  1. I 'DFN!('TS)!('LOC) Q 0 ; not enough info
  1. ;
  1. N EDPDATA,EDPVISIT,EDPPCHG
  1. S EDPVISIT=$P(X0,U,12),EDPPCHG=0 S:'EDPVISIT TS=$$TS4VISIT(DFN,LOC,TS,.PRVVISIT)
  1. ;
  1. ; if closed record and no visit, bail
  1. I $P(X0,U,7),'EDPVISIT Q 0
  1. ;
  1. ; if no visit, but diagnoses exist, xfer the diagnoses
  1. I 'EDPVISIT D XFERDIAG(LOG,.PCE)
  1. ; remove current primary provider(s) if there is a new one
  1. I $G(PCE("PRI")) D
  1. . N IPRV,XPRV,OLDPRI,EDPLCSYS,EDPLCIEN,GETVISIT ; Begin EDP*2.0*2 changes
  1. . S GETVISIT=0
  1. . I $G(PRVVISIT) S GETVISIT=PRVVISIT ;if we have no current visit but there is a recent visit we'll link to.
  1. . I $G(EDPVISIT) S GETVISIT=EDPVISIT ;we have a current visit
  1. . I 'GETVISIT Q
  1. . K ^TMP("PXKENC",$J)
  1. . D ENCEVENT^PXAPI(GETVISIT)
  1. . S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,GETVISIT,"PRV",IPRV)) Q:'IPRV D
  1. .. S XPRV=^TMP("PXKENC",$J,GETVISIT,"PRV",IPRV,0)
  1. .. Q:$P(XPRV,U,4)'="P"
  1. .. I +XPRV'=$G(PCE("PRI")) S EDPDATA("PROVIDER",IPRV,"NAME")=+XPRV,EDPDATA("PROVIDER",IPRV,"PRIMARY")=0
  1. ; add any new providers that were entered
  1. S I=0 F S I=$O(PCE("PRV",I)) Q:'I D
  1. . S EDPDATA("PROVIDER",I,"NAME")=+PCE("PRV",I)
  1. . I +PCE("PRV",I)=$G(PCE("PRI")) S EDPDATA("PROVIDER",I,"PRIMARY")=1,EDPPCHG=1
  1. ; update diagnoses
  1. ; DRP 04062012 Begin EDP*2.0*2 Changes
  1. S I=0 F S I=$O(PCE("POV",I)) Q:'I D
  1. . S X=PCE("POV",I)
  1. . Q:'($P(X,U,5)!$P(X,U,6)!$P(X,U,7)) ; no updates for this diagnosis
  1. . I $P(X,U,2) D
  1. .. S EDPLCSYS=$$CSYS^EDPLEX(TS)
  1. .. I EDPLCSYS="ICD" D
  1. ... N EDPLCIEN S EDPLCIEN=$$ONE^LEXU($P(X,U,2),TS,EDPLCSYS)
  1. ... Q:'$L(EDPLCIEN)
  1. ... S:$L(EDPLCIEN) $P(X,U,2)=$P($$ICDDATA^EDPLEX(EDPLCSYS,EDPLCIEN,TS,"E"),U,1) ;drp patch 2
  1. ...Q
  1. .. N CODE S CODE=$$CODEC^ICDEX(80,$P(X,U,2))
  1. .. S $P(X,U,3)=CODE
  1. . Q:'$L($P(X,U,3)) ; not coded
  1. . S EDPLCIEN=$P($$ICDDATA^EDPLEX("DIAG",$P(X,U,3),TS,"E"),U,1) Q:'EDPLCIEN
  1. . S EDPDATA("DX/PL",I,"DIAGNOSIS")=EDPLCIEN
  1. . ;DRP end EDP*2.0*2 changes
  1. . S EDPDATA("DX/PL",I,"NARRATIVE")=$P(X,U,4)
  1. . I $P(X,U,8) S EDPDATA("DX/PL",I,"PRIMARY")=1
  1. . I $P(X,U,6) S EDPDATA("DX/PL",I,"DELETE")=1
  1. ; update procedures
  1. S I=0 F S I=$O(PCE("CPT",I)) Q:'I D
  1. . S X=PCE("CPT",I)
  1. . Q:'($P(X,U,5)!$P(X,U,6)!$P(X,U,7)) ; no updates for this procedure
  1. . I $P(X,U,2) D
  1. .. N CODE S CODE=$$CPTONE^LEXU($P(X,U,2),TS)
  1. .. S $P(X,U,3)=CODE
  1. . Q:'$L($P(X,U,3)) ; not coded
  1. . S IEN=+$O(^ICPT("B",$P(X,U,3),0))
  1. . S EDPDATA("PROCEDURE",I,"PROCEDURE")=IEN
  1. . S EDPDATA("PROCEDURE",I,"QTY")=$S($P(X,U,9):$P(X,U,9),1:1)
  1. . S EDPDATA("PROCEDURE",I,"NARRATIVE")=$P(X,U,4)
  1. . I $P(X,U,6) S EDPDATA("PROCEDURE",I,"DELETE")=1
  1. ; exit if no updates
  1. Q:'$D(EDPDATA) 0
  1. ;
  1. N EDPKG,EDPSRC,EDPERR,OK
  1. S EDPKG=$O(^DIC(9.4,"B","EMERGENCY DEPARTMENT",0))
  1. S EDPSRC="EDP TRACKING LOG"
  1. S EDPDATA("ENCOUNTER",1,"PATIENT")=DFN
  1. S EDPDATA("ENCOUNTER",1,"HOS LOC")=LOC
  1. S EDPDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A"
  1. S EDPDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
  1. I 'EDPVISIT S EDPDATA("ENCOUNTER",1,"ENC D/T")=TS
  1. ;
  1. S OK=$$DATA2PCE^PXAPI("EDPDATA",EDPKG,EDPSRC,.EDPVISIT,,,,EDPPCHG,.EDPERR)
  1. I OK<1 D
  1. . N NOW S NOW=$$NOW^XLFDT
  1. . S ^XTMP("EDPERR-PCE-"_LOG,0)=$$FMADD^XLFDT(NOW,7)_U_NOW_U_"ED PCE Error"
  1. . S ^XTMP("EDPERR-PCE-"_LOG,"VISIT")=EDPVISIT_U_OK
  1. . M ^XTMP("EDPERR-PCE-"_LOG,"DATA")=EDPDATA
  1. . M ^XTMP("EDPERR-PCE-"_LOG,"ERR")=EDPERR
  1. ;
  1. ; update the visit pointer in 230
  1. I EDPVISIT,OK,($P(X0,U,12)'=EDPVISIT) D
  1. . N FDA,DIERR,ERR
  1. . S FDA(230,LOG_",",.12)=EDPVISIT
  1. . D FILE^DIE("","FDA","ERR")
  1. Q
  1. XFERDIAG(LOG,PCE) ; Setup diagnosis list based on entries in 230
  1. ;DRP 04062012 Begin EDP*2.0*2 ICD10 CHANGES
  1. N IEN,X0,CODE,EDPDOI,EDPLCIEN
  1. K PCE("POV") ; not worried about adds & subtracts, so start over
  1. S IEN=0 F S IEN=$O(^EDP(230,LOG,4,IEN)) Q:'IEN D
  1. . S X0=$G(^EDP(230,LOG,4,IEN,0)),EDPDOI=$P(^EDP(230,LOG,0),U,8) ; GET DATE OF INTEREST
  1. . S PCE("POV",IEN)="POV^^^^1",EDPLCIEN=$P(X0,U,2)
  1. . S CODE=$P($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPDOI),U,2)
  1. . ;DRP End EDP*2.0*2 Changes
  1. . S $P(PCE("POV",IEN),U,3)=CODE ; code
  1. . S $P(PCE("POV",IEN),U,4)=$P(X0,U) ; text
  1. . S $P(PCE("POV",IEN),U,8)=$P(X0,U,3) ; primary
  1. Q
  1. DELVISIT(LOG) ; Delete visit for stub entry
  1. N EDPVISIT S EDPVISIT=$P(^EDP(230,LOG,0),U,12)
  1. Q:'EDPVISIT
  1. ;
  1. N FDA,DIERR,ERR
  1. S FDA(230,LOG_",",.12)="@"
  1. D FILE^DIE("","FDA","ERR")
  1. ;
  1. S OK=$$DELVFILE^PXAPI("ALL",EDPVISIT,"EMERGENCY DEPARTMENT","EDP TRACKING LOG")
  1. Q
  1. DFLTLOC(DFN) ; Return the default location for the ED
  1. N EDPLST,I,LST,TM,BEG,END,LOCS
  1. D GETLST^XPAR(.EDPLST,EDPSITE_";DIC(4,","EDPF LOCATION","Q")
  1. S TM=$E($P($$NOW^XLFDT,".",2)_"0000",1,4)
  1. ; put time ranges first, then sequence
  1. S I=0 F S I=$O(EDPLST(I)) Q:'I D
  1. . ; put sequence at end of list
  1. . I EDPLST(I)'["-" S LST(+EDPLST(I)*1000)=EDPLST(I),LOCS(+$P(EDPLST(I),U,2))="" Q
  1. . ; put time ranges at top of list
  1. . S BEG=+$P(EDPLST(I),"-"),END=+$P(EDPLST(I),"-",2)
  1. . I (TM<BEG)!(TM>END) Q ; eliminating times that don't include NOW
  1. . S LST(I)=EDPLST(I),LOCS(+$P(EDPLST(I),U,2))=""
  1. ;
  1. ; look for visits to ED locations within the last hour
  1. N BACKTO,VTM,VLOC,LOC
  1. S BACKTO=$$FMADD^XLFDT($$NOW^XLFDT,0,-1),LOC=0
  1. I $G(DFN) D
  1. . S VTM="" F S VTM=$O(^AUPNVSIT("AET",DFN,VTM),-1) Q:VTM<BACKTO D
  1. .. S VLOC=0 F S VLOC=$O(^AUPNVSIT("AET",DFN,VTM,VLOC)) Q:'VLOC D Q:LOC
  1. ... I $D(LOCS(VLOC)) S LOC=VLOC
  1. Q:LOC LOC
  1. ;
  1. ; otherwise, return the highest ranked location
  1. S I=$O(LST(0)) S:I LOC=$P(LST(I),U,2)
  1. Q LOC
  1. ;
  1. TS4VISIT(DFN,LOC,TS,PRVVISIT) ; Return visit time if there is already a visit
  1. N BACKTO,VTM,VLOC,VCAT,NEWTS
  1. S BACKTO=$$FMADD^XLFDT($$NOW^XLFDT,0,-1),NEWTS=""
  1. S VTM="" F S VTM=$O(^AUPNVSIT("AET",DFN,VTM),-1) Q:VTM<BACKTO D
  1. . S VLOC=0 F S VLOC=$O(^AUPNVSIT("AET",DFN,VTM,VLOC)) Q:'VLOC Q:VLOC'=LOC D
  1. .. S VCAT="" F S VCAT=$O(^AUPNVSIT("AET",DFN,VTM,VLOC,VCAT)) Q:VCAT'="P" D
  1. ... S NEWTS=VTM
  1. ... S PRVVISIT=$O(^AUPNVSIT("AET",DFN,VTM,VLOC,VCAT,""))
  1. Q:NEWTS NEWTS
  1. Q TS
  1. ;
  1. TEST ; Test creation of encounter
  1. N DFN S DFN=100679
  1. S LOC=$$GET^XPAR(DUZ(2)_";DIC(4,","EDPF LOCATION")
  1. ;
  1. N EDPKG,EDPSRC,OK
  1. S EDPKG=$O(^DIC(9.4,"B","EMERGENCY DEPARTMENT",0))
  1. S EDPSRC="EDP TRACKING LOG"
  1. S EDPDATA("ENCOUNTER",1,"PATIENT")=DFN
  1. S EDPDATA("ENCOUNTER",1,"HOS LOC")=LOC
  1. S EDPDATA("ENCOUNTER",1,"SERVICE CATEGORY")="A"
  1. S EDPDATA("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
  1. S EDPDATA("ENCOUNTER",1,"ENC D/T")=$$NOW^XLFDT
  1. ;
  1. ;S EDPDATA("DX/PL",1,"DIAGNOSIS")=$O(^ICD9("BA","V70.3 ",0))
  1. ;S EDPDATA("PROCEDURE",1,"PROCEDURE")=$O(^ICPT("B","99201",0))
  1. S EDPDATA("PROVIDER",1,"NAME")=9066
  1. ;
  1. S OK=$$DATA2PCE^PXAPI("EDPDATA",EDPKG,EDPSRC,.EDPVISIT)
  1. Q