PXVRPC4 ;BPFO/LMT - PCE RPCs for Immunization(s) ;Jan 18, 2023@15:08:57
;;1.0;PCE PATIENT CARE ENCOUNTER;**215,216,217,233**;Aug 12, 1996;Build 3
;
; Reference to ^DIA(9999999.14,"C") in ICR #2602
; Reference to NAME in file .85 in ICR #6062
; Reference to EXCLUDED^ORWPCE2 in ICR #7399
;
IMMRPC(PXRTRN,PXIMM,PXDATE,PXLOC) ; Entry point for RPC
;
; Returns an Immunization object
;
;Input:
; PXRTRN - Return value passed by reference (Required)
; PXIMM - Pointer to #9999999.14 (Required)
; PXDATE - Immunization status and Codes will be based off this date
; (Optional; Defaults to NOW)
; PXLOC - Used to determine Institution (used when filtering Lot and Defaults) (Optional)
; Possible values are:
; "I:X": Institution (#4) IEN #X
; "V:X": Visit (#9000010) IEN #X
; "L:X": Hospital Location (#44) IEN #X
; If PXLOC is not passed in OR could not make determination based off
; input, then default to DUZ(2), and if DUZ(2) is not defined,
; default to Default Institution.
;
;Returns:
; ^TMP("PXVIMMRPC",$J,0)
; 1: 1 - Immunization was found. The "1" node will be returned, but
; the other nodes are optional.
; -1 - Immunization was not found; no other nodes will be returned
; ^TMP("PXVIMMRPC",$J,1)
; Note: Status (in the 5th piece) is determined as follows:
; - If PXDATE is today, the status is based off the Inactive Flag (#.07)
; - If PXDATE is different than today, we will look when an update was
; last made to the Immunization file (based off the Audits).
; If there have not been any changes since PXDATE, we will get the
; status based off the Inactive Flag, otherwise, we will get the
; status for that date by calling GETSTAT^XTID.
; 1: "IMM"
; 2: #9999999.14 IEN
; 3: Name (#.01)
; 4: CVX Code (#.03)
; 5: Status (1: Active; 0: Inactive)
; 6: Selectable for Historic (#8803)
; 7: Mnemonic (#8801)
; 8: Acronym (#8802)
; 9: Max # In Series (#.05)
; 10: Combination Immunization (Y/N) (#.2)
; 11: Reading Required (#.51)
; 12: Series Required (calculated)
; ^TMP("PXVIMMRPC",$J,x)
; 1: "VIS"
; 2: #920 IEN
; 3: Name (#920,#.01)
; 4: Edition Date (#920,#.02)
; 5: Edition Status (#920,#.03)
; 6: Language (#920, #.04)
; 7: 2D Bar Code (#100)
; 8: VIS URL (#101)
; ^TMP("PXVIMMRPC",$J,x)
; 1: "CDC"
; 2: CDC Product Name (#9999999.145, #.01)
; ^TMP("PXVIMMRPC",$J,x)
; 1: "GROUP"
; 2: Vaccine Group Name (#9999999.147, #.01)
; ^TMP("PXVIMMRPC",$J,x)
; 1: "SYNONYM"
; 2: Synonym (#9999999.141, #.01)
; ^TMP("PXVIMMRPC",$J,x)
; Note: Only active codes (based off PXDATE) are returned.
; 1: "CS"
; 2: Coding System (#9999999.143, #.01)
; 3: Code (#9999999.1431,#.01)
; 4: Variable pointer. e.g., IEN;ICPT(
; 5: Short Description
; ^TMP("PXVIMMRPC",$J,x)
; Note: Only active lots for the given division are returned.
; Also, the Expiration date must be >= PXDATE
; 1: "LOT"
; 2: #9999999.41 IEN
; 3: Lot Number (#9999999.41, #.01)
; 4: Manufacturer (#9999999.04, #.01)
; 5: Expiration Date (#9999999.41, #.09)
; 6: Doses Unused (#9999999.41, #.12)
; 7: Low Supply Alert (#9999999.41, #.15)
; 8: NDC Code (#9999999.41, #.18)
; ^TMP("PXVIMMRPC",$J,x)
; Note: Only active contraindications are returned
; 1: "CONTRA"
; 2: #920.4 variable pointer: IEN;PXV(920.4,
; 3: Name (#920.4, #.01)
; 4: Status (1:Active, 0:Inactive)
; 5: Code|Coding System (#920.4, #.02 and .05)
; 6: NIP004 (#920.4, #.04)
; 7: Contraindication/Precaution (#920.4, #.06)
; 8: Allergy-Related (1:Yes, 0:No)
; 9: Default Warn Until Date ("Forever" means it should be forever)
; ^TMP("PXVIMMRPC",$J,x)
; 1: "DEF"
; 2: Default Route (#920.051, #1302)
; 3: Default Site (#920.051, #1303)
; 4: Default Dose (#920.051, #1312)
; 5: Default Dose Units (#920.051, #1313)
; 6: Default Dose Units (external format) (#920.051, #1313)
; 7: Default Non-Standard Dose Units (#920.051, #1314)
; ^TMP("PXVIMMRPC",$J,x)
; 1: "DEFC"
; 2: Default Comments (#920.051, #81101)
;
N PXCNT,PXCODESYS,PXFLD,PXI,PXIMMARR,PXIMMSUB,PXNODE,PXSUB
;
S PXSUB="PXVIMMRPC"
S PXRTRN=$NA(^TMP(PXSUB,$J))
K ^TMP(PXSUB,$J)
;
D GETIMM(.PXIMMARR,$G(PXIMM),$G(PXDATE),$G(PXLOC))
S PXIMMSUB="PXVIMM"
;
S PXCNT=0
;
I '$D(^TMP(PXIMMSUB,$J)) D Q
. S ^TMP(PXSUB,$J,PXCNT)="-1"
;
S ^TMP(PXSUB,$J,PXCNT)=1
S PXCNT=PXCNT+1
S ^TMP(PXSUB,$J,PXCNT)="IMM"_U_$G(^TMP(PXIMMSUB,$J,0))
;
F PXFLD="VIS","LOT","CDC","GROUP","SYNONYM","CONTRA","DEF","DEFC" D
. I '$D(^TMP(PXIMMSUB,$J,PXFLD)) Q
. S PXI=0 F S PXI=$O(^TMP(PXIMMSUB,$J,PXFLD,PXI)) Q:'PXI D
. . S PXNODE=$G(^TMP(PXIMMSUB,$J,PXFLD,PXI,0))
. . I PXNODE="" Q
. . S PXCNT=PXCNT+1
. . S ^TMP(PXSUB,$J,PXCNT)=PXFLD_U_PXNODE
;
S PXFLD="CS"
I $D(^TMP(PXIMMSUB,$J,PXFLD)) D
. S PXCODESYS=""
. F S PXCODESYS=$O(^TMP(PXIMMSUB,$J,PXFLD,PXCODESYS)) Q:PXCODESYS="" D
. . S PXI=0
. . F S PXI=$O(^TMP(PXIMMSUB,$J,PXFLD,PXCODESYS,PXI)) Q:'PXI D
. . . S PXNODE=$G(^TMP(PXIMMSUB,$J,PXFLD,PXCODESYS,PXI,0))
. . . I PXNODE="" Q
. . . S PXCNT=PXCNT+1
. . . S ^TMP(PXSUB,$J,PXCNT)=PXFLD_U_PXCODESYS_U_PXNODE
;
K ^TMP(PXIMMSUB,$J)
;
Q
;
GETIMM(PXRTRN,PXIMM,PXDATE,PXLOC) ; Entry point for API
;
N PXAUDIT,PXDIV,PXI,PXINST,PXNODE,PXNODE0,PXNODETMP,PXSUB,PXSERIESREQ
;
S PXSUB="PXVIMM"
K ^TMP(PXSUB,$J)
S PXRTRN=$NA(^TMP(PXSUB,$J))
;
I '$G(PXIMM) Q
I '$D(^AUTTIMM(PXIMM,0)) Q
I '$G(PXDATE) S PXDATE=$$NOW^XLFDT()
S PXINST=$$INST^PXVUTIL($G(PXLOC))
;
S PXAUDIT=0
I $$GET1^DID(9999999.14,.07,"","AUDIT")="YES, ALWAYS" S PXAUDIT=1
;
S PXNODE0=^AUTTIMM(PXIMM,0)
S PXNODETMP=PXIMM_U_$P(PXNODE0,U,1)_U_$P(PXNODE0,U,3)
S PXNODETMP=PXNODETMP_U_$$GETSTAT(PXIMM,PXDATE,$$GETCSTAT(PXDATE,PXAUDIT),PXAUDIT)
S PXNODE=$P($G(^AUTTIMM(PXIMM,6)),U,1)
S PXNODETMP=PXNODETMP_U_PXNODE
S PXNODE=$G(^AUTTIMM(PXIMM,88))
S PXNODETMP=PXNODETMP_U_$P(PXNODE,U,1)
S PXNODETMP=PXNODETMP_U_$P(PXNODE,U,2)
S PXNODETMP=PXNODETMP_U_$P(PXNODE0,U,5)_U_$P(PXNODE0,U,20)
S PXNODE=$P($G(^AUTTIMM(PXIMM,.5)),U,1)
S PXNODETMP=PXNODETMP_U_PXNODE
S PXSERIESREQ=0
I $P(PXNODE0,U,5)>0,$$ISMAPTOADMCPT^PXVRPC4A(PXIMM) S PXSERIESREQ=1
S PXNODETMP=PXNODETMP_U_PXSERIESREQ
S ^TMP(PXSUB,$J,0)=PXNODETMP
;
I $D(^AUTTIMM(PXIMM,3)) D GETCS(PXSUB,PXIMM,PXDATE)
I $D(^AUTTIMM(PXIMM,4)) D GETVIS(PXSUB,PXIMM)
F PXI=5,7,10 I $D(^AUTTIMM(PXIMM,PXI)) D GETSUBS(PXSUB,PXIMM,PXI)
D GETLOT(PXSUB,PXIMM,PXDATE,PXINST)
D GETCONT(PXSUB,PXIMM,PXINST) ; Get Contraindications
D GETDEF(PXSUB,PXIMM,PXINST) ; Get Defaults
;
Q
;
GETCS(PXSUB,PXIMM,PXDATE) ;
;
N PXCNT,PXCODE,PXCODESYS,PXCODESYSLEX,PXLEX,PXLEXADATE,PXLEXARY,PXLEXIDATE,PXLEXNODE,PXLEXSUB,PXX,PXY,PXCODELEX
;
S PXDATE=$P(PXDATE,".",1)
S PXCNT=0
;
S PXX=0
F S PXX=$O(^AUTTIMM(PXIMM,3,PXX)) Q:'PXX D
. S PXCODESYS=$G(^AUTTIMM(PXIMM,3,PXX,0))
. I PXCODESYS="" Q
. ;
. ; do this for the CPT admin mappings (e.g., CPTAI1, etc.)
. S PXCODESYSLEX=PXCODESYS
. I $E(PXCODESYSLEX,1,3)="CPT" S PXCODESYSLEX="CPT"
. ;
. S PXY=0 F S PXY=$O(^AUTTIMM(PXIMM,3,PXX,1,PXY)) Q:'PXY D
. . S PXCODE=$G(^AUTTIMM(PXIMM,3,PXX,1,PXY,0))
. . I PXCODE="" Q
. . ;
. . ; do this for the CPT admin mappings (e.g., 91301-0011A)
. . S PXCODELEX=PXCODE
. . I PXCODESYSLEX="CPT",PXCODELEX["-" S PXCODELEX=$P(PXCODELEX,"-",2)
. . ;
. . K PXLEXARY
. . S PXLEX=$$PERIOD^LEXU(PXCODELEX,PXCODESYSLEX,.PXLEXARY)
. . ;
. . I $P(PXLEX,U,1)=-1 D Q
. . . I PXCODESYSLEX?1(1"CPT",1"10D") Q
. . . S PXCNT=PXCNT+1
. . . S ^TMP(PXSUB,$J,"CS",PXCODESYS,PXCNT,0)=PXCODE
. . ;
. . S PXLEXADATE=$O(PXLEXARY((PXDATE+.00001)),-1)
. . I PXLEXADATE="" Q
. . S PXLEXNODE=$G(PXLEXARY(PXLEXADATE))
. . S PXLEXIDATE=$P(PXLEXNODE,U,1)
. . I PXLEXIDATE,PXDATE>PXLEXIDATE Q
. . S PXCNT=PXCNT+1
. . S ^TMP(PXSUB,$J,"CS",PXCODESYS,PXCNT,0)=PXCODE_U_$P(PXLEXNODE,U,3)_U_$P(PXLEXNODE,U,4)
;
Q
;
GETVIS(PXSUB,PXIMM) ;
;
N PXBAR,PXCNT,PXLANG,PXNODE,PXURL,PXVIS,PXX
;
S PXCNT=0
S PXX=0
F S PXX=$O(^AUTTIMM(PXIMM,4,PXX)) Q:'PXX D
. S PXVIS=+$G(^AUTTIMM(PXIMM,4,PXX,0))
. I PXVIS'>0 Q
. I '$D(^AUTTIVIS(PXVIS,0)) Q
. S PXNODE=$G(^AUTTIVIS(PXVIS,0))
. I PXNODE="" Q
. S PXLANG=$P(PXNODE,U,4)
. I PXLANG'="" S PXLANG=$$GET1^DIQ(.85,PXLANG_",","NAME") ;ICR 6062
. S PXBAR=$P($G(^AUTTIVIS(PXVIS,100)),U,1)
. S PXURL=$G(^AUTTIVIS(PXVIS,101))
. S PXCNT=PXCNT+1
. S ^TMP(PXSUB,$J,"VIS",PXCNT,0)=PXVIS_U_$P(PXNODE,U,1,3)_U_PXLANG_U_PXBAR_U_PXURL
Q
;
GETSUBS(PXSUB,PXIMM,PXMULT) ;
;
N PXCNT,PXFLD,PXNODE,PXX
;
S PXFLD=$S(PXMULT=5:"CDC",PXMULT=7:"GROUP",PXMULT=10:"SYNONYM",1:"")
I PXFLD="" Q
S PXCNT=0
S PXX=0 F S PXX=$O(^AUTTIMM(PXIMM,PXMULT,PXX)) Q:'PXX D
. S PXNODE=$G(^AUTTIMM(PXIMM,PXMULT,PXX,0)) Q:PXNODE=""
. S PXCNT=PXCNT+1
. S ^TMP(PXSUB,$J,PXFLD,PXCNT,0)=PXNODE
Q
;
GETLOT(PXSUB,PXIMM,PXDATE,PXINST) ;
;
N PXCNT,PXEXPDATE,PXLOT,PXMAN,PXNDC,PXNODE,PXSTAT,PXTEMP
;
S PXCNT=0
S PXLOT=0
F S PXLOT=$O(^AUTTIML("C",PXIMM,PXLOT)) Q:'PXLOT D
. S PXNODE=$G(^AUTTIML(PXLOT,0))
. I PXNODE="" Q
. S PXEXPDATE=$P(PXNODE,U,9)
. S PXSTAT=$$LOTSTAT^PXVXR(PXLOT,PXDATE)
. I 'PXSTAT Q
. ; check if selectable for this facility
. I $G(PXINST),'$$IMMSEL^PXVXR(PXLOT,PXINST) Q
. S PXMAN=$P(PXNODE,U,2)
. I PXMAN S PXMAN=$P($G(^AUTTIMAN(PXMAN,0)),U,1)
. S PXNDC=$P(PXNODE,U,18)
. S PXCNT=PXCNT+1
. S PXTEMP=PXLOT_U_$P(PXNODE,U,1)_U_PXMAN_U_PXEXPDATE_U_$P(PXNODE,U,12)_U_$P(PXNODE,U,15)_U_PXNDC
. S ^TMP(PXSUB,$J,"LOT",PXCNT,0)=PXTEMP
Q
;
GETCONT(PXSUB,PXIMM,PXINST) ; Get Contraindications
;
N PXCNT,PXI,PXTMP
;
D GETICR^PXVRPC5(.PXTMP,920.4,"I:"_PXIMM,$G(PXINST))
S PXCNT=0
S PXI=0
F S PXI=$O(PXTMP(PXI)) Q:'PXI D
. S PXCNT=PXCNT+1
. S ^TMP(PXSUB,$J,"CONTRA",PXCNT,0)=$G(PXTMP(PXI))
;
Q
;
GETDEF(PXSUB,PXIMM,PXINST) ; Get defaults
;
N PXDFLTS,PXNODE,PXROUTE,PXSITE,PXDOSE,PXUNITS,PXEUNITS,PXNUNITS
;
I '$G(PXINST) S PXINST=$$KSP^XUPARAM("INST")
;
D IMMDEF^PXAPIIM(.PXDFLTS,PXIMM,PXINST)
;I '$D(PXDFLTS) Q
;
S PXNODE=$G(PXDFLTS(13))
S PXROUTE=$P(PXNODE,U,2)
S PXSITE=$P(PXNODE,U,3)
S PXDOSE=$P(PXNODE,U,12)
S PXUNITS=$P(PXNODE,U,13)
S PXNUNITS=$P(PXNODE,U,14)
;
I PXDOSE D
. S PXDOSE=$$EXTERNAL^DILFD(9000010.11,1312,"",PXDOSE)
I PXUNITS D
. S PXEUNITS=$$EXTERNAL^DILFD(9000010.11,1313,"",PXUNITS)
;
S ^TMP(PXSUB,$J,"DEF",1,0)=PXROUTE_U_PXSITE_U_PXDOSE_U_PXUNITS_U_$G(PXEUNITS)_U_PXNUNITS
;
S PXNODE=$G(PXDFLTS(811))
I PXNODE'="" S ^TMP(PXSUB,$J,"DEFC",1,0)=PXNODE
;
Q
;
GETUNITS(PXIMM,PXLOC) ;
N PXRSLT,PXSUB,PXINST
I '$G(PXIMM) Q ""
S PXINST=$$INST^PXVUTIL("L:"_+$G(PXLOC))
S PXSUB="PXVRPC4UNITS"
K ^TMP(PXSUB,$J)
D GETDEF(PXSUB,PXIMM,$G(PXINST))
S PXRSLT=$P($G(^TMP(PXSUB,$J,"DEF",1,0)),U,4,5)
I $P(PXRSLT,U,2)="" S $P(PXRSLT,U,2)=$P($G(^TMP(PXSUB,$J,"DEF",1,0)),U,6)
K ^TMP(PXSUB,$J)
Q PXRSLT
;
IMMSHORT(PXRSLT,PXFILTER,PXDATE,PXOREXC,PXLOC) ;
;
; Return short list of immunizations
;
;Input:
; PXRSLT - Return value passed by reference (Required)
; PXFILTER - Filter (Optional; Defaults to "B")
; Possible values are:
; "A": Only return active entries
; "H": Only return entries marked as Selectable for Historic
; "B": Return both active entries and those marked as Selectable for Historic
; PXDATE - Date (optional; defaults to NOW)
; Used for determining immunization status (both for filtering and for return value)
; and lot status.
; PXOREXC - Should entries defined in ORWPCE EXCLUDE IMMUNIZATIONS be excluded? (optional)
; PXLOC - Used when excluding entries listed in ORWPCE EXCLUDE IMMUNIZATIONS. (Optional)
; This is the location used when getting the parameter value at the Location level.
; Also used to get division when checking if there is a linked lot.
;
;Returns:
; PXRTRN(x)
; Note: Status (in the 5th piece) is determined as follows:
; - If PXDATE is today, the status is based off the Inactive Flag (#.07)
; - If PXDATE is different than today, we will look when an update was
; last made to the Immunization file (based off the Audits).
; If there have not been any changes since PXDATE, we will get the
; status based off the Inactive Flag, otherwise, we will get the
; status for that date by calling GETSTAT^XTID.
; 1: "IMM"
; 2: #9999999.14 IEN
; 3: Name (#.01)
; 4: CVX Code (#.03)
; 5: Status (1: Active; 0: Inactive)
; 6: Selectable for Historic (#8803)
; 7: Mnemonic (#8801)
; 8: Acronym (#8802)
; 9: Active Lot linked to this Immunization? (1:Yes; 0:No)
; PXRTRN(x)
; 1: "CDC"
; 2: CDC Product Name (#9999999.145, #.01)
; PXRTRN(x)
; 1: "GROUP"
; 2: Vaccine Group Name (#9999999.147, #.01)
;
N PXAUDIT,PXCNT,PXGETCSTAT,PXIEN,PXINST,PXLOT,PXLST,PXNODE,PXNODE88,PXSELHIST,PXSTAT,PXX
;
I $G(PXFILTER)'?1(1"A",1"H",1"B") S PXFILTER="B"
I '$G(PXDATE) S PXDATE=$$NOW^XLFDT()
S PXINST=$$INST^PXVUTIL("L:"_+$G(PXLOC))
S PXAUDIT=0
I $$GET1^DID(9999999.14,.07,"","AUDIT")="YES, ALWAYS" S PXAUDIT=1
S PXGETCSTAT=$$GETCSTAT(PXDATE,PXAUDIT)
;
S PXCNT=0
S PXIEN=0
F S PXIEN=$O(^AUTTIMM(PXIEN)) Q:PXIEN'>0 D
. I $G(PXOREXC),$$EXCLUDED(.PXLST,PXIEN,1,$G(PXLOC)) Q
. S PXSELHIST=$P($G(^AUTTIMM(PXIEN,6)),U)
. S PXSTAT=$$GETSTAT(PXIEN,PXDATE,PXGETCSTAT,PXAUDIT)
. I PXFILTER="A",'PXSTAT Q
. I PXFILTER="H",PXSELHIST'="Y" Q
. I PXFILTER="B",'PXSTAT,PXSELHIST'="Y" Q
. ;
. S PXCNT=PXCNT+1
. S PXNODE=$G(^AUTTIMM(PXIEN,0))
. S PXNODE88=$G(^AUTTIMM(PXIEN,88))
. ;
. S PXLOT=""
. I PXSTAT D
. . K ^TMP("PXVLOT",$J)
. . D GETLOT("PXVLOT",PXIEN,PXDATE,PXINST)
. . S PXLOT=0
. . I $O(^TMP("PXVLOT",$J,"LOT",0)) S PXLOT=1
. . K ^TMP("PXVLOT",$J)
. ;
. S PXRSLT(PXCNT)="IMM"_U_PXIEN_U_$P(PXNODE,U,1)_U_$P(PXNODE,U,3)_U_PXSTAT_U_PXSELHIST_U_$P(PXNODE88,U,1)_U_$P(PXNODE88,U,2)_U_PXLOT
. ;
. S PXX=0
. F S PXX=$O(^AUTTIMM(PXIEN,5,PXX)) Q:PXX'>0 D
. . S PXNODE=$G(^AUTTIMM(PXIEN,5,PXX,0))
. . I PXNODE="" Q
. . S PXCNT=PXCNT+1
. . S PXRSLT(PXCNT)="CDC"_U_PXNODE
. ;
. S PXX=0
. F S PXX=$O(^AUTTIMM(PXIEN,7,PXX)) Q:PXX'>0 D
. . S PXNODE=$P($G(^AUTTIMM(PXIEN,7,PXX,0)),U,1)
. . I PXNODE="" Q
. . S PXCNT=PXCNT+1
. . S PXRSLT(PXCNT)="GROUP"_U_PXNODE
Q
;
GETSTAT(PXIMM,PXDATE,PXCURR,PXAUDIT) ;
;
N PXLASTEDIT
;
I PXCURR Q '$P($G(^AUTTIMM(PXIMM,0)),U,7)
;
I PXAUDIT D
. S PXLASTEDIT=$P($$LAST^DIAUTL(9999999.14,PXIMM,".07"),U,1)
. I PXDATE>PXLASTEDIT S PXCURR=1
I PXCURR Q '$P($G(^AUTTIMM(PXIMM,0)),U,7)
;
Q $P($$GETSTAT^XTID(9999999.14,"",PXIMM_",",$G(PXDATE)),U,1)
;
GETCSTAT(PXDATE,PXAUDIT) ;
;
; Should we get current status of IMM entries or should we call GETSTAT^XTID
; to get status as of a specific date?
; Since GETSTAT^XTID is slow, we try to avoid it when possible.
;
; Returns: 0 - Call GETSTAT^XTID
; 1 - Get current status
;
N PXLASTEDITDT,PXRSLT
;
S PXRSLT=0
;
I '$G(PXDATE) D Q PXRSLT
. S PXRSLT=1
;
I $P(PXDATE,".",1)=DT D Q PXRSLT
. S PXRSLT=1
;
; If Inactive Flag is being audited (which should be the case)
; then get current status, if file has not been updated since PXDATE
I PXAUDIT D
. S PXLASTEDITDT=$O(^DIA(9999999.14,"C",""),-1) ;ICR #2602
. I PXDATE>PXLASTEDITDT S PXRSLT=1
;
Q PXRSLT
;
;
IMMADMCODES(PXRSLT,PXVISIT,PXPCELIST,PXRETCPTDEL) ;
;
; Returns Immunization Admin CPT codes
;
;Input:
; PXRSLT - Return value passed by reference (Required)
; PXVISIT - Visit IEN (Optional)
; PXPCELIST - PCE Array in format passed to PX SAVE DATA rpc (Required)
; PXRETCPTDEL - Should API return other mapped CPT codes (i.e., not admin) to delete (Optional)
;
;Returns:
; PXRSLT(n) = array of CPT codes to add/delete from Visit in format passed to PX SAVE DATA rpc
;
D IMMADMCODES^PXVRPC4A(.PXRSLT,.PXVISIT,.PXPCELIST,$G(PXRETCPTDEL))
Q
;
; Check if PXIEN should be excluded based off ORWPCE EXCLUDE XXX parameter
EXCLUDED(PXLST,PXIEN,PXTYPE,PXLOC) ;
;
N PXI,PXTMP,PXX
;
I '$D(PXLST) D
. D EXCLUDED^ORWPCE2(.PXTMP,$G(PXLOC),PXTYPE)
. S PXI=0
. F S PXI=$O(PXTMP(PXI)) Q:'PXI D
. . S PXX=$P($G(PXTMP(PXI)),U,2)
. . I PXX S PXLST(PXX)=""
;
I $D(PXLST(PXIEN)) Q 1
;
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVRPC4 17033 printed Dec 13, 2024@02:32:01 Page 2
PXVRPC4 ;BPFO/LMT - PCE RPCs for Immunization(s) ;Jan 18, 2023@15:08:57
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215,216,217,233**;Aug 12, 1996;Build 3
+2 ;
+3 ; Reference to ^DIA(9999999.14,"C") in ICR #2602
+4 ; Reference to NAME in file .85 in ICR #6062
+5 ; Reference to EXCLUDED^ORWPCE2 in ICR #7399
+6 ;
IMMRPC(PXRTRN,PXIMM,PXDATE,PXLOC) ; Entry point for RPC
+1 ;
+2 ; Returns an Immunization object
+3 ;
+4 ;Input:
+5 ; PXRTRN - Return value passed by reference (Required)
+6 ; PXIMM - Pointer to #9999999.14 (Required)
+7 ; PXDATE - Immunization status and Codes will be based off this date
+8 ; (Optional; Defaults to NOW)
+9 ; PXLOC - Used to determine Institution (used when filtering Lot and Defaults) (Optional)
+10 ; Possible values are:
+11 ; "I:X": Institution (#4) IEN #X
+12 ; "V:X": Visit (#9000010) IEN #X
+13 ; "L:X": Hospital Location (#44) IEN #X
+14 ; If PXLOC is not passed in OR could not make determination based off
+15 ; input, then default to DUZ(2), and if DUZ(2) is not defined,
+16 ; default to Default Institution.
+17 ;
+18 ;Returns:
+19 ; ^TMP("PXVIMMRPC",$J,0)
+20 ; 1: 1 - Immunization was found. The "1" node will be returned, but
+21 ; the other nodes are optional.
+22 ; -1 - Immunization was not found; no other nodes will be returned
+23 ; ^TMP("PXVIMMRPC",$J,1)
+24 ; Note: Status (in the 5th piece) is determined as follows:
+25 ; - If PXDATE is today, the status is based off the Inactive Flag (#.07)
+26 ; - If PXDATE is different than today, we will look when an update was
+27 ; last made to the Immunization file (based off the Audits).
+28 ; If there have not been any changes since PXDATE, we will get the
+29 ; status based off the Inactive Flag, otherwise, we will get the
+30 ; status for that date by calling GETSTAT^XTID.
+31 ; 1: "IMM"
+32 ; 2: #9999999.14 IEN
+33 ; 3: Name (#.01)
+34 ; 4: CVX Code (#.03)
+35 ; 5: Status (1: Active; 0: Inactive)
+36 ; 6: Selectable for Historic (#8803)
+37 ; 7: Mnemonic (#8801)
+38 ; 8: Acronym (#8802)
+39 ; 9: Max # In Series (#.05)
+40 ; 10: Combination Immunization (Y/N) (#.2)
+41 ; 11: Reading Required (#.51)
+42 ; 12: Series Required (calculated)
+43 ; ^TMP("PXVIMMRPC",$J,x)
+44 ; 1: "VIS"
+45 ; 2: #920 IEN
+46 ; 3: Name (#920,#.01)
+47 ; 4: Edition Date (#920,#.02)
+48 ; 5: Edition Status (#920,#.03)
+49 ; 6: Language (#920, #.04)
+50 ; 7: 2D Bar Code (#100)
+51 ; 8: VIS URL (#101)
+52 ; ^TMP("PXVIMMRPC",$J,x)
+53 ; 1: "CDC"
+54 ; 2: CDC Product Name (#9999999.145, #.01)
+55 ; ^TMP("PXVIMMRPC",$J,x)
+56 ; 1: "GROUP"
+57 ; 2: Vaccine Group Name (#9999999.147, #.01)
+58 ; ^TMP("PXVIMMRPC",$J,x)
+59 ; 1: "SYNONYM"
+60 ; 2: Synonym (#9999999.141, #.01)
+61 ; ^TMP("PXVIMMRPC",$J,x)
+62 ; Note: Only active codes (based off PXDATE) are returned.
+63 ; 1: "CS"
+64 ; 2: Coding System (#9999999.143, #.01)
+65 ; 3: Code (#9999999.1431,#.01)
+66 ; 4: Variable pointer. e.g., IEN;ICPT(
+67 ; 5: Short Description
+68 ; ^TMP("PXVIMMRPC",$J,x)
+69 ; Note: Only active lots for the given division are returned.
+70 ; Also, the Expiration date must be >= PXDATE
+71 ; 1: "LOT"
+72 ; 2: #9999999.41 IEN
+73 ; 3: Lot Number (#9999999.41, #.01)
+74 ; 4: Manufacturer (#9999999.04, #.01)
+75 ; 5: Expiration Date (#9999999.41, #.09)
+76 ; 6: Doses Unused (#9999999.41, #.12)
+77 ; 7: Low Supply Alert (#9999999.41, #.15)
+78 ; 8: NDC Code (#9999999.41, #.18)
+79 ; ^TMP("PXVIMMRPC",$J,x)
+80 ; Note: Only active contraindications are returned
+81 ; 1: "CONTRA"
+82 ; 2: #920.4 variable pointer: IEN;PXV(920.4,
+83 ; 3: Name (#920.4, #.01)
+84 ; 4: Status (1:Active, 0:Inactive)
+85 ; 5: Code|Coding System (#920.4, #.02 and .05)
+86 ; 6: NIP004 (#920.4, #.04)
+87 ; 7: Contraindication/Precaution (#920.4, #.06)
+88 ; 8: Allergy-Related (1:Yes, 0:No)
+89 ; 9: Default Warn Until Date ("Forever" means it should be forever)
+90 ; ^TMP("PXVIMMRPC",$J,x)
+91 ; 1: "DEF"
+92 ; 2: Default Route (#920.051, #1302)
+93 ; 3: Default Site (#920.051, #1303)
+94 ; 4: Default Dose (#920.051, #1312)
+95 ; 5: Default Dose Units (#920.051, #1313)
+96 ; 6: Default Dose Units (external format) (#920.051, #1313)
+97 ; 7: Default Non-Standard Dose Units (#920.051, #1314)
+98 ; ^TMP("PXVIMMRPC",$J,x)
+99 ; 1: "DEFC"
+100 ; 2: Default Comments (#920.051, #81101)
+101 ;
+102 NEW PXCNT,PXCODESYS,PXFLD,PXI,PXIMMARR,PXIMMSUB,PXNODE,PXSUB
+103 ;
+104 SET PXSUB="PXVIMMRPC"
+105 SET PXRTRN=$NAME(^TMP(PXSUB,$JOB))
+106 KILL ^TMP(PXSUB,$JOB)
+107 ;
+108 DO GETIMM(.PXIMMARR,$GET(PXIMM),$GET(PXDATE),$GET(PXLOC))
+109 SET PXIMMSUB="PXVIMM"
+110 ;
+111 SET PXCNT=0
+112 ;
+113 IF '$DATA(^TMP(PXIMMSUB,$JOB))
Begin DoDot:1
+114 SET ^TMP(PXSUB,$JOB,PXCNT)="-1"
End DoDot:1
QUIT
+115 ;
+116 SET ^TMP(PXSUB,$JOB,PXCNT)=1
+117 SET PXCNT=PXCNT+1
+118 SET ^TMP(PXSUB,$JOB,PXCNT)="IMM"_U_$GET(^TMP(PXIMMSUB,$JOB,0))
+119 ;
+120 FOR PXFLD="VIS","LOT","CDC","GROUP","SYNONYM","CONTRA","DEF","DEFC"
Begin DoDot:1
+121 IF '$DATA(^TMP(PXIMMSUB,$JOB,PXFLD))
QUIT
+122 SET PXI=0
FOR
SET PXI=$ORDER(^TMP(PXIMMSUB,$JOB,PXFLD,PXI))
if 'PXI
QUIT
Begin DoDot:2
+123 SET PXNODE=$GET(^TMP(PXIMMSUB,$JOB,PXFLD,PXI,0))
+124 IF PXNODE=""
QUIT
+125 SET PXCNT=PXCNT+1
+126 SET ^TMP(PXSUB,$JOB,PXCNT)=PXFLD_U_PXNODE
End DoDot:2
End DoDot:1
+127 ;
+128 SET PXFLD="CS"
+129 IF $DATA(^TMP(PXIMMSUB,$JOB,PXFLD))
Begin DoDot:1
+130 SET PXCODESYS=""
+131 FOR
SET PXCODESYS=$ORDER(^TMP(PXIMMSUB,$JOB,PXFLD,PXCODESYS))
if PXCODESYS=""
QUIT
Begin DoDot:2
+132 SET PXI=0
+133 FOR
SET PXI=$ORDER(^TMP(PXIMMSUB,$JOB,PXFLD,PXCODESYS,PXI))
if 'PXI
QUIT
Begin DoDot:3
+134 SET PXNODE=$GET(^TMP(PXIMMSUB,$JOB,PXFLD,PXCODESYS,PXI,0))
+135 IF PXNODE=""
QUIT
+136 SET PXCNT=PXCNT+1
+137 SET ^TMP(PXSUB,$JOB,PXCNT)=PXFLD_U_PXCODESYS_U_PXNODE
End DoDot:3
End DoDot:2
End DoDot:1
+138 ;
+139 KILL ^TMP(PXIMMSUB,$JOB)
+140 ;
+141 QUIT
+142 ;
GETIMM(PXRTRN,PXIMM,PXDATE,PXLOC) ; Entry point for API
+1 ;
+2 NEW PXAUDIT,PXDIV,PXI,PXINST,PXNODE,PXNODE0,PXNODETMP,PXSUB,PXSERIESREQ
+3 ;
+4 SET PXSUB="PXVIMM"
+5 KILL ^TMP(PXSUB,$JOB)
+6 SET PXRTRN=$NAME(^TMP(PXSUB,$JOB))
+7 ;
+8 IF '$GET(PXIMM)
QUIT
+9 IF '$DATA(^AUTTIMM(PXIMM,0))
QUIT
+10 IF '$GET(PXDATE)
SET PXDATE=$$NOW^XLFDT()
+11 SET PXINST=$$INST^PXVUTIL($GET(PXLOC))
+12 ;
+13 SET PXAUDIT=0
+14 IF $$GET1^DID(9999999.14,.07,"","AUDIT")="YES, ALWAYS"
SET PXAUDIT=1
+15 ;
+16 SET PXNODE0=^AUTTIMM(PXIMM,0)
+17 SET PXNODETMP=PXIMM_U_$PIECE(PXNODE0,U,1)_U_$PIECE(PXNODE0,U,3)
+18 SET PXNODETMP=PXNODETMP_U_$$GETSTAT(PXIMM,PXDATE,$$GETCSTAT(PXDATE,PXAUDIT),PXAUDIT)
+19 SET PXNODE=$PIECE($GET(^AUTTIMM(PXIMM,6)),U,1)
+20 SET PXNODETMP=PXNODETMP_U_PXNODE
+21 SET PXNODE=$GET(^AUTTIMM(PXIMM,88))
+22 SET PXNODETMP=PXNODETMP_U_$PIECE(PXNODE,U,1)
+23 SET PXNODETMP=PXNODETMP_U_$PIECE(PXNODE,U,2)
+24 SET PXNODETMP=PXNODETMP_U_$PIECE(PXNODE0,U,5)_U_$PIECE(PXNODE0,U,20)
+25 SET PXNODE=$PIECE($GET(^AUTTIMM(PXIMM,.5)),U,1)
+26 SET PXNODETMP=PXNODETMP_U_PXNODE
+27 SET PXSERIESREQ=0
+28 IF $PIECE(PXNODE0,U,5)>0
IF $$ISMAPTOADMCPT^PXVRPC4A(PXIMM)
SET PXSERIESREQ=1
+29 SET PXNODETMP=PXNODETMP_U_PXSERIESREQ
+30 SET ^TMP(PXSUB,$JOB,0)=PXNODETMP
+31 ;
+32 IF $DATA(^AUTTIMM(PXIMM,3))
DO GETCS(PXSUB,PXIMM,PXDATE)
+33 IF $DATA(^AUTTIMM(PXIMM,4))
DO GETVIS(PXSUB,PXIMM)
+34 FOR PXI=5,7,10
IF $DATA(^AUTTIMM(PXIMM,PXI))
DO GETSUBS(PXSUB,PXIMM,PXI)
+35 DO GETLOT(PXSUB,PXIMM,PXDATE,PXINST)
+36 ; Get Contraindications
DO GETCONT(PXSUB,PXIMM,PXINST)
+37 ; Get Defaults
DO GETDEF(PXSUB,PXIMM,PXINST)
+38 ;
+39 QUIT
+40 ;
GETCS(PXSUB,PXIMM,PXDATE) ;
+1 ;
+2 NEW PXCNT,PXCODE,PXCODESYS,PXCODESYSLEX,PXLEX,PXLEXADATE,PXLEXARY,PXLEXIDATE,PXLEXNODE,PXLEXSUB,PXX,PXY,PXCODELEX
+3 ;
+4 SET PXDATE=$PIECE(PXDATE,".",1)
+5 SET PXCNT=0
+6 ;
+7 SET PXX=0
+8 FOR
SET PXX=$ORDER(^AUTTIMM(PXIMM,3,PXX))
if 'PXX
QUIT
Begin DoDot:1
+9 SET PXCODESYS=$GET(^AUTTIMM(PXIMM,3,PXX,0))
+10 IF PXCODESYS=""
QUIT
+11 ;
+12 ; do this for the CPT admin mappings (e.g., CPTAI1, etc.)
+13 SET PXCODESYSLEX=PXCODESYS
+14 IF $EXTRACT(PXCODESYSLEX,1,3)="CPT"
SET PXCODESYSLEX="CPT"
+15 ;
+16 SET PXY=0
FOR
SET PXY=$ORDER(^AUTTIMM(PXIMM,3,PXX,1,PXY))
if 'PXY
QUIT
Begin DoDot:2
+17 SET PXCODE=$GET(^AUTTIMM(PXIMM,3,PXX,1,PXY,0))
+18 IF PXCODE=""
QUIT
+19 ;
+20 ; do this for the CPT admin mappings (e.g., 91301-0011A)
+21 SET PXCODELEX=PXCODE
+22 IF PXCODESYSLEX="CPT"
IF PXCODELEX["-"
SET PXCODELEX=$PIECE(PXCODELEX,"-",2)
+23 ;
+24 KILL PXLEXARY
+25 SET PXLEX=$$PERIOD^LEXU(PXCODELEX,PXCODESYSLEX,.PXLEXARY)
+26 ;
+27 IF $PIECE(PXLEX,U,1)=-1
Begin DoDot:3
+28 IF PXCODESYSLEX?1(1"CPT",1"10D")
QUIT
+29 SET PXCNT=PXCNT+1
+30 SET ^TMP(PXSUB,$JOB,"CS",PXCODESYS,PXCNT,0)=PXCODE
End DoDot:3
QUIT
+31 ;
+32 SET PXLEXADATE=$ORDER(PXLEXARY((PXDATE+.00001)),-1)
+33 IF PXLEXADATE=""
QUIT
+34 SET PXLEXNODE=$GET(PXLEXARY(PXLEXADATE))
+35 SET PXLEXIDATE=$PIECE(PXLEXNODE,U,1)
+36 IF PXLEXIDATE
IF PXDATE>PXLEXIDATE
QUIT
+37 SET PXCNT=PXCNT+1
+38 SET ^TMP(PXSUB,$JOB,"CS",PXCODESYS,PXCNT,0)=PXCODE_U_$PIECE(PXLEXNODE,U,3)_U_$PIECE(PXLEXNODE,U,4)
End DoDot:2
End DoDot:1
+39 ;
+40 QUIT
+41 ;
GETVIS(PXSUB,PXIMM) ;
+1 ;
+2 NEW PXBAR,PXCNT,PXLANG,PXNODE,PXURL,PXVIS,PXX
+3 ;
+4 SET PXCNT=0
+5 SET PXX=0
+6 FOR
SET PXX=$ORDER(^AUTTIMM(PXIMM,4,PXX))
if 'PXX
QUIT
Begin DoDot:1
+7 SET PXVIS=+$GET(^AUTTIMM(PXIMM,4,PXX,0))
+8 IF PXVIS'>0
QUIT
+9 IF '$DATA(^AUTTIVIS(PXVIS,0))
QUIT
+10 SET PXNODE=$GET(^AUTTIVIS(PXVIS,0))
+11 IF PXNODE=""
QUIT
+12 SET PXLANG=$PIECE(PXNODE,U,4)
+13 ;ICR 6062
IF PXLANG'=""
SET PXLANG=$$GET1^DIQ(.85,PXLANG_",","NAME")
+14 SET PXBAR=$PIECE($GET(^AUTTIVIS(PXVIS,100)),U,1)
+15 SET PXURL=$GET(^AUTTIVIS(PXVIS,101))
+16 SET PXCNT=PXCNT+1
+17 SET ^TMP(PXSUB,$JOB,"VIS",PXCNT,0)=PXVIS_U_$PIECE(PXNODE,U,1,3)_U_PXLANG_U_PXBAR_U_PXURL
End DoDot:1
+18 QUIT
+19 ;
GETSUBS(PXSUB,PXIMM,PXMULT) ;
+1 ;
+2 NEW PXCNT,PXFLD,PXNODE,PXX
+3 ;
+4 SET PXFLD=$SELECT(PXMULT=5:"CDC",PXMULT=7:"GROUP",PXMULT=10:"SYNONYM",1:"")
+5 IF PXFLD=""
QUIT
+6 SET PXCNT=0
+7 SET PXX=0
FOR
SET PXX=$ORDER(^AUTTIMM(PXIMM,PXMULT,PXX))
if 'PXX
QUIT
Begin DoDot:1
+8 SET PXNODE=$GET(^AUTTIMM(PXIMM,PXMULT,PXX,0))
if PXNODE=""
QUIT
+9 SET PXCNT=PXCNT+1
+10 SET ^TMP(PXSUB,$JOB,PXFLD,PXCNT,0)=PXNODE
End DoDot:1
+11 QUIT
+12 ;
GETLOT(PXSUB,PXIMM,PXDATE,PXINST) ;
+1 ;
+2 NEW PXCNT,PXEXPDATE,PXLOT,PXMAN,PXNDC,PXNODE,PXSTAT,PXTEMP
+3 ;
+4 SET PXCNT=0
+5 SET PXLOT=0
+6 FOR
SET PXLOT=$ORDER(^AUTTIML("C",PXIMM,PXLOT))
if 'PXLOT
QUIT
Begin DoDot:1
+7 SET PXNODE=$GET(^AUTTIML(PXLOT,0))
+8 IF PXNODE=""
QUIT
+9 SET PXEXPDATE=$PIECE(PXNODE,U,9)
+10 SET PXSTAT=$$LOTSTAT^PXVXR(PXLOT,PXDATE)
+11 IF 'PXSTAT
QUIT
+12 ; check if selectable for this facility
+13 IF $GET(PXINST)
IF '$$IMMSEL^PXVXR(PXLOT,PXINST)
QUIT
+14 SET PXMAN=$PIECE(PXNODE,U,2)
+15 IF PXMAN
SET PXMAN=$PIECE($GET(^AUTTIMAN(PXMAN,0)),U,1)
+16 SET PXNDC=$PIECE(PXNODE,U,18)
+17 SET PXCNT=PXCNT+1
+18 SET PXTEMP=PXLOT_U_$PIECE(PXNODE,U,1)_U_PXMAN_U_PXEXPDATE_U_$PIECE(PXNODE,U,12)_U_$PIECE(PXNODE,U,15)_U_PXNDC
+19 SET ^TMP(PXSUB,$JOB,"LOT",PXCNT,0)=PXTEMP
End DoDot:1
+20 QUIT
+21 ;
GETCONT(PXSUB,PXIMM,PXINST) ; Get Contraindications
+1 ;
+2 NEW PXCNT,PXI,PXTMP
+3 ;
+4 DO GETICR^PXVRPC5(.PXTMP,920.4,"I:"_PXIMM,$GET(PXINST))
+5 SET PXCNT=0
+6 SET PXI=0
+7 FOR
SET PXI=$ORDER(PXTMP(PXI))
if 'PXI
QUIT
Begin DoDot:1
+8 SET PXCNT=PXCNT+1
+9 SET ^TMP(PXSUB,$JOB,"CONTRA",PXCNT,0)=$GET(PXTMP(PXI))
End DoDot:1
+10 ;
+11 QUIT
+12 ;
GETDEF(PXSUB,PXIMM,PXINST) ; Get defaults
+1 ;
+2 NEW PXDFLTS,PXNODE,PXROUTE,PXSITE,PXDOSE,PXUNITS,PXEUNITS,PXNUNITS
+3 ;
+4 IF '$GET(PXINST)
SET PXINST=$$KSP^XUPARAM("INST")
+5 ;
+6 DO IMMDEF^PXAPIIM(.PXDFLTS,PXIMM,PXINST)
+7 ;I '$D(PXDFLTS) Q
+8 ;
+9 SET PXNODE=$GET(PXDFLTS(13))
+10 SET PXROUTE=$PIECE(PXNODE,U,2)
+11 SET PXSITE=$PIECE(PXNODE,U,3)
+12 SET PXDOSE=$PIECE(PXNODE,U,12)
+13 SET PXUNITS=$PIECE(PXNODE,U,13)
+14 SET PXNUNITS=$PIECE(PXNODE,U,14)
+15 ;
+16 IF PXDOSE
Begin DoDot:1
+17 SET PXDOSE=$$EXTERNAL^DILFD(9000010.11,1312,"",PXDOSE)
End DoDot:1
+18 IF PXUNITS
Begin DoDot:1
+19 SET PXEUNITS=$$EXTERNAL^DILFD(9000010.11,1313,"",PXUNITS)
End DoDot:1
+20 ;
+21 SET ^TMP(PXSUB,$JOB,"DEF",1,0)=PXROUTE_U_PXSITE_U_PXDOSE_U_PXUNITS_U_$GET(PXEUNITS)_U_PXNUNITS
+22 ;
+23 SET PXNODE=$GET(PXDFLTS(811))
+24 IF PXNODE'=""
SET ^TMP(PXSUB,$JOB,"DEFC",1,0)=PXNODE
+25 ;
+26 QUIT
+27 ;
GETUNITS(PXIMM,PXLOC) ;
+1 NEW PXRSLT,PXSUB,PXINST
+2 IF '$GET(PXIMM)
QUIT ""
+3 SET PXINST=$$INST^PXVUTIL("L:"_+$GET(PXLOC))
+4 SET PXSUB="PXVRPC4UNITS"
+5 KILL ^TMP(PXSUB,$JOB)
+6 DO GETDEF(PXSUB,PXIMM,$GET(PXINST))
+7 SET PXRSLT=$PIECE($GET(^TMP(PXSUB,$JOB,"DEF",1,0)),U,4,5)
+8 IF $PIECE(PXRSLT,U,2)=""
SET $PIECE(PXRSLT,U,2)=$PIECE($GET(^TMP(PXSUB,$JOB,"DEF",1,0)),U,6)
+9 KILL ^TMP(PXSUB,$JOB)
+10 QUIT PXRSLT
+11 ;
IMMSHORT(PXRSLT,PXFILTER,PXDATE,PXOREXC,PXLOC) ;
+1 ;
+2 ; Return short list of immunizations
+3 ;
+4 ;Input:
+5 ; PXRSLT - Return value passed by reference (Required)
+6 ; PXFILTER - Filter (Optional; Defaults to "B")
+7 ; Possible values are:
+8 ; "A": Only return active entries
+9 ; "H": Only return entries marked as Selectable for Historic
+10 ; "B": Return both active entries and those marked as Selectable for Historic
+11 ; PXDATE - Date (optional; defaults to NOW)
+12 ; Used for determining immunization status (both for filtering and for return value)
+13 ; and lot status.
+14 ; PXOREXC - Should entries defined in ORWPCE EXCLUDE IMMUNIZATIONS be excluded? (optional)
+15 ; PXLOC - Used when excluding entries listed in ORWPCE EXCLUDE IMMUNIZATIONS. (Optional)
+16 ; This is the location used when getting the parameter value at the Location level.
+17 ; Also used to get division when checking if there is a linked lot.
+18 ;
+19 ;Returns:
+20 ; PXRTRN(x)
+21 ; Note: Status (in the 5th piece) is determined as follows:
+22 ; - If PXDATE is today, the status is based off the Inactive Flag (#.07)
+23 ; - If PXDATE is different than today, we will look when an update was
+24 ; last made to the Immunization file (based off the Audits).
+25 ; If there have not been any changes since PXDATE, we will get the
+26 ; status based off the Inactive Flag, otherwise, we will get the
+27 ; status for that date by calling GETSTAT^XTID.
+28 ; 1: "IMM"
+29 ; 2: #9999999.14 IEN
+30 ; 3: Name (#.01)
+31 ; 4: CVX Code (#.03)
+32 ; 5: Status (1: Active; 0: Inactive)
+33 ; 6: Selectable for Historic (#8803)
+34 ; 7: Mnemonic (#8801)
+35 ; 8: Acronym (#8802)
+36 ; 9: Active Lot linked to this Immunization? (1:Yes; 0:No)
+37 ; PXRTRN(x)
+38 ; 1: "CDC"
+39 ; 2: CDC Product Name (#9999999.145, #.01)
+40 ; PXRTRN(x)
+41 ; 1: "GROUP"
+42 ; 2: Vaccine Group Name (#9999999.147, #.01)
+43 ;
+44 NEW PXAUDIT,PXCNT,PXGETCSTAT,PXIEN,PXINST,PXLOT,PXLST,PXNODE,PXNODE88,PXSELHIST,PXSTAT,PXX
+45 ;
+46 IF $GET(PXFILTER)'?1(1"A",1"H",1"B")
SET PXFILTER="B"
+47 IF '$GET(PXDATE)
SET PXDATE=$$NOW^XLFDT()
+48 SET PXINST=$$INST^PXVUTIL("L:"_+$GET(PXLOC))
+49 SET PXAUDIT=0
+50 IF $$GET1^DID(9999999.14,.07,"","AUDIT")="YES, ALWAYS"
SET PXAUDIT=1
+51 SET PXGETCSTAT=$$GETCSTAT(PXDATE,PXAUDIT)
+52 ;
+53 SET PXCNT=0
+54 SET PXIEN=0
+55 FOR
SET PXIEN=$ORDER(^AUTTIMM(PXIEN))
if PXIEN'>0
QUIT
Begin DoDot:1
+56 IF $GET(PXOREXC)
IF $$EXCLUDED(.PXLST,PXIEN,1,$GET(PXLOC))
QUIT
+57 SET PXSELHIST=$PIECE($GET(^AUTTIMM(PXIEN,6)),U)
+58 SET PXSTAT=$$GETSTAT(PXIEN,PXDATE,PXGETCSTAT,PXAUDIT)
+59 IF PXFILTER="A"
IF 'PXSTAT
QUIT
+60 IF PXFILTER="H"
IF PXSELHIST'="Y"
QUIT
+61 IF PXFILTER="B"
IF 'PXSTAT
IF PXSELHIST'="Y"
QUIT
+62 ;
+63 SET PXCNT=PXCNT+1
+64 SET PXNODE=$GET(^AUTTIMM(PXIEN,0))
+65 SET PXNODE88=$GET(^AUTTIMM(PXIEN,88))
+66 ;
+67 SET PXLOT=""
+68 IF PXSTAT
Begin DoDot:2
+69 KILL ^TMP("PXVLOT",$JOB)
+70 DO GETLOT("PXVLOT",PXIEN,PXDATE,PXINST)
+71 SET PXLOT=0
+72 IF $ORDER(^TMP("PXVLOT",$JOB,"LOT",0))
SET PXLOT=1
+73 KILL ^TMP("PXVLOT",$JOB)
End DoDot:2
+74 ;
+75 SET PXRSLT(PXCNT)="IMM"_U_PXIEN_U_$PIECE(PXNODE,U,1)_U_$PIECE(PXNODE,U,3)_U_PXSTAT_U_PXSELHIST_U_$PIECE(PXNODE88,U,1)_U_$PIECE(PXNODE88,U,2)_U_PXLOT
+76 ;
+77 SET PXX=0
+78 FOR
SET PXX=$ORDER(^AUTTIMM(PXIEN,5,PXX))
if PXX'>0
QUIT
Begin DoDot:2
+79 SET PXNODE=$GET(^AUTTIMM(PXIEN,5,PXX,0))
+80 IF PXNODE=""
QUIT
+81 SET PXCNT=PXCNT+1
+82 SET PXRSLT(PXCNT)="CDC"_U_PXNODE
End DoDot:2
+83 ;
+84 SET PXX=0
+85 FOR
SET PXX=$ORDER(^AUTTIMM(PXIEN,7,PXX))
if PXX'>0
QUIT
Begin DoDot:2
+86 SET PXNODE=$PIECE($GET(^AUTTIMM(PXIEN,7,PXX,0)),U,1)
+87 IF PXNODE=""
QUIT
+88 SET PXCNT=PXCNT+1
+89 SET PXRSLT(PXCNT)="GROUP"_U_PXNODE
End DoDot:2
End DoDot:1
+90 QUIT
+91 ;
GETSTAT(PXIMM,PXDATE,PXCURR,PXAUDIT) ;
+1 ;
+2 NEW PXLASTEDIT
+3 ;
+4 IF PXCURR
QUIT '$PIECE($GET(^AUTTIMM(PXIMM,0)),U,7)
+5 ;
+6 IF PXAUDIT
Begin DoDot:1
+7 SET PXLASTEDIT=$PIECE($$LAST^DIAUTL(9999999.14,PXIMM,".07"),U,1)
+8 IF PXDATE>PXLASTEDIT
SET PXCURR=1
End DoDot:1
+9 IF PXCURR
QUIT '$PIECE($GET(^AUTTIMM(PXIMM,0)),U,7)
+10 ;
+11 QUIT $PIECE($$GETSTAT^XTID(9999999.14,"",PXIMM_",",$GET(PXDATE)),U,1)
+12 ;
GETCSTAT(PXDATE,PXAUDIT) ;
+1 ;
+2 ; Should we get current status of IMM entries or should we call GETSTAT^XTID
+3 ; to get status as of a specific date?
+4 ; Since GETSTAT^XTID is slow, we try to avoid it when possible.
+5 ;
+6 ; Returns: 0 - Call GETSTAT^XTID
+7 ; 1 - Get current status
+8 ;
+9 NEW PXLASTEDITDT,PXRSLT
+10 ;
+11 SET PXRSLT=0
+12 ;
+13 IF '$GET(PXDATE)
Begin DoDot:1
+14 SET PXRSLT=1
End DoDot:1
QUIT PXRSLT
+15 ;
+16 IF $PIECE(PXDATE,".",1)=DT
Begin DoDot:1
+17 SET PXRSLT=1
End DoDot:1
QUIT PXRSLT
+18 ;
+19 ; If Inactive Flag is being audited (which should be the case)
+20 ; then get current status, if file has not been updated since PXDATE
+21 IF PXAUDIT
Begin DoDot:1
+22 ;ICR #2602
SET PXLASTEDITDT=$ORDER(^DIA(9999999.14,"C",""),-1)
+23 IF PXDATE>PXLASTEDITDT
SET PXRSLT=1
End DoDot:1
+24 ;
+25 QUIT PXRSLT
+26 ;
+27 ;
IMMADMCODES(PXRSLT,PXVISIT,PXPCELIST,PXRETCPTDEL) ;
+1 ;
+2 ; Returns Immunization Admin CPT codes
+3 ;
+4 ;Input:
+5 ; PXRSLT - Return value passed by reference (Required)
+6 ; PXVISIT - Visit IEN (Optional)
+7 ; PXPCELIST - PCE Array in format passed to PX SAVE DATA rpc (Required)
+8 ; PXRETCPTDEL - Should API return other mapped CPT codes (i.e., not admin) to delete (Optional)
+9 ;
+10 ;Returns:
+11 ; PXRSLT(n) = array of CPT codes to add/delete from Visit in format passed to PX SAVE DATA rpc
+12 ;
+13 DO IMMADMCODES^PXVRPC4A(.PXRSLT,.PXVISIT,.PXPCELIST,$GET(PXRETCPTDEL))
+14 QUIT
+15 ;
+16 ; Check if PXIEN should be excluded based off ORWPCE EXCLUDE XXX parameter
EXCLUDED(PXLST,PXIEN,PXTYPE,PXLOC) ;
+1 ;
+2 NEW PXI,PXTMP,PXX
+3 ;
+4 IF '$DATA(PXLST)
Begin DoDot:1
+5 DO EXCLUDED^ORWPCE2(.PXTMP,$GET(PXLOC),PXTYPE)
+6 SET PXI=0
+7 FOR
SET PXI=$ORDER(PXTMP(PXI))
if 'PXI
QUIT
Begin DoDot:2
+8 SET PXX=$PIECE($GET(PXTMP(PXI)),U,2)
+9 IF PXX
SET PXLST(PXX)=""
End DoDot:2
End DoDot:1
+10 ;
+11 IF $DATA(PXLST(PXIEN))
QUIT 1
+12 ;
+13 QUIT 0
