- 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 Feb 18, 2025@23:52:33 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