PXRHS03.m

PXRHS03 ; SLC/SBW - PCE Visit data immunization extract ;11/25/96

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

IMMUN(DFN) ; Control branching

 ;INPUT  : DFN      - Pointer to PATIENT file (#2)

 ;OUTPUT : 

 ;  Data from V Immunization (9000010.11) file

 ;  ^TMP("PXI",$J,IMM,InvDt,IFN,0) = IMMUNIZATION [E;.01]

 ;     ^ IMMUNIZATION SHORT NAME [E;9999999.14,.02]

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

 ;     ^ SERIES CODE [I;.04] ^ SERIES [E;.04] ^ REACTION [E;.06]

 ;     ^ CONTRAINDICATED [I;.07] ^ ORDERING PROVIDER [E;1202]

 ;     ^ ENCOUNTER PROVIDER [E;1204]

 ;  ^TMP("PXI",$J,IMM,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("PXI",$J,IMM,InvDt,IFN,"R",CNT) = REMARKS [E;1101]

 ;  ^TMP("PXI",$J,IMM,InvDt,IFN,"S") = DATA SOURCE [E;80102]

 ;

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

 ;   Subscripts:

 ;     IMM   - Immunization name

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

 ;     IFN   - Internal Record #

 ;

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

 N PXIMM,PXIVD,PXIFN,IHSDATE

 S IHSDATE=9999999-$$HSDATE^PXRHS01

 K ^TMP("PXI",$J)

 S PXIMM=""

 F  S PXIMM=$O(^AUPNVIMM("AA",DFN,PXIMM)) Q:PXIMM=""  D

 . S PXIVD=0

 . F  S PXIVD=$O(^AUPNVIMM("AA",DFN,PXIMM,PXIVD)) Q:PXIVD'>0  Q:PXIVD>IHSDATE  D

 . . S PXIFN=0

 . . F  S PXIFN=$O(^AUPNVIMM("AA",DFN,PXIMM,PXIVD,PXIFN)) Q:PXIFN'>0  D

 . . . N DIC,DIQ,DR,DA,REC,IMM,SNIMM,IMDT,SERIESC,SERIES,REACT,CONT

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

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

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

 . . . D EN^DIQ1

 . . . Q:'$D(REC)

 . . . S VDATA=$$GETVDATA(+REC(9000010.11,DA,.03,"I"))

 . . . S SNIMM=$P($G(^AUTTIMM(REC(9000010.11,DA,.01,"I"),0)),U,2)

 . . . S IMM=$E(REC(9000010.11,DA,.01,"E"),1,10)

 . . . I SNIMM']"" S SNIMM=IMM

 . . . S IMDT=REC(9000010.11,DA,1201,"I")

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

 . . . S IDT=9999999-IMDT

 . . . S SERIESC=REC(9000010.11,DA,.04,"I")

 . . . S SERIES=REC(9000010.11,DA,.04,"E")

 . . . S REACT=REC(9000010.11,DA,.06,"E")

 . . . S CONT=REC(9000010.11,DA,.07,"I")

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

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

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

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

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

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

 . . . S ^TMP("PXI",$J,SNIMM,IDT,DA,0)=IMM_U_SNIMM_U_IMDT_U_SERIESC_U_SERIES_U_REACT_U_CONT_U_OPROV_U_EPROV

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

 . . . S ^TMP("PXI",$J,SNIMM,IDT,DA,"S")=SOURCE

 . . . S ^TMP("PXI",$J,SNIMM,IDT,DA,"COM")=COMMENT

 . . . D GETREM(SNIMM,IDT,DA)

 Q

GETREM(SNIMM,IDT,RNUM) ;Get the remark data

 N CNT

 S CNT=0

 F  S CNT=$O(^AUPNVIMM(RNUM,11,CNT)) Q:CNT'>0  D

 . S ^TMP("PXI",$J,SNIMM,IDT,RNUM,"R",CNT)=$G(^AUPNVIMM(RNUM,11,CNT,0))

 Q

GETVDATA(DA) ;Get location of encounter and outside location from visit file

 N DIC,DIQ,DR,VREC,HLOC,HLOCABB

 S DIC=9000010,DIQ="VREC(",DIQ(0)="IE"

 S DR=".01;.06;.07;.22;2101"

 D EN^DIQ1

 S HLOC=VREC(9000010,DA,.22,"E")

 S HLOCABB=$$GETHLOC^PXRHS02(+VREC(9000010,DA,.22,"I"))

 Q VREC(9000010,DA,.01,"I")_U_VREC(9000010,DA,.06,"E")_U_VREC(9000010,DA,.07,"I")_U_VREC(9000010,DA,2101,"E")_U_HLOC_U_HLOCABB

PXRHS03   ; SLC/SBW - PCE Visit data immunization extract ;11/25/96

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

IMMUN(DFN) ; Control branching

 +1       ;INPUT  : DFN      - Pointer to PATIENT file (#2)

 +2       ;OUTPUT : 

 +3       ;  Data from V Immunization (9000010.11) file

 +4       ;  ^TMP("PXI",$J,IMM,InvDt,IFN,0) = IMMUNIZATION [E;.01]

 +5       ;     ^ IMMUNIZATION SHORT NAME [E;9999999.14,.02]

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

 +7       ;     ^ SERIES CODE [I;.04] ^ SERIES [E;.04] ^ REACTION [E;.06]

 +8       ;     ^ CONTRAINDICATED [I;.07] ^ ORDERING PROVIDER [E;1202]

 +9       ;     ^ ENCOUNTER PROVIDER [E;1204]

 +10      ;  ^TMP("PXI",$J,IMM,InvDt,IFN,1) = ^ HOSPITAL LOCATION [E;9000010;.22] 

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

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

 +13      ;  ^TMP("PXI",$J,IMM,InvDt,IFN,"R",CNT) = REMARKS [E;1101]

 +14      ;  ^TMP("PXI",$J,IMM,InvDt,IFN,"S") = DATA SOURCE [E;80102]

 +15      ;

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

 +17      ;   Subscripts:

 +18      ;     IMM   - Immunization name

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

 +20      ;     IFN   - Internal Record #

 +21      ;

 +22       IF $GET(DFN)']""!'$DATA(^AUPNVIMM("AA",DFN))

               QUIT 

 +23       NEW PXIMM,PXIVD,PXIFN,IHSDATE

 +24       SET IHSDATE=9999999-$$HSDATE^PXRHS01

 +25       KILL ^TMP("PXI",$JOB)

 +26       SET PXIMM=""

 +27       FOR 

               SET PXIMM=$ORDER(^AUPNVIMM("AA",DFN,PXIMM))

               IF PXIMM=""

                   QUIT 

               Begin DoDot:1

 +28               SET PXIVD=0

 +29               FOR 

                       SET PXIVD=$ORDER(^AUPNVIMM("AA",DFN,PXIMM,PXIVD))

                       IF PXIVD'>0

                           QUIT 

                       IF PXIVD>IHSDATE

                           QUIT 

                       Begin DoDot:2

 +30                       SET PXIFN=0

 +31                       FOR 

                               SET PXIFN=$ORDER(^AUPNVIMM("AA",DFN,PXIMM,PXIVD,PXIFN))

                               IF PXIFN'>0

                                   QUIT 

                               Begin DoDot:3

 +32                               NEW DIC,DIQ,DR,DA,REC,IMM,SNIMM,IMDT,SERIESC,SERIES,REACT,CONT

 +33                               NEW OPROV,EPROV,HLOC,HLOCABB,SOURCE,VDATA,IDT,COMMENT

 +34                               SET DIC=9000010.11

                                   SET DA=PXIFN

                                   SET DIQ="REC("

                                   SET DIQ(0)="IE"

 +35                               SET DR=".01;.03;.04;.06;.07;1201;1202;1204;80102;81101"

 +36                               DO EN^DIQ1

 +37                               IF '$DATA(REC)

                                       QUIT 

 +38                               SET VDATA=$$GETVDATA(+REC(9000010.11,DA,.03,"I"))

 +39                               SET SNIMM=$PIECE($GET(^AUTTIMM(REC(9000010.11,DA,.01,"I"),0)),U,2)

 +40                               SET IMM=$EXTRACT(REC(9000010.11,DA,.01,"E"),1,10)

 +41                               IF SNIMM']""

                                       SET SNIMM=IMM

 +42                               SET IMDT=REC(9000010.11,DA,1201,"I")

 +43                               IF IMDT']""

                                       SET IMDT=$PIECE(VDATA,U)

 +44                               SET IDT=9999999-IMDT

 +45                               SET SERIESC=REC(9000010.11,DA,.04,"I")

 +46                               SET SERIES=REC(9000010.11,DA,.04,"E")

 +47                               SET REACT=REC(9000010.11,DA,.06,"E")

 +48                               SET CONT=REC(9000010.11,DA,.07,"I")

 +49                               SET OPROV=REC(9000010.11,DA,1202,"E")

 +50                               SET EPROV=REC(9000010.11,DA,1204,"E")

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

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

 +53                               SET SOURCE=REC(9000010.11,DA,80102,"E")

 +54                               SET COMMENT=REC(9000010.11,DA,81101,"E")

 +55                               SET ^TMP("PXI",$JOB,SNIMM,IDT,DA,0)=IMM_U_SNIMM_U_IMDT_U_SERIESC_U_SERIES_U_REACT_U_CONT_U_OPROV_U_EPROV

 +56                               SET ^TMP("PXI",$JOB,SNIMM,IDT,DA,1)=HLOC_U_HLOCABB_U_$PIECE(VDATA,U,2)_U_$PIECE(VDATA,U,4)

 +57                               SET ^TMP("PXI",$JOB,SNIMM,IDT,DA,"S")=SOURCE

 +58                               SET ^TMP("PXI",$JOB,SNIMM,IDT,DA,"COM")=COMMENT

 +59                               DO GETREM(SNIMM,IDT,DA)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +60       QUIT 

GETREM(SNIMM,IDT,RNUM) ;Get the remark data

 +1        NEW CNT

 +2        SET CNT=0

 +3        FOR 

               SET CNT=$ORDER(^AUPNVIMM(RNUM,11,CNT))

               IF CNT'>0

                   QUIT 

               Begin DoDot:1

 +4                SET ^TMP("PXI",$JOB,SNIMM,IDT,RNUM,"R",CNT)=$GET(^AUPNVIMM(RNUM,11,CNT,0))

               End DoDot:1

 +5        QUIT 

GETVDATA(DA) ;Get location of encounter and outside location from visit file

 +1        NEW DIC,DIQ,DR,VREC,HLOC,HLOCABB

 +2        SET DIC=9000010

           SET DIQ="VREC("

           SET DIQ(0)="IE"

 +3        SET DR=".01;.06;.07;.22;2101"

 +4        DO EN^DIQ1

 +5        SET HLOC=VREC(9000010,DA,.22,"E")

 +6        SET HLOCABB=$$GETHLOC^PXRHS02(+VREC(9000010,DA,.22,"I"))

 +7        QUIT VREC(9000010,DA,.01,"I")_U_VREC(9000010,DA,.06,"E")_U_VREC(9000010,DA,.07,"I")_U_VREC(9000010,DA,2101,"E")_U_HLOC_U_HLOCABB