- PXBGIMM ;ISL/PKR - Gather immunization data. Follow the convention established by PXBGCPT. ;7/24/96 14:00
- ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- ;
- IMM(VISIT) ;Gather the entries in the V Immunization file.
- N DA,DIC,DIQ,DR,IEN
- ;
- K ^TMP("PXBU",$J)
- I $D(^AUPNVIMM("AD",VISIT)) D
- . S IEN=0
- . F S IEN=$O(^AUPNVIMM("AD",VISIT,IEN)) Q:IEN'>0 D
- .. S ^TMP("PXBU",$J,"IMM",IEN)=""
- ;
- N CONTRA,ENCDT,ENCPRV,IMM,IMMUN,PATIENT,REACTION,SERIES,TEMP
- I $D(^TMP("PXBU",$J,"IMM")) D
- . S IEN=0
- . F S IEN=$O(^TMP("PXBU",$J,"IMM",IEN)) Q:IEN'>0 D
- .. K TEMP
- .. S DIC=9000010.11,DA=IEN
- .. S DR=".01;.02;.04;.06;.07;1201;1204;811"
- .. S DIQ="TEMP(",DIQ(0)="E"
- .. D EN^DIQ1
- .. S IMM=$G(TEMP(9000010.11,DA,.01,"E"))
- .. S PATIENT=$G(TEMP(9000010.11,DA,.02,"E"))
- .. S SERIES=$G(TEMP(9000010.11,DA,.04,"E"))
- .. S REACTION=$G(TEMP(9000010.11,DA,.06,"E"))
- .. S CONTRA=$G(TEMP(9000010.11,DA,.07,"E"))
- .. S ENCDT=$G(TEMP(9000010.11,DA,1201,"E"))
- .. S ENCPRV=$G(TEMP(9000010.11,DA,1204,"E"))
- .. S IMMUN(IMM,IEN)=IMM_U_PATIENT_U_SERIES_U_REACTION_U_CONTRA_U_ENCDT_U_ENCPRV
- ;
- N PXBC
- S PXBC=0
- I $D(IMMUN) D
- . S IMM=""
- . F S IMM=$O(IMMUN(IMM)) Q:IMM="" D
- .. S IEN=0
- .. F S IEN=$O(IMMUN(IMM,IEN)) Q:IEN="" D
- ... S PXBC=PXBC+1
- ... S PXBKY(IMM,IEN)=IMMUN(IMM,IEN)
- ... S PXBSAM(PXBC)=IMMUN(IMM,IEN)
- ... S PXBSKY(PXBC,IEN)=IMMUN(IMM,IEN)
- ;
- K ^TMP("PXBU",$J)
- S PXBCNT=PXBC
- Q
- 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
- +2 ;
- IMM(VISIT) ;Gather the entries in the V Immunization file.
- +1 NEW DA,DIC,DIQ,DR,IEN
- +2 ;
- +3 KILL ^TMP("PXBU",$JOB)
- +4 IF $DATA(^AUPNVIMM("AD",VISIT))
- Begin DoDot:1
- +5 SET IEN=0
- +6 FOR
- SET IEN=$ORDER(^AUPNVIMM("AD",VISIT,IEN))
- IF IEN'>0
- QUIT
- Begin DoDot:2
- +7 SET ^TMP("PXBU",$JOB,"IMM",IEN)=""
- End DoDot:2
- End DoDot:1
- +8 ;
- +9 NEW CONTRA,ENCDT,ENCPRV,IMM,IMMUN,PATIENT,REACTION,SERIES,TEMP
- +10 IF $DATA(^TMP("PXBU",$JOB,"IMM"))
- Begin DoDot:1
- +11 SET IEN=0
- +12 FOR
- SET IEN=$ORDER(^TMP("PXBU",$JOB,"IMM",IEN))
- IF IEN'>0
- QUIT
- Begin DoDot:2
- +13 KILL TEMP
- +14 SET DIC=9000010.11
- SET DA=IEN
- +15 SET DR=".01;.02;.04;.06;.07;1201;1204;811"
- +16 SET DIQ="TEMP("
- SET DIQ(0)="E"
- +17 DO EN^DIQ1
- +18 SET IMM=$GET(TEMP(9000010.11,DA,.01,"E"))
- +19 SET PATIENT=$GET(TEMP(9000010.11,DA,.02,"E"))
- +20 SET SERIES=$GET(TEMP(9000010.11,DA,.04,"E"))
- +21 SET REACTION=$GET(TEMP(9000010.11,DA,.06,"E"))
- +22 SET CONTRA=$GET(TEMP(9000010.11,DA,.07,"E"))
- +23 SET ENCDT=$GET(TEMP(9000010.11,DA,1201,"E"))
- +24 SET ENCPRV=$GET(TEMP(9000010.11,DA,1204,"E"))
- +25 SET IMMUN(IMM,IEN)=IMM_U_PATIENT_U_SERIES_U_REACTION_U_CONTRA_U_ENCDT_U_ENCPRV
- End DoDot:2
- End DoDot:1
- +26 ;
- +27 NEW PXBC
- +28 SET PXBC=0
- +29 IF $DATA(IMMUN)
- Begin DoDot:1
- +30 SET IMM=""
- +31 FOR
- SET IMM=$ORDER(IMMUN(IMM))
- IF IMM=""
- QUIT
- Begin DoDot:2
- +32 SET IEN=0
- +33 FOR
- SET IEN=$ORDER(IMMUN(IMM,IEN))
- IF IEN=""
- QUIT
- Begin DoDot:3
- +34 SET PXBC=PXBC+1
- +35 SET PXBKY(IMM,IEN)=IMMUN(IMM,IEN)
- +36 SET PXBSAM(PXBC)=IMMUN(IMM,IEN)
- +37 SET PXBSKY(PXBC,IEN)=IMMUN(IMM,IEN)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +38 ;
- +39 KILL ^TMP("PXBU",$JOB)
- +40 SET PXBCNT=PXBC
- +41 QUIT