PXRHS05.m

PXRHS05 ;ISL/SBW - PCE V EXAM extract routine ;12/10/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13**;Aug 12, 1996

 ; Extract returns EXAM data

EXAM(DFN,ENDDT,BEGDT,OCCLIM) ; 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 # of each type of exam returned

 ;OUTPUT :

 ;  Data from V EXAM (9000010.13) file

 ;  ^TMP("PXE,$J,EXAM,InvDt,IFN,0) = EXAM [E;.01]

 ;     ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03] 

 ;     ^ RESULTS CODE [I;.04] ^ RESULTS [E;.04]

 ;     ^ ORDERING PROVIDER [E;1202] ^ ENCOUNTER PROVIDER [E;1204] ^

 ;  ^TMP("PXE",$J,EXAM,InvDt,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("PXE",$J,EXAM,InvDt,IFN,"S") = DATA SOURCE [E;80102]

 ;

 ;   [] = [I(nternal)/E(xternal); Optional file #; Record #]

 ;   Subscripts:

 ;     EXAM  - EXAM name

 ;     InvDt - Inverse FileMan date of DATE OF event or visit

 ;     IFN   - Internal Record #

 ;

 Q:$G(DFN)']""!'$D(^AUPNVXAM("AA",DFN))

 N PXEX,PXIVD,PXIFN,CNT,IBEGDT,IENDDT

 S:+$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("PXE",$J)

 S PXEX=""

 F  S PXEX=$O(^AUPNVXAM("AA",DFN,PXEX)) Q:PXEX=""  D

 . S PXIVD=IBEGDT,CNT=0

 . F  S PXIVD=$O(^AUPNVXAM("AA",DFN,PXEX,PXIVD)) Q:PXIVD'>0!(PXIVD>IENDDT)  D  Q:CNT'<OCCLIM

 . . S PXIFN=0

 . . F  S PXIFN=$O(^AUPNVXAM("AA",DFN,PXEX,PXIVD,PXIFN)) Q:PXIFN'>0  D  Q:CNT'<OCCLIM

 . . . N DIC,DIQ,DR,DA,REC,VDATA,EXAM,EXDT,RESULTC,RESULT,COMMENT

 . . . N OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT

 . . . S DIC=9000010.13,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"

 . . . S DR=".01;.03;.04;1201;1202;1204;80102;81101"

 . . . D EN^DIQ1

 . . . Q:'$D(REC)

 . . . S VDATA=$$GETVDATA^PXRHS03(+REC(9000010.13,DA,.03,"I"))

 . . . S EXAM=REC(9000010.13,DA,.01,"E")

 . . . S EXDT=REC(9000010.13,DA,1201,"I")

 . . . S:EXDT']"" EXDT=$P(VDATA,U)

 . . . S IDT=9999999-EXDT

 . . . I IDT<IBEGDT!(IDT>IENDDT) Q  ;Only get data within date range

 . . . S RESULTC=REC(9000010.13,DA,.04,"I")

 . . . S RESULT=REC(9000010.13,DA,.04,"E")

 . . . S OPROV=REC(9000010.13,DA,1202,"E")

 . . . S EPROV=REC(9000010.13,DA,1204,"E")

 . . . S HLOC=$P(VDATA,U,5)

 . . . S HLOCABB=$P(VDATA,U,6)

 . . . S SOURCE=REC(9000010.13,DA,80102,"E")

 . . . S COMMENT=REC(9000010.13,DA,81101,"E")

 . . . S ^TMP("PXE",$J,EXAM,IDT,DA,0)=EXAM_U_EXDT_U_RESULTC_U_RESULT_U_OPROV_U_EPROV

 . . . S ^TMP("PXE",$J,EXAM,IDT,DA,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)

 . . . S ^TMP("PXE",$J,EXAM,IDT,DA,"S")=SOURCE

 . . . S ^TMP("PXE",$J,EXAM,IDT,DA,"COM")=COMMENT

 . . . S CNT=CNT+1

 Q

PXRHS05   ;ISL/SBW - PCE V EXAM extract routine ;12/10/96

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**13**;Aug 12, 1996

 +2       ; Extract returns EXAM data

EXAM(DFN,ENDDT,BEGDT,OCCLIM) ; 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 # of each type of exam returned

 +7       ;OUTPUT :

 +8       ;  Data from V EXAM (9000010.13) file

 +9       ;  ^TMP("PXE,$J,EXAM,InvDt,IFN,0) = EXAM [E;.01]

 +10      ;     ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03] 

 +11      ;     ^ RESULTS CODE [I;.04] ^ RESULTS [E;.04]

 +12      ;     ^ ORDERING PROVIDER [E;1202] ^ ENCOUNTER PROVIDER [E;1204] ^

 +13      ;  ^TMP("PXE",$J,EXAM,InvDt,IFN,1) = HOSPITAL LOCATION [E;9000010;.22] 

 +14      ;     ^ HOSP. LOC. ABBREVIATION [E;44;1]

 +15      ;     ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]

 +16      ;  ^TMP("PXE",$J,EXAM,InvDt,IFN,"S") = DATA SOURCE [E;80102]

 +17      ;

 +18      ;   [] = [I(nternal)/E(xternal); Optional file #; Record #]

 +19      ;   Subscripts:

 +20      ;     EXAM  - EXAM name

 +21      ;     InvDt - Inverse FileMan date of DATE OF event or visit

 +22      ;     IFN   - Internal Record #

 +23      ;

 +24       IF $GET(DFN)']""!'$DATA(^AUPNVXAM("AA",DFN))

               QUIT 

 +25       NEW PXEX,PXIVD,PXIFN,CNT,IBEGDT,IENDDT

 +26       IF +$GET(OCCLIM)'>0

               SET OCCLIM=999

 +27       IF +$GET(BEGDT)'>0

               SET BEGDT=DT-10000

 +28       IF +$GET(ENDDT)'>0

               SET ENDDT=DT_".235959"

 +29      ; Chg regular dt/time to inverted dt/time

 +30       SET IBEGDT=9999999-ENDDT

           SET IENDDT=9999999-BEGDT

 +31       KILL ^TMP("PXE",$JOB)

 +32       SET PXEX=""

 +33       FOR 

               SET PXEX=$ORDER(^AUPNVXAM("AA",DFN,PXEX))

               IF PXEX=""

                   QUIT 

               Begin DoDot:1

 +34               SET PXIVD=IBEGDT

                   SET CNT=0

 +35               FOR 

                       SET PXIVD=$ORDER(^AUPNVXAM("AA",DFN,PXEX,PXIVD))

                       IF PXIVD'>0!(PXIVD>IENDDT)

                           QUIT 

                       Begin DoDot:2

 +36                       SET PXIFN=0

 +37                       FOR 

                               SET PXIFN=$ORDER(^AUPNVXAM("AA",DFN,PXEX,PXIVD,PXIFN))

                               IF PXIFN'>0

                                   QUIT 

                               Begin DoDot:3

 +38                               NEW DIC,DIQ,DR,DA,REC,VDATA,EXAM,EXDT,RESULTC,RESULT,COMMENT

 +39                               NEW OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT

 +40                               SET DIC=9000010.13

                                   SET DA=PXIFN

                                   SET DIQ="REC("

                                   SET DIQ(0)="IE"

 +41                               SET DR=".01;.03;.04;1201;1202;1204;80102;81101"

 +42                               DO EN^DIQ1

 +43                               IF '$DATA(REC)

                                       QUIT 

 +44                               SET VDATA=$$GETVDATA^PXRHS03(+REC(9000010.13,DA,.03,"I"))

 +45                               SET EXAM=REC(9000010.13,DA,.01,"E")

 +46                               SET EXDT=REC(9000010.13,DA,1201,"I")

 +47                               IF EXDT']""

                                       SET EXDT=$PIECE(VDATA,U)

 +48                               SET IDT=9999999-EXDT

 +49      ;Only get data within date range

                                   IF IDT<IBEGDT!(IDT>IENDDT)

                                       QUIT 

 +50                               SET RESULTC=REC(9000010.13,DA,.04,"I")

 +51                               SET RESULT=REC(9000010.13,DA,.04,"E")

 +52                               SET OPROV=REC(9000010.13,DA,1202,"E")

 +53                               SET EPROV=REC(9000010.13,DA,1204,"E")

 +54                               SET HLOC=$PIECE(VDATA,U,5)

 +55                               SET HLOCABB=$PIECE(VDATA,U,6)

 +56                               SET SOURCE=REC(9000010.13,DA,80102,"E")

 +57                               SET COMMENT=REC(9000010.13,DA,81101,"E")

 +58                               SET ^TMP("PXE",$JOB,EXAM,IDT,DA,0)=EXAM_U_EXDT_U_RESULTC_U_RESULT_U_OPROV_U_EPROV

 +59                               SET ^TMP("PXE",$JOB,EXAM,IDT,DA,1)=HLOC_U_HLOCABB_U_$PIECE(VDATA,U,2)_U_$PIECE(VDATA,U,4)

 +60                               SET ^TMP("PXE",$JOB,EXAM,IDT,DA,"S")=SOURCE

 +61                               SET ^TMP("PXE",$JOB,EXAM,IDT,DA,"COM")=COMMENT

 +62                               SET CNT=CNT+1

                               End DoDot:3

                               IF CNT'<OCCLIM

                                   QUIT 

                       End DoDot:2

                       IF CNT'<OCCLIM

                           QUIT 

               End DoDot:1

 +63       QUIT