PXAPIIM2 ;ISP/LMT - PCE Immunization APIs Cont. ;Aug 16, 2023@14:04
;;1.0;PCE PATIENT CARE ENCOUNTER;**217,236**;Aug 12, 1996;Build 17
;
;
Q
;
IMMGRP(PXRESULT,PXIMM,PXSKIPNOTLIMITED) ; called from IMMGRP^PXAPIIM
N PXCODE,PXCVX,PXICRIEN,PXICRNAME,PXIMMB,PXNAME,PXVGIEN,PXVGNAME
;
I '$G(PXIMM) Q
S PXSKIPNOTLIMITED=+$G(PXSKIPNOTLIMITED)
;
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
. ;
. I PXSKIPNOTLIMITED Q
. ; 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 1671 printed Apr 09, 2024@21:30:18 Page 2
PXAPIIM2 ;ISP/LMT - PCE Immunization APIs Cont. ;Aug 16, 2023@14:04
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217,236**;Aug 12, 1996;Build 17
+2 ;
+3 ;
+4 QUIT
+5 ;
IMMGRP(PXRESULT,PXIMM,PXSKIPNOTLIMITED) ; called from IMMGRP^PXAPIIM
+1 NEW PXCODE,PXCVX,PXICRIEN,PXICRNAME,PXIMMB,PXNAME,PXVGIEN,PXVGNAME
+2 ;
+3 IF '$GET(PXIMM)
QUIT
+4 SET PXSKIPNOTLIMITED=+$GET(PXSKIPNOTLIMITED)
+5 ;
+6 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMM,0)),U,1)
+7 ;
+8 SET PXCVX=$PIECE($GET(^AUTTIMM(PXIMM,0)),U,3)
+9 IF PXCVX'=""
Begin DoDot:1
+10 SET PXIMMB=0
+11 FOR
SET PXIMMB=$ORDER(^AUTTIMM("C",PXCVX,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+12 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMMB,0)),U,1)
+13 SET PXRESULT("CVX",PXCVX,PXIMMB)=PXNAME
End DoDot:2
End DoDot:1
+14 ;
+15 SET PXVGIEN=0
+16 FOR
SET PXVGIEN=$ORDER(^AUTTIMM(PXIMM,7,PXVGIEN))
if 'PXVGIEN
QUIT
Begin DoDot:1
+17 SET PXVGNAME=$PIECE($GET(^AUTTIMM(PXIMM,7,PXVGIEN,0)),U,1)
+18 IF PXVGNAME=""
QUIT
+19 SET PXIMMB=0
+20 FOR
SET PXIMMB=$ORDER(^AUTTIMM("I",PXVGNAME,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+21 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMMB,0)),U,1)
+22 SET PXRESULT("VG",PXVGNAME,PXIMMB)=PXNAME
End DoDot:2
End DoDot:1
+23 ;
+24 SET PXICRIEN=0
+25 FOR
SET PXICRIEN=$ORDER(^PXV(920.4,PXICRIEN))
if 'PXICRIEN
QUIT
Begin DoDot:1
+26 SET PXICRNAME=$PIECE($GET(^PXV(920.4,PXICRIEN,0)),U,1)
+27 ;
+28 ; If this imm is listed in the Immunizations Limited To
+29 ; multiple, include it
+30 IF $ORDER(^PXV(920.4,PXICRIEN,3,"B",PXIMM,0))
Begin DoDot:2
+31 SET PXRESULT("ICR",PXICRIEN_";PXV(920.4,")=PXICRNAME
End DoDot:2
QUIT
+32 ;
+33 IF PXSKIPNOTLIMITED
QUIT
+34 ; Include all contras that don't have the Immunizations
+35 ; Limited To multiple populated, except Severe Reaction
+36 ; Previous Dose
+37 IF '$ORDER(^PXV(920.4,PXICRIEN,3,0))
Begin DoDot:2
+38 SET PXCODE=$PIECE($GET(^PXV(920.4,PXICRIEN,0)),U,2)
+39 IF (PXICRNAME="SEVERE REACTION PREVIOUS DOSE")!(PXCODE="VXC20")
QUIT
+40 SET PXRESULT("ICR",PXICRIEN_";PXV(920.4,")=PXICRNAME
End DoDot:2
QUIT
End DoDot:1
+41 ;
+42 QUIT
