PXRHS08 ;ISL/SBW,PKR - PCE Visit Patient Education data extract ;03/21/2022
;;1.0;PCE PATIENT CARE ENCOUNTER;**13,16,211,217**;Aug 12, 1996;Build 134
EDUC(DFN,BEGDT,ENDDT,OCCLIM,CATCODE) ; Control branching
;INPUT : DFN - Pointer to PATIENT file (#2)
; BEGDT - Beginning date/time in internal FileMan format
; - Defaults to one year prior to today's date
; ENDDT - Ending date/time in internal FileMan format
; - Defaults to today's date at 11:59 pm
; OCCLIM - Maximum number of days for which data is returned
; (If multiple visits on a given day, all data for
; these visit will be returned) or an "R" for
; only the most recent occurrence of each topic
; Note: If event date is used, it may appear that too
; many occurrences are retrieved but it is
; it is based on visit date not event date.
; CATCODE - Pattern Match which controls visit data that is
; returned (Can include multiple codes)
; A = AMBULATORY
; H = HOSPITALIZATION
; I = IN HOSPITAL
; C = CHART REVIEW
; T = TELECOMMUNICATIONS
; N = NOT FOUND
; S = DAY SURGERY
; O = OBSERVATION
; E = EVENT (HISTORICAL)
; R = NURSING HOME
; D = DAILY HOSPITALIZATION DATA
; X = ANCILLARY PACKAGE DAILY DATA
;
;OUTPUT :
; Data from V Patient Education (9000010.16) file
; ^TMP("PXPE",$J,InvDt,TOPIC,IFN,0) = PRINT NAME or TOPIC [E;.01]
; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
; ^ LEVEL OF UNDERSTANDING [E;.06] ^ ORDERING PROVIDER [E;1202]
; ^ ENCOUNTER PROVIDER [E;1204]
; ^TMP("PXPE",$J,InvDt,TOPIC,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
; ^ HOSP. LOC. ABBREVIATION [E;44;1]
; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
; ^TMP("PXPE",$J,InvDt,TOPIC,IFN,"S") = DATA SOURCE [E;81203]
;
; [] = [I(nternal)/E(xternal); Optional file #; Record #]
; Subscripts:
; InvDt - Inverse FileMan date of DATE OF event or visit
; TOPIC - Patient Education Topic
; IFN - Internal Record #
;
Q:$G(DFN)']""!'$D(^PXRMINDX(9000010.16,"PI",DFN))
S:+$G(OCCLIM)'>0 OCCLIM=999
S:+$G(BEGDT)'>0 BEGDT=DT-10000
S:+$G(ENDDT)'>0 ENDDT=DT_".235959"
K ^TMP("PXPE",$J)
N DATE,EDUIEN,VPEDIEN
S EDUIEN=""
F S EDUIEN=$O(^PXRMINDX(9000010.16,"PI",DFN,EDUIEN)) Q:EDUIEN="" D
. S CNT=0,DATE=""
. F S DATE=$O(^PXRMINDX(9000010.16,"PI",DFN,EDUIEN,DATE),-1) Q:(DATE="")!(CNT'<OCCLIM) D
.. S VPEDIEN=0
.. F S VPEDIEN=$O(^PXRMINDX(9000010.16,"PI",DFN,EDUIEN,DATE,VPEDIEN)) Q:(VPEDIEN="")!(CNT'<OCCLIM) D
... I $$ADDEDU(EDUIEN,VPEDIEN,BEGDT,ENDDT)=1 S CNT=CNT+1
Q
;
ADDEDU(EDUIEN,VPEDIEN,BEGDT,ENDDT) ;
N COMMENT,DATASRC,EPROV,EVENTDT,HLOC,HLOCABB,IDT,LEVEL,OPROV
N PNAME,TMP0,TMP12,TMP220,TMP811,TMP812,TOPIC,VDATA
S TMP0=$G(^AUPNVPED(VPEDIEN,0))
S TMP12=$G(^AUPNVPED(VPEDIEN,12))
S VDATA=$$GETVDATA^PXRHS03($P(TMP0,U,3))
S EVENTDT=$P(TMP12,U,1)
I EVENTDT="" S EVENTDT=$P(VDATA,U,1)
;Is it in the date range?
I (EVENTDT<BEGDT)!(EVENTDT>ENDDT) Q 0
;Only get data with passed serv. cat.
I $G(CATCODE)'[$P(VDATA,U,3) Q 0
S TMP220=$G(^AUPNVPED(VPEDIEN,220))
I TMP220'="" S TMP220=TMP220_U_$P(^AUTTEDT(EDUIEN,220),U,6)
S TMP811=$G(^AUPNVPED(VPEDIEN,811))
S TMP812=$G(^AUPNVPED(VPEDIEN,812))
S TOPIC=$P(^AUTTEDT(EDUIEN,0),U,1)
S PNAME=$P($G(^AUTTEDT(EDUIEN,0)),U,4)
I PNAME="" S PNAME=TOPIC
S LEVEL=$$EXTERNAL^DILFD(9000010.16,.06,"",$P(TMP0,U,6))
S OPROV=$$GET1^DIQ(9000010.16,VPEDIEN_",",1202)
S EPROV=$$GET1^DIQ(9000010.16,VPEDIEN_",",1204)
S HLOC=$P(VDATA,U,5)
S HLOCABB=$P(VDATA,U,6)
S DATASRC=$P(TMP812,U,3)
S COMMENT=TMP811
S IDT=9999999-EVENTDT
S ^TMP("PXPE",$J,IDT,TOPIC,VPEDIEN,0)=PNAME_U_EVENTDT_U_LEVEL_U_OPROV_U_EPROV
S ^TMP("PXPE",$J,IDT,TOPIC,VPEDIEN,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
S ^TMP("PXPE",$J,IDT,TOPIC,VPEDIEN,"COM")=COMMENT
S ^TMP("PXPE",$J,IDT,TOPIC,VPEDIEN,"MEASUREMENT")=TMP220
S ^TMP("PXPE",$J,IDT,TOPIC,VPEDIEN,"S")=DATASRC
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRHS08 4367 printed Nov 22, 2024@17:40:29 Page 2
PXRHS08 ;ISL/SBW,PKR - PCE Visit Patient Education data extract ;03/21/2022
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13,16,211,217**;Aug 12, 1996;Build 134
EDUC(DFN,BEGDT,ENDDT,OCCLIM,CATCODE) ; Control branching
+1 ;INPUT : DFN - Pointer to PATIENT file (#2)
+2 ; BEGDT - Beginning date/time in internal FileMan format
+3 ; - Defaults to one year prior to today's date
+4 ; ENDDT - Ending date/time in internal FileMan format
+5 ; - Defaults to today's date at 11:59 pm
+6 ; OCCLIM - Maximum number of days for which data is returned
+7 ; (If multiple visits on a given day, all data for
+8 ; these visit will be returned) or an "R" for
+9 ; only the most recent occurrence of each topic
+10 ; Note: If event date is used, it may appear that too
+11 ; many occurrences are retrieved but it is
+12 ; it is based on visit date not event date.
+13 ; CATCODE - Pattern Match which controls visit data that is
+14 ; returned (Can include multiple codes)
+15 ; A = AMBULATORY
+16 ; H = HOSPITALIZATION
+17 ; I = IN HOSPITAL
+18 ; C = CHART REVIEW
+19 ; T = TELECOMMUNICATIONS
+20 ; N = NOT FOUND
+21 ; S = DAY SURGERY
+22 ; O = OBSERVATION
+23 ; E = EVENT (HISTORICAL)
+24 ; R = NURSING HOME
+25 ; D = DAILY HOSPITALIZATION DATA
+26 ; X = ANCILLARY PACKAGE DAILY DATA
+27 ;
+28 ;OUTPUT :
+29 ; Data from V Patient Education (9000010.16) file
+30 ; ^TMP("PXPE",$J,InvDt,TOPIC,IFN,0) = PRINT NAME or TOPIC [E;.01]
+31 ; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
+32 ; ^ LEVEL OF UNDERSTANDING [E;.06] ^ ORDERING PROVIDER [E;1202]
+33 ; ^ ENCOUNTER PROVIDER [E;1204]
+34 ; ^TMP("PXPE",$J,InvDt,TOPIC,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+35 ; ^ HOSP. LOC. ABBREVIATION [E;44;1]
+36 ; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
+37 ; ^TMP("PXPE",$J,InvDt,TOPIC,IFN,"S") = DATA SOURCE [E;81203]
+38 ;
+39 ; [] = [I(nternal)/E(xternal); Optional file #; Record #]
+40 ; Subscripts:
+41 ; InvDt - Inverse FileMan date of DATE OF event or visit
+42 ; TOPIC - Patient Education Topic
+43 ; IFN - Internal Record #
+44 ;
+45 if $GET(DFN)']""!'$DATA(^PXRMINDX(9000010.16,"PI",DFN))
QUIT
+46 if +$GET(OCCLIM)'>0
SET OCCLIM=999
+47 if +$GET(BEGDT)'>0
SET BEGDT=DT-10000
+48 if +$GET(ENDDT)'>0
SET ENDDT=DT_".235959"
+49 KILL ^TMP("PXPE",$JOB)
+50 NEW DATE,EDUIEN,VPEDIEN
+51 SET EDUIEN=""
+52 FOR
SET EDUIEN=$ORDER(^PXRMINDX(9000010.16,"PI",DFN,EDUIEN))
if EDUIEN=""
QUIT
Begin DoDot:1
+53 SET CNT=0
SET DATE=""
+54 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.16,"PI",DFN,EDUIEN,DATE),-1)
if (DATE="")!(CNT'<OCCLIM)
QUIT
Begin DoDot:2
+55 SET VPEDIEN=0
+56 FOR
SET VPEDIEN=$ORDER(^PXRMINDX(9000010.16,"PI",DFN,EDUIEN,DATE,VPEDIEN))
if (VPEDIEN="")!(CNT'<OCCLIM)
QUIT
Begin DoDot:3
+57 IF $$ADDEDU(EDUIEN,VPEDIEN,BEGDT,ENDDT)=1
SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+58 QUIT
+59 ;
ADDEDU(EDUIEN,VPEDIEN,BEGDT,ENDDT) ;
+1 NEW COMMENT,DATASRC,EPROV,EVENTDT,HLOC,HLOCABB,IDT,LEVEL,OPROV
+2 NEW PNAME,TMP0,TMP12,TMP220,TMP811,TMP812,TOPIC,VDATA
+3 SET TMP0=$GET(^AUPNVPED(VPEDIEN,0))
+4 SET TMP12=$GET(^AUPNVPED(VPEDIEN,12))
+5 SET VDATA=$$GETVDATA^PXRHS03($PIECE(TMP0,U,3))
+6 SET EVENTDT=$PIECE(TMP12,U,1)
+7 IF EVENTDT=""
SET EVENTDT=$PIECE(VDATA,U,1)
+8 ;Is it in the date range?
+9 IF (EVENTDT<BEGDT)!(EVENTDT>ENDDT)
QUIT 0
+10 ;Only get data with passed serv. cat.
+11 IF $GET(CATCODE)'[$PIECE(VDATA,U,3)
QUIT 0
+12 SET TMP220=$GET(^AUPNVPED(VPEDIEN,220))
+13 IF TMP220'=""
SET TMP220=TMP220_U_$PIECE(^AUTTEDT(EDUIEN,220),U,6)
+14 SET TMP811=$GET(^AUPNVPED(VPEDIEN,811))
+15 SET TMP812=$GET(^AUPNVPED(VPEDIEN,812))
+16 SET TOPIC=$PIECE(^AUTTEDT(EDUIEN,0),U,1)
+17 SET PNAME=$PIECE($GET(^AUTTEDT(EDUIEN,0)),U,4)
+18 IF PNAME=""
SET PNAME=TOPIC
+19 SET LEVEL=$$EXTERNAL^DILFD(9000010.16,.06,"",$PIECE(TMP0,U,6))
+20 SET OPROV=$$GET1^DIQ(9000010.16,VPEDIEN_",",1202)
+21 SET EPROV=$$GET1^DIQ(9000010.16,VPEDIEN_",",1204)
+22 SET HLOC=$PIECE(VDATA,U,5)
+23 SET HLOCABB=$PIECE(VDATA,U,6)
+24 SET DATASRC=$PIECE(TMP812,U,3)
+25 SET COMMENT=TMP811
+26 SET IDT=9999999-EVENTDT
+27 SET ^TMP("PXPE",$JOB,IDT,TOPIC,VPEDIEN,0)=PNAME_U_EVENTDT_U_LEVEL_U_OPROV_U_EPROV
+28 SET ^TMP("PXPE",$JOB,IDT,TOPIC,VPEDIEN,1)=HLOC_U_HLOCABB_U_$PIECE(VDATA,U,2)_U_$PIECE(VDATA,U,4)
+29 SET ^TMP("PXPE",$JOB,IDT,TOPIC,VPEDIEN,"COM")=COMMENT
+30 SET ^TMP("PXPE",$JOB,IDT,TOPIC,VPEDIEN,"MEASUREMENT")=TMP220
+31 SET ^TMP("PXPE",$JOB,IDT,TOPIC,VPEDIEN,"S")=DATASRC
+32 QUIT 1
+33 ;
