- 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 Feb 18, 2025@23:18:37 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
