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

PXBGIMM.m

Go to the documentation of this file.
  1. PXBGIMM ;ISL/PKR - Gather immunization data. Follow the convention established by PXBGCPT. ;7/24/96 14:00
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
  1. ;
  1. IMM(VISIT) ;Gather the entries in the V Immunization file.
  1. N DA,DIC,DIQ,DR,IEN
  1. ;
  1. K ^TMP("PXBU",$J)
  1. I $D(^AUPNVIMM("AD",VISIT)) D
  1. . S IEN=0
  1. . F S IEN=$O(^AUPNVIMM("AD",VISIT,IEN)) Q:IEN'>0 D
  1. .. S ^TMP("PXBU",$J,"IMM",IEN)=""
  1. ;
  1. N CONTRA,ENCDT,ENCPRV,IMM,IMMUN,PATIENT,REACTION,SERIES,TEMP
  1. I $D(^TMP("PXBU",$J,"IMM")) D
  1. . S IEN=0
  1. . F S IEN=$O(^TMP("PXBU",$J,"IMM",IEN)) Q:IEN'>0 D
  1. .. K TEMP
  1. .. S DIC=9000010.11,DA=IEN
  1. .. S DR=".01;.02;.04;.06;.07;1201;1204;811"
  1. .. S DIQ="TEMP(",DIQ(0)="E"
  1. .. D EN^DIQ1
  1. .. S IMM=$G(TEMP(9000010.11,DA,.01,"E"))
  1. .. S PATIENT=$G(TEMP(9000010.11,DA,.02,"E"))
  1. .. S SERIES=$G(TEMP(9000010.11,DA,.04,"E"))
  1. .. S REACTION=$G(TEMP(9000010.11,DA,.06,"E"))
  1. .. S CONTRA=$G(TEMP(9000010.11,DA,.07,"E"))
  1. .. S ENCDT=$G(TEMP(9000010.11,DA,1201,"E"))
  1. .. S ENCPRV=$G(TEMP(9000010.11,DA,1204,"E"))
  1. .. S IMMUN(IMM,IEN)=IMM_U_PATIENT_U_SERIES_U_REACTION_U_CONTRA_U_ENCDT_U_ENCPRV
  1. ;
  1. N PXBC
  1. S PXBC=0
  1. I $D(IMMUN) D
  1. . S IMM=""
  1. . F S IMM=$O(IMMUN(IMM)) Q:IMM="" D
  1. .. S IEN=0
  1. .. F S IEN=$O(IMMUN(IMM,IEN)) Q:IEN="" D
  1. ... S PXBC=PXBC+1
  1. ... S PXBKY(IMM,IEN)=IMMUN(IMM,IEN)
  1. ... S PXBSAM(PXBC)=IMMUN(IMM,IEN)
  1. ... S PXBSKY(PXBC,IEN)=IMMUN(IMM,IEN)
  1. ;
  1. K ^TMP("PXBU",$J)
  1. S PXBCNT=PXBC
  1. Q