PXAPIIM2 ;ISP/LMT - PCE Immunization APIs Cont. ;Jun 03, 2021@09:56:01
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
;
Q
;
IMMGRP(PXRESULT,PXIMM) ; called from IMMGRP^PXAPIIM
N PXCODE,PXCVX,PXICRIEN,PXICRNAME,PXIMMB,PXNAME,PXVGIEN,PXVGNAME
;
I '$G(PXIMM) Q
;
S PXNAME=$P($G(^AUTTIMM(PXIMM,0)),U,1)
;
S PXCVX=$P($G(^AUTTIMM(PXIMM,0)),U,3)
I PXCVX'="" D
. S PXIMMB=0
. F S PXIMMB=$O(^AUTTIMM("C",PXCVX,PXIMMB)) Q:'PXIMMB D
. . S PXNAME=$P($G(^AUTTIMM(PXIMMB,0)),U,1)
. . S PXRESULT("CVX",PXCVX,PXIMMB)=PXNAME
;
S PXVGIEN=0
F S PXVGIEN=$O(^AUTTIMM(PXIMM,7,PXVGIEN)) Q:'PXVGIEN D
. S PXVGNAME=$P($G(^AUTTIMM(PXIMM,7,PXVGIEN,0)),U,1)
. I PXVGNAME="" Q
. S PXIMMB=0
. F S PXIMMB=$O(^AUTTIMM("I",PXVGNAME,PXIMMB)) Q:'PXIMMB D
. . S PXNAME=$P($G(^AUTTIMM(PXIMMB,0)),U,1)
. . S PXRESULT("VG",PXVGNAME,PXIMMB)=PXNAME
;
S PXICRIEN=0
F S PXICRIEN=$O(^PXV(920.4,PXICRIEN)) Q:'PXICRIEN D
. S PXICRNAME=$P($G(^PXV(920.4,PXICRIEN,0)),U,1)
. ;
. ; If this imm is listed in the Immunizations Limited To
. ; multiple, include it
. I $O(^PXV(920.4,PXICRIEN,3,"B",PXIMM,0)) D Q
. . S PXRESULT("ICR",PXICRIEN_";PXV(920.4,")=PXICRNAME
. ;
. ; Include all contras that don't have the Immunizations
. ; Limited To multiple populated, except Severe Reaction
. ; Previous Dose
. I '$O(^PXV(920.4,PXICRIEN,3,0)) D Q
. . S PXCODE=$P($G(^PXV(920.4,PXICRIEN,0)),U,2)
. . I (PXICRNAME="SEVERE REACTION PREVIOUS DOSE")!(PXCODE="VXC20") Q
. . S PXRESULT("ICR",PXICRIEN_";PXV(920.4,")=PXICRNAME
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAPIIM2 1586 printed Mar 10, 2023@00:24:59 Page 2
PXAPIIM2 ;ISP/LMT - PCE Immunization APIs Cont. ;Jun 03, 2021@09:56:01
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 ;
+3 ;
+4 QUIT
+5 ;
IMMGRP(PXRESULT,PXIMM) ; called from IMMGRP^PXAPIIM
+1 NEW PXCODE,PXCVX,PXICRIEN,PXICRNAME,PXIMMB,PXNAME,PXVGIEN,PXVGNAME
+2 ;
+3 IF '$GET(PXIMM)
QUIT
+4 ;
+5 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMM,0)),U,1)
+6 ;
+7 SET PXCVX=$PIECE($GET(^AUTTIMM(PXIMM,0)),U,3)
+8 IF PXCVX'=""
Begin DoDot:1
+9 SET PXIMMB=0
+10 FOR
SET PXIMMB=$ORDER(^AUTTIMM("C",PXCVX,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+11 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMMB,0)),U,1)
+12 SET PXRESULT("CVX",PXCVX,PXIMMB)=PXNAME
End DoDot:2
End DoDot:1
+13 ;
+14 SET PXVGIEN=0
+15 FOR
SET PXVGIEN=$ORDER(^AUTTIMM(PXIMM,7,PXVGIEN))
if 'PXVGIEN
QUIT
Begin DoDot:1
+16 SET PXVGNAME=$PIECE($GET(^AUTTIMM(PXIMM,7,PXVGIEN,0)),U,1)
+17 IF PXVGNAME=""
QUIT
+18 SET PXIMMB=0
+19 FOR
SET PXIMMB=$ORDER(^AUTTIMM("I",PXVGNAME,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+20 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMMB,0)),U,1)
+21 SET PXRESULT("VG",PXVGNAME,PXIMMB)=PXNAME
End DoDot:2
End DoDot:1
+22 ;
+23 SET PXICRIEN=0
+24 FOR
SET PXICRIEN=$ORDER(^PXV(920.4,PXICRIEN))
if 'PXICRIEN
QUIT
Begin DoDot:1
+25 SET PXICRNAME=$PIECE($GET(^PXV(920.4,PXICRIEN,0)),U,1)
+26 ;
+27 ; If this imm is listed in the Immunizations Limited To
+28 ; multiple, include it
+29 IF $ORDER(^PXV(920.4,PXICRIEN,3,"B",PXIMM,0))
Begin DoDot:2
+30 SET PXRESULT("ICR",PXICRIEN_";PXV(920.4,")=PXICRNAME
End DoDot:2
QUIT
+31 ;
+32 ; Include all contras that don't have the Immunizations
+33 ; Limited To multiple populated, except Severe Reaction
+34 ; Previous Dose
+35 IF '$ORDER(^PXV(920.4,PXICRIEN,3,0))
Begin DoDot:2
+36 SET PXCODE=$PIECE($GET(^PXV(920.4,PXICRIEN,0)),U,2)
+37 IF (PXICRNAME="SEVERE REACTION PREVIOUS DOSE")!(PXCODE="VXC20")
QUIT
+38 SET PXRESULT("ICR",PXICRIEN_";PXV(920.4,")=PXICRNAME
End DoDot:2
QUIT
End DoDot:1
+39 ;
+40 QUIT
