Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRHS03

PXRHS03.m

Go to the documentation of this file. 
  1. PXRHS03 ; SLC/SBW - PCE Visit data immunization extract ;11/25/96
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**13**;Aug 12, 1996
  1. IMMUN(DFN) ; Control branching
  1.  ;INPUT  : DFN      - Pointer to PATIENT file (#2)
  1.  ;OUTPUT : 
  1.  ;  Data from V Immunization (9000010.11) file
  1.  ;  ^TMP("PXI",$J,IMM,InvDt,IFN,0) = IMMUNIZATION [E;.01]
  1.  ;     ^ IMMUNIZATION SHORT NAME [E;9999999.14,.02]
  1.  ;     ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03] 
  1.  ;     ^ SERIES CODE [I;.04] ^ SERIES [E;.04] ^ REACTION [E;.06]
  1.  ;     ^ CONTRAINDICATED [I;.07] ^ ORDERING PROVIDER [E;1202]
  1.  ;     ^ ENCOUNTER PROVIDER [E;1204]
  1.  ;  ^TMP("PXI",$J,IMM,InvDt,IFN,1) = ^ HOSPITAL LOCATION [E;9000010;.22] 
  1.  ;     ^ HOSP. LOC. ABBREVIATION [E;44;1]
  1.  ;     ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
  1.  ;  ^TMP("PXI",$J,IMM,InvDt,IFN,"R",CNT) = REMARKS [E;1101]
  1.  ;  ^TMP("PXI",$J,IMM,InvDt,IFN,"S") = DATA SOURCE [E;80102]
  1.  ;
  1.  ;   [] = [I(nternal)/E(xternal); Optional file #; Record #]
  1.  ;   Subscripts:
  1.  ;     IMM   - Immunization name
  1.  ;     InvDt - Inverse FileMan date of DATE OF event or visit
  1.  ;     IFN   - Internal Record #
  1.  ;
  1.  Q:$G(DFN)']""!'$D(^AUPNVIMM("AA",DFN))
  1.  N PXIMM,PXIVD,PXIFN,IHSDATE
  1.  S IHSDATE=9999999-$$HSDATE^PXRHS01
  1.  K ^TMP("PXI",$J)
  1.  S PXIMM=""
  1.  F  S PXIMM=$O(^AUPNVIMM("AA",DFN,PXIMM)) Q:PXIMM=""  D
  1.  . S PXIVD=0
  1.  . F  S PXIVD=$O(^AUPNVIMM("AA",DFN,PXIMM,PXIVD)) Q:PXIVD'>0  Q:PXIVD>IHSDATE  D
  1.  . . S PXIFN=0
  1.  . . F  S PXIFN=$O(^AUPNVIMM("AA",DFN,PXIMM,PXIVD,PXIFN)) Q:PXIFN'>0  D
  1.  . . . N DIC,DIQ,DR,DA,REC,IMM,SNIMM,IMDT,SERIESC,SERIES,REACT,CONT
  1.  . . . N OPROV,EPROV,HLOC,HLOCABB,SOURCE,VDATA,IDT,COMMENT
  1.  . . . S DIC=9000010.11,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"
  1.  . . . S DR=".01;.03;.04;.06;.07;1201;1202;1204;80102;81101"
  1.  . . . D EN^DIQ1
  1.  . . . Q:'$D(REC)
  1.  . . . S VDATA=$$GETVDATA(+REC(9000010.11,DA,.03,"I"))
  1.  . . . S SNIMM=$P($G(^AUTTIMM(REC(9000010.11,DA,.01,"I"),0)),U,2)
  1.  . . . S IMM=$E(REC(9000010.11,DA,.01,"E"),1,10)
  1.  . . . I SNIMM']"" S SNIMM=IMM
  1.  . . . S IMDT=REC(9000010.11,DA,1201,"I")
  1.  . . . S:IMDT']"" IMDT=$P(VDATA,U)
  1.  . . . S IDT=9999999-IMDT
  1.  . . . S SERIESC=REC(9000010.11,DA,.04,"I")
  1.  . . . S SERIES=REC(9000010.11,DA,.04,"E")
  1.  . . . S REACT=REC(9000010.11,DA,.06,"E")
  1.  . . . S CONT=REC(9000010.11,DA,.07,"I")
  1.  . . . S OPROV=REC(9000010.11,DA,1202,"E")
  1.  . . . S EPROV=REC(9000010.11,DA,1204,"E")
  1.  . . . S HLOC=$P(VDATA,U,5)
  1.  . . . S HLOCABB=$P(VDATA,U,6)
  1.  . . . S SOURCE=REC(9000010.11,DA,80102,"E")
  1.  . . . S COMMENT=REC(9000010.11,DA,81101,"E")
  1.  . . . 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
  1.  . . . S ^TMP("PXI",$J,SNIMM,IDT,DA,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
  1.  . . . S ^TMP("PXI",$J,SNIMM,IDT,DA,"S")=SOURCE
  1.  . . . S ^TMP("PXI",$J,SNIMM,IDT,DA,"COM")=COMMENT
  1.  . . . D GETREM(SNIMM,IDT,DA)
  1.  Q
  1. GETREM(SNIMM,IDT,RNUM) ;Get the remark data
  1.  N CNT
  1.  S CNT=0
  1.  F  S CNT=$O(^AUPNVIMM(RNUM,11,CNT)) Q:CNT'>0  D
  1.  . S ^TMP("PXI",$J,SNIMM,IDT,RNUM,"R",CNT)=$G(^AUPNVIMM(RNUM,11,CNT,0))
  1.  Q
  1. GETVDATA(DA) ;Get location of encounter and outside location from visit file
  1.  N DIC,DIQ,DR,VREC,HLOC,HLOCABB
  1.  S DIC=9000010,DIQ="VREC(",DIQ(0)="IE"
  1.  S DR=".01;.06;.07;.22;2101"
  1.  D EN^DIQ1
  1.  S HLOC=VREC(9000010,DA,.22,"E")
  1.  S HLOCABB=$$GETHLOC^PXRHS02(+VREC(9000010,DA,.22,"I"))
  1.  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