PXAPIIM ;BP/LMT - PCE Immunization APIs ;04/20/16 10:00
;;1.0;PCE PATIENT CARE ENCOUNTER;**210,215**;Aug 12, 1996;Build 10
;
; Reference to NAME in file .85 is supported by ICR #6062
;
Q
;
VIS(PXRESULT,PXVIS,PXDATE) ;Called from VIS^PXAPI
;
;Input:
; PXRESULT (required) Return value (passed by reference)
; PXVIS (required) Pointer to #920
; PXDATE (optional; defaults to NOW) The date in FileMan format.
; Used to check the status of the VIS on that date.
;Returns:
; PXRESULT("NAME") = VIS Name
; PXRESULT("EDITION DATE") = FileManager Internal Format for date/time
; PXRESULT("EDITION STATUS") = code^value (C^CURRENT or H^HISTORIC)
; PXRESULT("LANGUAGE") = IEN ^ Language (e.g., 1^ENGLISH)
; PXRESULT("2D BAR CODE") = Barcode from the CDC VIS barcode lookup table
; PXRESULT("VIS URL") = Internet URL for this VIS
; PXRESULT("STATUS") = Status based on PXDATE (1^ACTIVE or 0^INACTIVE)
;
N PXDATA,PXFILE,PXIENS,PXLANG,PXSTATUS
;
S PXFILE=920
S PXIENS=PXVIS_","
D GETS^DIQ(PXFILE,PXIENS,"*","EI","PXDATA")
;
S PXRESULT("NAME")=$G(PXDATA(PXFILE,PXIENS,.01,"E"))
S PXRESULT("EDITION DATE")=$G(PXDATA(PXFILE,PXIENS,.02,"I"))
S PXRESULT("EDITION STATUS")=$G(PXDATA(PXFILE,PXIENS,.03,"I"))_U_$G(PXDATA(PXFILE,PXIENS,.03,"E"))
S PXRESULT("2D BAR CODE")=$G(PXDATA(PXFILE,PXIENS,100,"E"))
S PXRESULT("VIS URL")=$G(PXDATA(PXFILE,PXIENS,101,"E"))
;
S PXLANG=$G(PXDATA(PXFILE,PXIENS,.04,"I"))
I PXLANG D
. S PXLANG=PXLANG_U_$$GET1^DIQ(.85,PXLANG_",","NAME") ;ICR 6062
S PXRESULT("LANGUAGE")=PXLANG
;
S PXSTATUS=$$GETSTAT^XTID(PXFILE,.01,PXIENS,$G(PXDATE))
S PXRESULT("STATUS")=$P(PXSTATUS,U,1)_U_$P(PXSTATUS,U,3)
;
Q
;
IMMGRP(PXRESULT,PXIMM) ;
;
; Returns a list of immunizations that share the same CVX code and Vaccine Group
; Name(s) as PXIMM, as well as Contraindications that are limited to PXIMM.
;
;Input:
; PXRESULT (required) Return value (passed by reference)
; PXIMM (required) Pointer to #9999999.14
;
;Returns:
; PXRESULT("CVX",CVX_CODE,IMM_IEN) = Immunization Name
; PXRESULT("VG",GROUP_NAME,IMM_IEN) = Immunization Name
; PXRESULT("ICR",CONTRA_VIEN) = Contraindication Name
;
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
;
IMMSTAT(PXIMM) ;
;
;Returns Immunization status
;
;Input:
; PXIMM - (required) Pointer to #9999999.14
;
;Returns:
; A: Active
; H: Inactive, but Selectable for Historic
; I: Inactive
;
I '$G(PXIMM) Q ""
I '$D(^AUTTIMM(PXIMM)) Q ""
I $P($G(^AUTTIMM(PXIMM,0)),U,7)="" Q "A"
I $P($G(^AUTTIMM(PXIMM,6)),U,1)="Y" Q "H"
Q "I"
;
IMMNODEF() ; Returns "IMMUNIZATION, NO DEFAULT SELECTED" entry
N PXIMM
S PXIMM=$O(^AUTTIMM("AVUID",5237389,0))
I 'PXIMM S PXIMM=$O(^AUTTIMM("B","IMMUNIZATION, NO DEFAULT SELECTED",0))
Q PXIMM
;
IMMBYNM(PXNAME) ; Finds Immunization that matches on PXNAME and returns IEN
N PXIMM
I $G(PXNAME)="" Q 0
S PXIMM=$O(^AUTTIMM("B",PXNAME,0))
I PXIMM Q PXIMM
S PXIMM=$O(^AUTTIMM("G",PXNAME,0))
I PXIMM Q PXIMM
S PXIMM=$O(^AUTTIMM("H",PXNAME,0))
I PXIMM Q PXIMM
Q 0
;
PATICR(PXRESULT,DFN,PXIMM,PXBDT,PXEDT) ;
;
; Finds all of a patient's contraindications/refusals using the following criteria:
; 1. Any current-dated contraindication/refusal for PXIMM AND any immunization
; that shares the same CVX code.
; 2. Any current-dated refusals for an immunization that shares the same vaccine
; group as PXIMM.
; 3. Any current-dated contraindications where the contraindication has PXIMM
; listed in the "Immunization Limited To" multiple.
; 4. Any current-dated contraindications where the contraindication does not have
; anything listed in the "Immunization Limited To" multiple, excluding Severe
; Reaction Previous Dose.
;
; * If PXBDT and PXEDT are null, then "current-dated" means where STOP >= TODAY.
; * If PXBDT and PXEDT are defined, then "current-dated" means where START
; <= PXEDT, and STOP is >= PXBDT.
;
;Input:
; PXRESULT - (required) Return value (passed by reference)
; DFN - (required) Pointer to #2
; PXIMM - (required) Pointer to #9999999.14
; PXBDT - (optional; defaults to TODAY) Begin Search Date
; PXEDT - (optional; defaults to 9999999) End Search Date
;
;Returns:
; PXRESULT(DAS) = Visit IEN ^ Contra/Refusal variable pointer | Contra/Refusal Name
; ^ Immunization IEN | Name ^ Warn Until Date ^ D/T Recorded ^ Event D/T
; ^ Encounter Provider IEN | Name
; PXRESULT(DAS,"COMMENTS") = Comments
;
; * DAS = Pointer to #9000010.707
;
N PXCVX,PXDAS,PXDATA,PXFILE,PXICR,PXIMMB,PXIMMGRP,PXSEARCH,PXSEARCHBY,PXSUB,PXVGN,PXX
;
I '$G(DFN)!('$G(PXIMM)) Q
;
S PXFILE=9000010.707
;
I $G(PXEDT)="" S PXEDT=9999999
I $G(PXBDT)="" S PXBDT=DT
I PXBDT S PXBDT=PXBDT-.0000001
;
D IMMGRP(.PXIMMGRP,PXIMM)
;
; >> Search based off criteria #1 & #2:
;
; PXSEARCH("ALL") - assists in searching based off criteria #1
S PXSEARCH("ALL",PXIMM)=""
S PXCVX=$O(PXIMMGRP("CVX",""))
I PXCVX'="" D
. S PXIMMB=0
. F S PXIMMB=$O(PXIMMGRP("CVX",PXCVX,PXIMMB)) Q:'PXIMMB D
. . S PXSEARCH("ALL",PXIMMB)=""
;
; PXSEARCH("REFUSALS") - assists in searching based off criteria #2
S PXVGN=""
F S PXVGN=$O(PXIMMGRP("VG",PXVGN)) Q:PXVGN="" D
. S PXIMMB=0
. F S PXIMMB=$O(PXIMMGRP("VG",PXVGN,PXIMMB)) Q:'PXIMMB D
. . I '$D(PXSEARCH("ALL",PXIMMB)) S PXSEARCH("REFUSALS",PXIMMB)=""
;
F PXSEARCHBY="ALL","REFUSALS" D
. S PXIMMB=0
. F S PXIMMB=$O(PXSEARCH(PXSEARCHBY,PXIMMB)) Q:'PXIMMB D
. . S PXICR=""
. . F S PXICR=$O(^PXRMINDX(PXFILE,"PIC",DFN,PXIMMB,PXICR)) Q:'PXICR D
. . . I PXSEARCHBY="REFUSALS",PXICR'[920.5 Q
. . . S PXSUB(1)=PXFILE,PXSUB(2)="PIC",PXSUB(3)=DFN,PXSUB(4)=PXIMMB,PXSUB(5)=PXICR
. . . D SEARCH(.PXRESULT,.PXSUB,.PXBDT,.PXEDT)
;
; >> Search based off criteria #3 & #4:
;
S PXICR=""
F S PXICR=$O(PXIMMGRP("ICR",PXICR)) Q:'PXICR D
. S PXIMMB=0
. F S PXIMMB=$O(^PXRMINDX(PXFILE,"PCI",DFN,PXICR,PXIMMB)) Q:'PXIMMB D
. . S PXSUB(1)=PXFILE,PXSUB(2)="PCI",PXSUB(3)=DFN,PXSUB(4)=PXICR,PXSUB(5)=PXIMMB
. . D SEARCH(.PXRESULT,.PXSUB,.PXBDT,.PXEDT)
;
; >> Setup return array fields:
S PXDAS=0
F S PXDAS=$O(PXRESULT(PXDAS)) Q:'PXDAS D
. D VICR^PXPXRM(PXDAS,.PXDATA)
. S PXX=$G(PXDATA("VISIT"))
. S PXX=PXX_U_$P($G(PXDATA("CONTRA/REFUSAL")),U,1)_"|"_$P($G(PXDATA("CONTRA/REFUSAL")),U,2)
. S PXX=PXX_U_$P($G(PXDATA("IMMUN")),U,1)_"|"_$P($G(PXDATA("IMMUN")),U,2)
. S PXX=PXX_U_$G(PXDATA("WARN UNTIL DATE"))
. S PXX=PXX_U_$G(PXDATA("D/T RECORDED"))
. S PXX=PXX_U_$G(PXDATA("EVENT D/T"))
. S PXX=PXX_U_$P($G(PXDATA("ENC PROVIDER")),U,1)_"|"_$P($G(PXDATA("ENC PROVIDER")),U,2)
. S PXRESULT(PXDAS)=PXX
. S PXRESULT(PXDAS,"COMMENTS")=$G(PXDATA("COMMENTS"))
;
Q
;
SEARCH(PXRESULT,PXSUB,PXBDT,PXEDT) ; Helper function for PATICR
;
N PXDAS,PXSTART,PXSTOP
;
S PXSTART=0
F S PXSTART=$O(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART)) Q:'PXSTART!(PXEDT<PXSTART) D
. S PXSTOP=PXBDT
. F S PXSTOP=$O(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART,PXSTOP)) Q:'PXSTOP D
. . S PXDAS=0
. . F S PXDAS=$O(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART,PXSTOP,PXDAS)) Q:'PXDAS D
. . . S PXRESULT(PXDAS)=""
;
Q
;
SITES(PXRSLT,PXROUTE,PXSORTBY) ;
;
;Returns list of selectable Sites for a given Route
;
;Input:
; PXROUTE - (required) Pointer to #920.2
; PXSORTBY - (optional; defaults to "N")
; "N" - Sort by Name
; "R" - Sort by IEN
;
;Returns:
; - If only a subset of sites are selectable for this route,
; that list will be returned in PXRSLT.
; o If PXSORTBY="N" - PXRSLT(Site_Name)=920_3_IEN ^ HL7 Code
; o If PXSORTBY="R" - PXRSLT(920_3_IEN)=Site_Name ^ HL7 Code
; - If all sites are selectable for this route, the API will return:
; PXRSLT("ALL")=""
; - If no sites are selectable for this route, the API will return:
; PXRSLT("NONE")=""
;
N PXI,PXSITE,PXSITEHL,PXSITENM
;
I '$G(PXROUTE) Q
I '$D(^PXV(920.2,PXROUTE,0)) Q
I $G(PXSORTBY)'?1(1"N",1"R") S PXSORTBY="N"
;
I $D(^PXV(920.6,PXROUTE)) D
. S PXI=0
. F S PXI=$O(^PXV(920.6,PXROUTE,1,PXI)) Q:'PXI D
. . S PXSITE=$P($G(^PXV(920.6,PXROUTE,1,PXI,0)),U,1)
. . S PXSITENM=$P($G(^PXV(920.3,+PXSITE,0)),U,1)
. . S PXSITEHL=$P($G(^PXV(920.3,PXSITE,0)),U,2)
. . I PXSITENM="" Q
. . I PXSORTBY="N" S PXRSLT(PXSITENM)=PXSITE_U_PXSITEHL
. . I PXSORTBY="R" S PXRSLT(PXSITE)=PXSITENM_U_PXSITEHL
. ;
. ; if this route exists in 920.6, but is not mapped to any sites
. ; then no sites should be selectable for this route (e.g., Oral)
. I '$D(PXRSLT) S PXRSLT("NONE")=""
;
; If no mapping exists, all entries are selectable
I '$D(^PXV(920.6,PXROUTE)) D
. S PXRSLT("ALL")=""
;
Q
;
IMMDEF(PXRSLT,PXIMM,PXINST) ;
;
N PXIEN,PXPRNT,PXSTA
;
I '$G(PXIMM)!('$G(PXINST)) Q
I $D(PXINST(PXINST)) Q ; Used to prevent infinite recursion
;
S PXIEN=$O(^PXV(920.05,"AC",PXINST,PXIMM,0))
;
I PXIEN D Q
. M PXRSLT=^PXV(920.05,PXIEN,1,PXIMM)
;
; If site did not create defaults, make recursive
; call for parent Institution; if parent has defaults,
; inherit from parent.
I 'PXIEN D Q
. S PXSTA=$$STA^XUAF4(PXINST)
. I PXSTA="" Q
. S PXPRNT=$$PRNT^XUAF4(PXSTA)
. ;
. ; If parent = self, we reached the top of the chain
. I $P(PXPRNT,U,2)=PXSTA Q
. I (+PXPRNT)=PXINST Q
. I 'PXPRNT Q
. ;
. ; Used to prevent infinite recursion
. S PXINST(PXINST)=""
. ;
. S PXINST=+PXPRNT
. D IMMDEF(.PXRSLT,PXIMM,.PXINST)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAPIIM 11097 printed Nov 24, 2021@03:26:05 Page 2
PXAPIIM ;BP/LMT - PCE Immunization APIs ;04/20/16 10:00
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**210,215**;Aug 12, 1996;Build 10
+2 ;
+3 ; Reference to NAME in file .85 is supported by ICR #6062
+4 ;
+5 QUIT
+6 ;
VIS(PXRESULT,PXVIS,PXDATE) ;Called from VIS^PXAPI
+1 ;
+2 ;Input:
+3 ; PXRESULT (required) Return value (passed by reference)
+4 ; PXVIS (required) Pointer to #920
+5 ; PXDATE (optional; defaults to NOW) The date in FileMan format.
+6 ; Used to check the status of the VIS on that date.
+7 ;Returns:
+8 ; PXRESULT("NAME") = VIS Name
+9 ; PXRESULT("EDITION DATE") = FileManager Internal Format for date/time
+10 ; PXRESULT("EDITION STATUS") = code^value (C^CURRENT or H^HISTORIC)
+11 ; PXRESULT("LANGUAGE") = IEN ^ Language (e.g., 1^ENGLISH)
+12 ; PXRESULT("2D BAR CODE") = Barcode from the CDC VIS barcode lookup table
+13 ; PXRESULT("VIS URL") = Internet URL for this VIS
+14 ; PXRESULT("STATUS") = Status based on PXDATE (1^ACTIVE or 0^INACTIVE)
+15 ;
+16 NEW PXDATA,PXFILE,PXIENS,PXLANG,PXSTATUS
+17 ;
+18 SET PXFILE=920
+19 SET PXIENS=PXVIS_","
+20 DO GETS^DIQ(PXFILE,PXIENS,"*","EI","PXDATA")
+21 ;
+22 SET PXRESULT("NAME")=$GET(PXDATA(PXFILE,PXIENS,.01,"E"))
+23 SET PXRESULT("EDITION DATE")=$GET(PXDATA(PXFILE,PXIENS,.02,"I"))
+24 SET PXRESULT("EDITION STATUS")=$GET(PXDATA(PXFILE,PXIENS,.03,"I"))_U_$GET(PXDATA(PXFILE,PXIENS,.03,"E"))
+25 SET PXRESULT("2D BAR CODE")=$GET(PXDATA(PXFILE,PXIENS,100,"E"))
+26 SET PXRESULT("VIS URL")=$GET(PXDATA(PXFILE,PXIENS,101,"E"))
+27 ;
+28 SET PXLANG=$GET(PXDATA(PXFILE,PXIENS,.04,"I"))
+29 IF PXLANG
Begin DoDot:1
+30 ;ICR 6062
SET PXLANG=PXLANG_U_$$GET1^DIQ(.85,PXLANG_",","NAME")
End DoDot:1
+31 SET PXRESULT("LANGUAGE")=PXLANG
+32 ;
+33 SET PXSTATUS=$$GETSTAT^XTID(PXFILE,.01,PXIENS,$GET(PXDATE))
+34 SET PXRESULT("STATUS")=$PIECE(PXSTATUS,U,1)_U_$PIECE(PXSTATUS,U,3)
+35 ;
+36 QUIT
+37 ;
IMMGRP(PXRESULT,PXIMM) ;
+1 ;
+2 ; Returns a list of immunizations that share the same CVX code and Vaccine Group
+3 ; Name(s) as PXIMM, as well as Contraindications that are limited to PXIMM.
+4 ;
+5 ;Input:
+6 ; PXRESULT (required) Return value (passed by reference)
+7 ; PXIMM (required) Pointer to #9999999.14
+8 ;
+9 ;Returns:
+10 ; PXRESULT("CVX",CVX_CODE,IMM_IEN) = Immunization Name
+11 ; PXRESULT("VG",GROUP_NAME,IMM_IEN) = Immunization Name
+12 ; PXRESULT("ICR",CONTRA_VIEN) = Contraindication Name
+13 ;
+14 NEW PXCODE,PXCVX,PXICRIEN,PXICRNAME,PXIMMB,PXNAME,PXVGIEN,PXVGNAME
+15 ;
+16 IF '$GET(PXIMM)
QUIT
+17 ;
+18 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMM,0)),U,1)
+19 ;
+20 SET PXCVX=$PIECE($GET(^AUTTIMM(PXIMM,0)),U,3)
+21 IF PXCVX'=""
Begin DoDot:1
+22 SET PXIMMB=0
+23 FOR
SET PXIMMB=$ORDER(^AUTTIMM("C",PXCVX,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+24 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMMB,0)),U,1)
+25 SET PXRESULT("CVX",PXCVX,PXIMMB)=PXNAME
End DoDot:2
End DoDot:1
+26 ;
+27 SET PXVGIEN=0
+28 FOR
SET PXVGIEN=$ORDER(^AUTTIMM(PXIMM,7,PXVGIEN))
if 'PXVGIEN
QUIT
Begin DoDot:1
+29 SET PXVGNAME=$PIECE($GET(^AUTTIMM(PXIMM,7,PXVGIEN,0)),U,1)
+30 IF PXVGNAME=""
QUIT
+31 SET PXIMMB=0
+32 FOR
SET PXIMMB=$ORDER(^AUTTIMM("I",PXVGNAME,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+33 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMMB,0)),U,1)
+34 SET PXRESULT("VG",PXVGNAME,PXIMMB)=PXNAME
End DoDot:2
End DoDot:1
+35 ;
+36 SET PXICRIEN=0
+37 FOR
SET PXICRIEN=$ORDER(^PXV(920.4,PXICRIEN))
if 'PXICRIEN
QUIT
Begin DoDot:1
+38 SET PXICRNAME=$PIECE($GET(^PXV(920.4,PXICRIEN,0)),U,1)
+39 ;
+40 ; If this imm is listed in the Immunizations Limited To
+41 ; multiple, include it
+42 IF $ORDER(^PXV(920.4,PXICRIEN,3,"B",PXIMM,0))
Begin DoDot:2
+43 SET PXRESULT("ICR",PXICRIEN_";PXV(920.4,")=PXICRNAME
End DoDot:2
QUIT
+44 ;
+45 ; Include all contras that don't have the Immunizations
+46 ; Limited To multiple populated, except Severe Reaction
+47 ; Previous Dose
+48 IF '$ORDER(^PXV(920.4,PXICRIEN,3,0))
Begin DoDot:2
+49 SET PXCODE=$PIECE($GET(^PXV(920.4,PXICRIEN,0)),U,2)
+50 IF (PXICRNAME="SEVERE REACTION PREVIOUS DOSE")!(PXCODE="VXC20")
QUIT
+51 SET PXRESULT("ICR",PXICRIEN_";PXV(920.4,")=PXICRNAME
End DoDot:2
QUIT
End DoDot:1
+52 ;
+53 QUIT
+54 ;
IMMSTAT(PXIMM) ;
+1 ;
+2 ;Returns Immunization status
+3 ;
+4 ;Input:
+5 ; PXIMM - (required) Pointer to #9999999.14
+6 ;
+7 ;Returns:
+8 ; A: Active
+9 ; H: Inactive, but Selectable for Historic
+10 ; I: Inactive
+11 ;
+12 IF '$GET(PXIMM)
QUIT ""
+13 IF '$DATA(^AUTTIMM(PXIMM))
QUIT ""
+14 IF $PIECE($GET(^AUTTIMM(PXIMM,0)),U,7)=""
QUIT "A"
+15 IF $PIECE($GET(^AUTTIMM(PXIMM,6)),U,1)="Y"
QUIT "H"
+16 QUIT "I"
+17 ;
IMMNODEF() ; Returns "IMMUNIZATION, NO DEFAULT SELECTED" entry
+1 NEW PXIMM
+2 SET PXIMM=$ORDER(^AUTTIMM("AVUID",5237389,0))
+3 IF 'PXIMM
SET PXIMM=$ORDER(^AUTTIMM("B","IMMUNIZATION, NO DEFAULT SELECTED",0))
+4 QUIT PXIMM
+5 ;
IMMBYNM(PXNAME) ; Finds Immunization that matches on PXNAME and returns IEN
+1 NEW PXIMM
+2 IF $GET(PXNAME)=""
QUIT 0
+3 SET PXIMM=$ORDER(^AUTTIMM("B",PXNAME,0))
+4 IF PXIMM
QUIT PXIMM
+5 SET PXIMM=$ORDER(^AUTTIMM("G",PXNAME,0))
+6 IF PXIMM
QUIT PXIMM
+7 SET PXIMM=$ORDER(^AUTTIMM("H",PXNAME,0))
+8 IF PXIMM
QUIT PXIMM
+9 QUIT 0
+10 ;
PATICR(PXRESULT,DFN,PXIMM,PXBDT,PXEDT) ;
+1 ;
+2 ; Finds all of a patient's contraindications/refusals using the following criteria:
+3 ; 1. Any current-dated contraindication/refusal for PXIMM AND any immunization
+4 ; that shares the same CVX code.
+5 ; 2. Any current-dated refusals for an immunization that shares the same vaccine
+6 ; group as PXIMM.
+7 ; 3. Any current-dated contraindications where the contraindication has PXIMM
+8 ; listed in the "Immunization Limited To" multiple.
+9 ; 4. Any current-dated contraindications where the contraindication does not have
+10 ; anything listed in the "Immunization Limited To" multiple, excluding Severe
+11 ; Reaction Previous Dose.
+12 ;
+13 ; * If PXBDT and PXEDT are null, then "current-dated" means where STOP >= TODAY.
+14 ; * If PXBDT and PXEDT are defined, then "current-dated" means where START
+15 ; <= PXEDT, and STOP is >= PXBDT.
+16 ;
+17 ;Input:
+18 ; PXRESULT - (required) Return value (passed by reference)
+19 ; DFN - (required) Pointer to #2
+20 ; PXIMM - (required) Pointer to #9999999.14
+21 ; PXBDT - (optional; defaults to TODAY) Begin Search Date
+22 ; PXEDT - (optional; defaults to 9999999) End Search Date
+23 ;
+24 ;Returns:
+25 ; PXRESULT(DAS) = Visit IEN ^ Contra/Refusal variable pointer | Contra/Refusal Name
+26 ; ^ Immunization IEN | Name ^ Warn Until Date ^ D/T Recorded ^ Event D/T
+27 ; ^ Encounter Provider IEN | Name
+28 ; PXRESULT(DAS,"COMMENTS") = Comments
+29 ;
+30 ; * DAS = Pointer to #9000010.707
+31 ;
+32 NEW PXCVX,PXDAS,PXDATA,PXFILE,PXICR,PXIMMB,PXIMMGRP,PXSEARCH,PXSEARCHBY,PXSUB,PXVGN,PXX
+33 ;
+34 IF '$GET(DFN)!('$GET(PXIMM))
QUIT
+35 ;
+36 SET PXFILE=9000010.707
+37 ;
+38 IF $GET(PXEDT)=""
SET PXEDT=9999999
+39 IF $GET(PXBDT)=""
SET PXBDT=DT
+40 IF PXBDT
SET PXBDT=PXBDT-.0000001
+41 ;
+42 DO IMMGRP(.PXIMMGRP,PXIMM)
+43 ;
+44 ; >> Search based off criteria #1 & #2:
+45 ;
+46 ; PXSEARCH("ALL") - assists in searching based off criteria #1
+47 SET PXSEARCH("ALL",PXIMM)=""
+48 SET PXCVX=$ORDER(PXIMMGRP("CVX",""))
+49 IF PXCVX'=""
Begin DoDot:1
+50 SET PXIMMB=0
+51 FOR
SET PXIMMB=$ORDER(PXIMMGRP("CVX",PXCVX,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+52 SET PXSEARCH("ALL",PXIMMB)=""
End DoDot:2
End DoDot:1
+53 ;
+54 ; PXSEARCH("REFUSALS") - assists in searching based off criteria #2
+55 SET PXVGN=""
+56 FOR
SET PXVGN=$ORDER(PXIMMGRP("VG",PXVGN))
if PXVGN=""
QUIT
Begin DoDot:1
+57 SET PXIMMB=0
+58 FOR
SET PXIMMB=$ORDER(PXIMMGRP("VG",PXVGN,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+59 IF '$DATA(PXSEARCH("ALL",PXIMMB))
SET PXSEARCH("REFUSALS",PXIMMB)=""
End DoDot:2
End DoDot:1
+60 ;
+61 FOR PXSEARCHBY="ALL","REFUSALS"
Begin DoDot:1
+62 SET PXIMMB=0
+63 FOR
SET PXIMMB=$ORDER(PXSEARCH(PXSEARCHBY,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+64 SET PXICR=""
+65 FOR
SET PXICR=$ORDER(^PXRMINDX(PXFILE,"PIC",DFN,PXIMMB,PXICR))
if 'PXICR
QUIT
Begin DoDot:3
+66 IF PXSEARCHBY="REFUSALS"
IF PXICR'[920.5
QUIT
+67 SET PXSUB(1)=PXFILE
SET PXSUB(2)="PIC"
SET PXSUB(3)=DFN
SET PXSUB(4)=PXIMMB
SET PXSUB(5)=PXICR
+68 DO SEARCH(.PXRESULT,.PXSUB,.PXBDT,.PXEDT)
End DoDot:3
End DoDot:2
End DoDot:1
+69 ;
+70 ; >> Search based off criteria #3 & #4:
+71 ;
+72 SET PXICR=""
+73 FOR
SET PXICR=$ORDER(PXIMMGRP("ICR",PXICR))
if 'PXICR
QUIT
Begin DoDot:1
+74 SET PXIMMB=0
+75 FOR
SET PXIMMB=$ORDER(^PXRMINDX(PXFILE,"PCI",DFN,PXICR,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+76 SET PXSUB(1)=PXFILE
SET PXSUB(2)="PCI"
SET PXSUB(3)=DFN
SET PXSUB(4)=PXICR
SET PXSUB(5)=PXIMMB
+77 DO SEARCH(.PXRESULT,.PXSUB,.PXBDT,.PXEDT)
End DoDot:2
End DoDot:1
+78 ;
+79 ; >> Setup return array fields:
+80 SET PXDAS=0
+81 FOR
SET PXDAS=$ORDER(PXRESULT(PXDAS))
if 'PXDAS
QUIT
Begin DoDot:1
+82 DO VICR^PXPXRM(PXDAS,.PXDATA)
+83 SET PXX=$GET(PXDATA("VISIT"))
+84 SET PXX=PXX_U_$PIECE($GET(PXDATA("CONTRA/REFUSAL")),U,1)_"|"_$PIECE($GET(PXDATA("CONTRA/REFUSAL")),U,2)
+85 SET PXX=PXX_U_$PIECE($GET(PXDATA("IMMUN")),U,1)_"|"_$PIECE($GET(PXDATA("IMMUN")),U,2)
+86 SET PXX=PXX_U_$GET(PXDATA("WARN UNTIL DATE"))
+87 SET PXX=PXX_U_$GET(PXDATA("D/T RECORDED"))
+88 SET PXX=PXX_U_$GET(PXDATA("EVENT D/T"))
+89 SET PXX=PXX_U_$PIECE($GET(PXDATA("ENC PROVIDER")),U,1)_"|"_$PIECE($GET(PXDATA("ENC PROVIDER")),U,2)
+90 SET PXRESULT(PXDAS)=PXX
+91 SET PXRESULT(PXDAS,"COMMENTS")=$GET(PXDATA("COMMENTS"))
End DoDot:1
+92 ;
+93 QUIT
+94 ;
SEARCH(PXRESULT,PXSUB,PXBDT,PXEDT) ; Helper function for PATICR
+1 ;
+2 NEW PXDAS,PXSTART,PXSTOP
+3 ;
+4 SET PXSTART=0
+5 FOR
SET PXSTART=$ORDER(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART))
if 'PXSTART!(PXEDT<PXSTART)
QUIT
Begin DoDot:1
+6 SET PXSTOP=PXBDT
+7 FOR
SET PXSTOP=$ORDER(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART,PXSTOP))
if 'PXSTOP
QUIT
Begin DoDot:2
+8 SET PXDAS=0
+9 FOR
SET PXDAS=$ORDER(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART,PXSTOP,PXDAS))
if 'PXDAS
QUIT
Begin DoDot:3
+10 SET PXRESULT(PXDAS)=""
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;
+12 QUIT
+13 ;
SITES(PXRSLT,PXROUTE,PXSORTBY) ;
+1 ;
+2 ;Returns list of selectable Sites for a given Route
+3 ;
+4 ;Input:
+5 ; PXROUTE - (required) Pointer to #920.2
+6 ; PXSORTBY - (optional; defaults to "N")
+7 ; "N" - Sort by Name
+8 ; "R" - Sort by IEN
+9 ;
+10 ;Returns:
+11 ; - If only a subset of sites are selectable for this route,
+12 ; that list will be returned in PXRSLT.
+13 ; o If PXSORTBY="N" - PXRSLT(Site_Name)=920_3_IEN ^ HL7 Code
+14 ; o If PXSORTBY="R" - PXRSLT(920_3_IEN)=Site_Name ^ HL7 Code
+15 ; - If all sites are selectable for this route, the API will return:
+16 ; PXRSLT("ALL")=""
+17 ; - If no sites are selectable for this route, the API will return:
+18 ; PXRSLT("NONE")=""
+19 ;
+20 NEW PXI,PXSITE,PXSITEHL,PXSITENM
+21 ;
+22 IF '$GET(PXROUTE)
QUIT
+23 IF '$DATA(^PXV(920.2,PXROUTE,0))
QUIT
+24 IF $GET(PXSORTBY)'?1(1"N",1"R")
SET PXSORTBY="N"
+25 ;
+26 IF $DATA(^PXV(920.6,PXROUTE))
Begin DoDot:1
+27 SET PXI=0
+28 FOR
SET PXI=$ORDER(^PXV(920.6,PXROUTE,1,PXI))
if 'PXI
QUIT
Begin DoDot:2
+29 SET PXSITE=$PIECE($GET(^PXV(920.6,PXROUTE,1,PXI,0)),U,1)
+30 SET PXSITENM=$PIECE($GET(^PXV(920.3,+PXSITE,0)),U,1)
+31 SET PXSITEHL=$PIECE($GET(^PXV(920.3,PXSITE,0)),U,2)
+32 IF PXSITENM=""
QUIT
+33 IF PXSORTBY="N"
SET PXRSLT(PXSITENM)=PXSITE_U_PXSITEHL
+34 IF PXSORTBY="R"
SET PXRSLT(PXSITE)=PXSITENM_U_PXSITEHL
End DoDot:2
+35 ;
+36 ; if this route exists in 920.6, but is not mapped to any sites
+37 ; then no sites should be selectable for this route (e.g., Oral)
+38 IF '$DATA(PXRSLT)
SET PXRSLT("NONE")=""
End DoDot:1
+39 ;
+40 ; If no mapping exists, all entries are selectable
+41 IF '$DATA(^PXV(920.6,PXROUTE))
Begin DoDot:1
+42 SET PXRSLT("ALL")=""
End DoDot:1
+43 ;
+44 QUIT
+45 ;
IMMDEF(PXRSLT,PXIMM,PXINST) ;
+1 ;
+2 NEW PXIEN,PXPRNT,PXSTA
+3 ;
+4 IF '$GET(PXIMM)!('$GET(PXINST))
QUIT
+5 ; Used to prevent infinite recursion
IF $DATA(PXINST(PXINST))
QUIT
+6 ;
+7 SET PXIEN=$ORDER(^PXV(920.05,"AC",PXINST,PXIMM,0))
+8 ;
+9 IF PXIEN
Begin DoDot:1
+10 MERGE PXRSLT=^PXV(920.05,PXIEN,1,PXIMM)
End DoDot:1
QUIT
+11 ;
+12 ; If site did not create defaults, make recursive
+13 ; call for parent Institution; if parent has defaults,
+14 ; inherit from parent.
+15 IF 'PXIEN
Begin DoDot:1
+16 SET PXSTA=$$STA^XUAF4(PXINST)
+17 IF PXSTA=""
QUIT
+18 SET PXPRNT=$$PRNT^XUAF4(PXSTA)
+19 ;
+20 ; If parent = self, we reached the top of the chain
+21 IF $PIECE(PXPRNT,U,2)=PXSTA
QUIT
+22 IF (+PXPRNT)=PXINST
QUIT
+23 IF 'PXPRNT
QUIT
+24 ;
+25 ; Used to prevent infinite recursion
+26 SET PXINST(PXINST)=""
+27 ;
+28 SET PXINST=+PXPRNT
+29 DO IMMDEF(.PXRSLT,PXIMM,.PXINST)
End DoDot:1
QUIT
+30 ;
+31 QUIT
