- 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 Feb 18, 2025@23:56:46 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 ;