PXRHS08 ;ISL/SBW - PCE Visit Patient Education data extract ;2/14/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**13,16**;Aug 12, 1996
;IHS/ITSC/LJF 9/26/2003 use IHS format for AA xref
;
EDUC(DFN,ENDDT,BEGDT,OCCLIM,CATCODE) ; Control branching
;INPUT : DFN - Pointer to PATIENT file (#2)
; ENDDT - Ending date/time in internal FileMan format
; - Defaults to today's date at 11:59 pm
; BEGDT - Beginning date/time in internal FileMan format
; - Defaults to one year prior to today's date
; 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) = 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;80102]
;
; [] = [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(^AUPNVPED("AA",DFN))
N PXIED,PXIVD,PXIFN,CNT,PDT,GMA,IBEGDT,IENDDT
S:($G(OCCLIM)'="R")&(+$G(OCCLIM)'>0) OCCLIM=999
S:+$G(BEGDT)'>0 BEGDT=DT-10000
S:+$G(ENDDT)'>0 ENDDT=DT_".235959"
; Chg regular dt/time to inverted dt/time
S IBEGDT=9999999-ENDDT,IENDDT=9999999-BEGDT
K ^TMP("PXPE",$J)
I OCCLIM="R" D Q ;Get each most recent topic for time period
. ;
. ;IHS/ITSC/LJF 9/26/2003 use IHS format for AA xref
. ;S PXIED=""
. ;F S PXIED=$O(^AUPNVPED("AA",DFN,PXIED)) Q:PXIED="" D
. ;. S PXIVD=$O(^AUPNVPED("AA",DFN,PXIED,""))
. ;. I (PXIVD'<IBEGDT)&(PXIVD'>IENDDT) D
. ;. . S PXIFN=$O(^AUPNVPED("AA",DFN,PXIED,PXIVD,""))
. ;. . D GETDATA
. ;
. ;IHS/ITSC/LJF 9/26/2003 uncomment lines below
. S CNT=0,PXIVD=IBEGDT
. F S PXIVD=$O(^AUPNVPED("AA",DFN,PXIVD)) Q:PXIVD'>0!(PXIVD>IENDDT) D Q:CNT'<OCCLIM
. . S PXIFN=0
. . F S PXIFN=$O(^AUPNVPED("AA",DFN,PXIVD,PXIFN)) Q:PXIFN'>0 D GETDATA
;IHS/ITSC/LJF 9/26/2003 end of IHS mods
;
I OCCLIM>0 D Q
. S PXED=""
. F S PXED=$O(^AUPNVPED("AA",DFN,PXED)) Q:PXED="" D
. . S PXIVD=IBEGDT,CNT=0
. . F S PXIVD=$O(^AUPNVPED("AA",DFN,PXED,PXIVD)) Q:PXIVD'>0!(PXIVD>IENDDT) D Q:CNT'<OCCLIM
. . . S PXIFN=0
. . . F S PXIFN=$O(^AUPNVPED("AA",DFN,PXED,PXIVD,PXIFN)) Q:PXIFN'>0 D Q:CNT'<OCCLIM
. . . . D GETDATA
Q
;
GETDATA ;
N DIC,DIQ,DR,DA,REC,VDATA,TOPIC,EDDT,LEVEL
N OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT,COMMENT
S DIC=9000010.16,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"
S DR=".01;.03;.06;1201;1202;1204;80102;80201;81101"
D EN^DIQ1
Q:'$D(REC)
S VDATA=$$GETVDATA^PXRHS03(+REC(9000010.16,DA,.03,"I"))
Q:$G(CATCODE)'[$P(VDATA,U,3) ;Only get data with passed serv. cat.
S TOPIC=REC(9000010.16,DA,.01,"E")
S EDDT=REC(9000010.16,DA,1201,"I")
S:EDDT']"" EDDT=$P(VDATA,U)
S IDT=9999999-EDDT
I IDT<IBEGDT!(IDT>IENDDT) Q ;Only get data within date range
I OCCLIM="R" Q:$D(GMA(TOPIC)) ;Get only most recent Pat. Ed. topic
S LEVEL=REC(9000010.16,DA,.06,"E")
S OPROV=REC(9000010.16,DA,1202,"E")
S EPROV=REC(9000010.16,DA,1204,"E")
S HLOC=$P(VDATA,U,5)
S HLOCABB=$P(VDATA,U,6)
S SOURCE=REC(9000010.16,DA,80102,"E")
S COMMENT=REC(9000010.16,DA,81101,"E")
S ^TMP("PXPE",$J,IDT,TOPIC,DA,0)=TOPIC_U_EDDT_U_LEVEL_U_OPROV_U_EPROV
S ^TMP("PXPE",$J,IDT,TOPIC,DA,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
S ^TMP("PXPE",$J,IDT,TOPIC,DA,"S")=SOURCE
S ^TMP("PXPE",$J,IDT,TOPIC,DA,"COM")=COMMENT
; Counter by date not by visit. There may be multiple visits with
; multiple patient education topics for any given day
I OCCLIM>0,PXIVD'=$G(PDT) S CNT=CNT+1,PDT=PXIVD
I OCCLIM="R" S GMA(TOPIC)=""
Q
PXRHS08 ;ISL/SBW - PCE Visit Patient Education data extract ;2/14/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13,16**;Aug 12, 1996
+2 ;IHS/ITSC/LJF 9/26/2003 use IHS format for AA xref
+3 ;
EDUC(DFN,ENDDT,BEGDT,OCCLIM,CATCODE) ; Control branching
+1 ;INPUT : DFN - Pointer to PATIENT file (#2)
+2 ; ENDDT - Ending date/time in internal FileMan format
+3 ; - Defaults to today's date at 11:59 pm
+4 ; BEGDT - Beginning date/time in internal FileMan format
+5 ; - Defaults to one year prior to today's date
+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) = 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;80102]
+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(^AUPNVPED("AA",DFN))
QUIT
+46 NEW PXIED,PXIVD,PXIFN,CNT,PDT,GMA,IBEGDT,IENDDT
+47 IF ($GET(OCCLIM)'="R")&(+$GET(OCCLIM)'>0)
SET OCCLIM=999
+48 IF +$GET(BEGDT)'>0
SET BEGDT=DT-10000
+49 IF +$GET(ENDDT)'>0
SET ENDDT=DT_".235959"
+50 ; Chg regular dt/time to inverted dt/time
+51 SET IBEGDT=9999999-ENDDT
SET IENDDT=9999999-BEGDT
+52 KILL ^TMP("PXPE",$JOB)
+53 ;Get each most recent topic for time period
IF OCCLIM="R"
Begin DoDot:1
+54 ;
+55 ;IHS/ITSC/LJF 9/26/2003 use IHS format for AA xref
+56 ;S PXIED=""
+57 ;F S PXIED=$O(^AUPNVPED("AA",DFN,PXIED)) Q:PXIED="" D
+58 ;. S PXIVD=$O(^AUPNVPED("AA",DFN,PXIED,""))
+59 ;. I (PXIVD'<IBEGDT)&(PXIVD'>IENDDT) D
+60 ;. . S PXIFN=$O(^AUPNVPED("AA",DFN,PXIED,PXIVD,""))
+61 ;. . D GETDATA
+62 ;
+63 ;IHS/ITSC/LJF 9/26/2003 uncomment lines below
+64 SET CNT=0
SET PXIVD=IBEGDT
+65 FOR
SET PXIVD=$ORDER(^AUPNVPED("AA",DFN,PXIVD))
IF PXIVD'>0!(PXIVD>IENDDT)
QUIT
Begin DoDot:2
+66 SET PXIFN=0
+67 FOR
SET PXIFN=$ORDER(^AUPNVPED("AA",DFN,PXIVD,PXIFN))
IF PXIFN'>0
QUIT
DO GETDATA
End DoDot:2
IF CNT'<OCCLIM
QUIT
End DoDot:1
QUIT
+68 ;IHS/ITSC/LJF 9/26/2003 end of IHS mods
+69 ;
+70 IF OCCLIM>0
Begin DoDot:1
+71 SET PXED=""
+72 FOR
SET PXED=$ORDER(^AUPNVPED("AA",DFN,PXED))
IF PXED=""
QUIT
Begin DoDot:2
+73 SET PXIVD=IBEGDT
SET CNT=0
+74 FOR
SET PXIVD=$ORDER(^AUPNVPED("AA",DFN,PXED,PXIVD))
IF PXIVD'>0!(PXIVD>IENDDT)
QUIT
Begin DoDot:3
+75 SET PXIFN=0
+76 FOR
SET PXIFN=$ORDER(^AUPNVPED("AA",DFN,PXED,PXIVD,PXIFN))
IF PXIFN'>0
QUIT
Begin DoDot:4
+77 DO GETDATA
End DoDot:4
IF CNT'<OCCLIM
QUIT
End DoDot:3
IF CNT'<OCCLIM
QUIT
End DoDot:2
End DoDot:1
QUIT
+78 QUIT
+79 ;
GETDATA ;
+1 NEW DIC,DIQ,DR,DA,REC,VDATA,TOPIC,EDDT,LEVEL
+2 NEW OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT,COMMENT
+3 SET DIC=9000010.16
SET DA=PXIFN
SET DIQ="REC("
SET DIQ(0)="IE"
+4 SET DR=".01;.03;.06;1201;1202;1204;80102;80201;81101"
+5 DO EN^DIQ1
+6 IF '$DATA(REC)
QUIT
+7 SET VDATA=$$GETVDATA^PXRHS03(+REC(9000010.16,DA,.03,"I"))
+8 ;Only get data with passed serv. cat.
IF $GET(CATCODE)'[$PIECE(VDATA,U,3)
QUIT
+9 SET TOPIC=REC(9000010.16,DA,.01,"E")
+10 SET EDDT=REC(9000010.16,DA,1201,"I")
+11 IF EDDT']""
SET EDDT=$PIECE(VDATA,U)
+12 SET IDT=9999999-EDDT
+13 ;Only get data within date range
IF IDT<IBEGDT!(IDT>IENDDT)
QUIT
+14 ;Get only most recent Pat. Ed. topic
IF OCCLIM="R"
IF $DATA(GMA(TOPIC))
QUIT
+15 SET LEVEL=REC(9000010.16,DA,.06,"E")
+16 SET OPROV=REC(9000010.16,DA,1202,"E")
+17 SET EPROV=REC(9000010.16,DA,1204,"E")
+18 SET HLOC=$PIECE(VDATA,U,5)
+19 SET HLOCABB=$PIECE(VDATA,U,6)
+20 SET SOURCE=REC(9000010.16,DA,80102,"E")
+21 SET COMMENT=REC(9000010.16,DA,81101,"E")
+22 SET ^TMP("PXPE",$JOB,IDT,TOPIC,DA,0)=TOPIC_U_EDDT_U_LEVEL_U_OPROV_U_EPROV
+23 SET ^TMP("PXPE",$JOB,IDT,TOPIC,DA,1)=HLOC_U_HLOCABB_U_$PIECE(VDATA,U,2)_U_$PIECE(VDATA,U,4)
+24 SET ^TMP("PXPE",$JOB,IDT,TOPIC,DA,"S")=SOURCE
+25 SET ^TMP("PXPE",$JOB,IDT,TOPIC,DA,"COM")=COMMENT
+26 ; Counter by date not by visit. There may be multiple visits with
+27 ; multiple patient education topics for any given day
+28 IF OCCLIM>0
IF PXIVD'=$GET(PDT)
SET CNT=CNT+1
SET PDT=PXIVD
+29 IF OCCLIM="R"
SET GMA(TOPIC)=""
+30 QUIT
