EDPQPCE ;SLC/KCM - Retrieve PCE information for ED Visits ; 9/20/21 11:53am
;;2.0;EMERGENCY DEPARTMENT;**6,2,16**;Feb 24, 2012;Build 6
;
DXPRI(AREA,LOG) ; return primary diagnosis
N DXLST
D DXALL(AREA,LOG,.DXLST)
Q $G(DXLST(1)) ;$P( ,U,2)
;
DXALL(AREA,LOG,DXLST) ; build list of diagnoses for a visit
N EDPVISIT S EDPVISIT=$P(^EDP(230,LOG,0),U,12)
I EDPVISIT,$P($G(^EDPB(231.9,AREA,1)),U,2) D DXPCE(EDPVISIT,.DXLST) I 1
E D DXFREE(LOG,.DXLST)
Q
DXPCE(EDPVISIT,DXLST) ; return a list of diagnoses from PCE
; DRP 04062012 ADD ICD10 API CALLS EDP*2.0*2 Begin
N I,X,CODE,NAME,DX,EDPLVDT,EDPLCIEN,EDPLCTYPE
K ^TMP("PXKENC",$J)
D ENCEVENT^PXAPI(EDPVISIT)
S I=0,DX=0 F S I=$O(^TMP("PXKENC",$J,EDPVISIT,"POV",I)) Q:'I D
. S X=^TMP("PXKENC",$J,EDPVISIT,"POV",I,0)
. S EDPLVDT=$P($G(^TMP("PXKENC",$J,EDPVISIT,"VST",EDPVISIT,0)),U,1)
. S EDPLCTYPE=$$VER^EDPLEX($$CSYS^EDPLEX(EDPLVDT))
. S EDPLCIEN=$P(X,U)
. S CODE=$P($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPLVDT),U,2) ; DRP
. ;DRP end EDP*2.0*2 changes
. S NAME=$G(^AUTNPOV($P(X,U,4),0))
. I 'NAME S NAME=$$LD^ICDEX(80,EDPLCIEN,EDPLCTYPE) ; *16
. S:NAME'[EDPLCTYPE NAME=NAME_" ("_$G(EDPLCTYPE)_" "_CODE_")"
. S DX=DX+1,DX($S($P(X,U,12)="P":DX,1:DX*10000))=CODE_U_NAME_U_EDPLCTYPE
S X="",DXLST=DX F I=1:1 S X=$O(DX(X)) Q:X="" S DXLST(I)=DX(X)
Q
DXFREE(LOG,DXLST) ; return free text diagnoses from ED LOG file
N I,CODE,NAME,X4,DX,EDPLVDT,EDPLCIEN,EDPLCTYPE
S I=0,DX=0 F S I=$O(^EDP(230,LOG,4,I)) Q:'I D
. S X4=^EDP(230,LOG,4,I,0)
. ; DRP 04062012 ADD ICD10 API CALLS EDP*2.0*2 Begin
. S EDPLVDT=$P(^EDP(230,LOG,0),U,8) ;added this line DRP
. S EDPLCIEN=$P(X4,U,2) S:EDPLCIEN CODE=$P($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPLVDT),U,2)
. S:$G(CODE)'="" EDPLCTYPE=$$VER^EDPLEX($$CSYS^EDPLEX(EDPLVDT))
. S NAME=$P(X4,U,1)
. S:NAME'[$G(EDPLCTYPE) NAME=NAME_" ("_$G(EDPLCTYPE)_" "_$G(CODE)_")" ; drp added this line
. S DX=DX+1,DX($S(+$P(X4,U,3):DX,1:DX*10000))=$G(CODE)_U_NAME_U_$G(EDPLCTYPE)
. ;DRP end EDP*2.0*2 changes
S X="",DXLST=DX F I=1:1 S X=$O(DX(X)) Q:X="" S DXLST(I)=DX(X)
Q
DXFREE2(LOG,DXLST) ; return ONLY the free text diagnosis
N I,CODE,NAME,X4,DX
S I=0,DX=0 F S I=$O(^EDP(230,LOG,4,I)) Q:'I D
. S X4=^EDP(230,LOG,4,I,0)
. S NAME=$P(X4,U,1)
. S DX=DX+1,DX($S(+$P(X4,U,3):DX,1:DX*10000))=NAME
S X="",DXLST=DX F I=1:1 S X=$O(DX(X)) Q:X="" S DXLST(I)=DX(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPQPCE 2407 printed Oct 16, 2024@17:53:02 Page 2
EDPQPCE ;SLC/KCM - Retrieve PCE information for ED Visits ; 9/20/21 11:53am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6,2,16**;Feb 24, 2012;Build 6
+2 ;
DXPRI(AREA,LOG) ; return primary diagnosis
+1 NEW DXLST
+2 DO DXALL(AREA,LOG,.DXLST)
+3 ;$P( ,U,2)
QUIT $GET(DXLST(1))
+4 ;
DXALL(AREA,LOG,DXLST) ; build list of diagnoses for a visit
+1 NEW EDPVISIT
SET EDPVISIT=$PIECE(^EDP(230,LOG,0),U,12)
+2 IF EDPVISIT
IF $PIECE($GET(^EDPB(231.9,AREA,1)),U,2)
DO DXPCE(EDPVISIT,.DXLST)
IF 1
+3 IF '$TEST
DO DXFREE(LOG,.DXLST)
+4 QUIT
DXPCE(EDPVISIT,DXLST) ; return a list of diagnoses from PCE
+1 ; DRP 04062012 ADD ICD10 API CALLS EDP*2.0*2 Begin
+2 NEW I,X,CODE,NAME,DX,EDPLVDT,EDPLCIEN,EDPLCTYPE
+3 KILL ^TMP("PXKENC",$JOB)
+4 DO ENCEVENT^PXAPI(EDPVISIT)
+5 SET I=0
SET DX=0
FOR
SET I=$ORDER(^TMP("PXKENC",$JOB,EDPVISIT,"POV",I))
if 'I
QUIT
Begin DoDot:1
+6 SET X=^TMP("PXKENC",$JOB,EDPVISIT,"POV",I,0)
+7 SET EDPLVDT=$PIECE($GET(^TMP("PXKENC",$JOB,EDPVISIT,"VST",EDPVISIT,0)),U,1)
+8 SET EDPLCTYPE=$$VER^EDPLEX($$CSYS^EDPLEX(EDPLVDT))
+9 SET EDPLCIEN=$PIECE(X,U)
+10 ; DRP
SET CODE=$PIECE($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPLVDT),U,2)
+11 ;DRP end EDP*2.0*2 changes
+12 SET NAME=$GET(^AUTNPOV($PIECE(X,U,4),0))
+13 ; *16
IF 'NAME
SET NAME=$$LD^ICDEX(80,EDPLCIEN,EDPLCTYPE)
+14 if NAME'[EDPLCTYPE
SET NAME=NAME_" ("_$GET(EDPLCTYPE)_" "_CODE_")"
+15 SET DX=DX+1
SET DX($SELECT($PIECE(X,U,12)="P":DX,1:DX*10000))=CODE_U_NAME_U_EDPLCTYPE
End DoDot:1
+16 SET X=""
SET DXLST=DX
FOR I=1:1
SET X=$ORDER(DX(X))
if X=""
QUIT
SET DXLST(I)=DX(X)
+17 QUIT
DXFREE(LOG,DXLST) ; return free text diagnoses from ED LOG file
+1 NEW I,CODE,NAME,X4,DX,EDPLVDT,EDPLCIEN,EDPLCTYPE
+2 SET I=0
SET DX=0
FOR
SET I=$ORDER(^EDP(230,LOG,4,I))
if 'I
QUIT
Begin DoDot:1
+3 SET X4=^EDP(230,LOG,4,I,0)
+4 ; DRP 04062012 ADD ICD10 API CALLS EDP*2.0*2 Begin
+5 ;added this line DRP
SET EDPLVDT=$PIECE(^EDP(230,LOG,0),U,8)
+6 SET EDPLCIEN=$PIECE(X4,U,2)
if EDPLCIEN
SET CODE=$PIECE($$ICDDATA^EDPLEX("DIAG",EDPLCIEN,EDPLVDT),U,2)
+7 if $GET(CODE)'=""
SET EDPLCTYPE=$$VER^EDPLEX($$CSYS^EDPLEX(EDPLVDT))
+8 SET NAME=$PIECE(X4,U,1)
+9 ; drp added this line
if NAME'[$GET(EDPLCTYPE)
SET NAME=NAME_" ("_$GET(EDPLCTYPE)_" "_$GET(CODE)_")"
+10 SET DX=DX+1
SET DX($SELECT(+$PIECE(X4,U,3):DX,1:DX*10000))=$GET(CODE)_U_NAME_U_$GET(EDPLCTYPE)
+11 ;DRP end EDP*2.0*2 changes
End DoDot:1
+12 SET X=""
SET DXLST=DX
FOR I=1:1
SET X=$ORDER(DX(X))
if X=""
QUIT
SET DXLST(I)=DX(X)
+13 QUIT
DXFREE2(LOG,DXLST) ; return ONLY the free text diagnosis
+1 NEW I,CODE,NAME,X4,DX
+2 SET I=0
SET DX=0
FOR
SET I=$ORDER(^EDP(230,LOG,4,I))
if 'I
QUIT
Begin DoDot:1
+3 SET X4=^EDP(230,LOG,4,I,0)
+4 SET NAME=$PIECE(X4,U,1)
+5 SET DX=DX+1
SET DX($SELECT(+$PIECE(X4,U,3):DX,1:DX*10000))=NAME
End DoDot:1
+6 SET X=""
SET DXLST=DX
FOR I=1:1
SET X=$ORDER(DX(X))
if X=""
QUIT
SET DXLST(I)=DX(X)
+7 QUIT
