Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXVRPC5

PXVRPC5.m

Go to the documentation of this file. 
  1. PXVRPC5 ;BPFO/LMT - PCE RPCs for Imm Contraindications/refusals ;Aug 10, 2021@15:21:58
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**215,216,217**;Aug 12, 1996;Build 134
  1.  ;
  1.  ;
  1. GETICR(PXRSLT,PXFILE,PXFLTR,PXINST,PXLOC) ;
  1.  ;
  1.  ; Returns entries from the IMM CONTRAINDICATION REASONS (#920.4) and
  1.  ; IMM REFUSAL REASONS (#920.5) files.
  1.  ;
  1.  ;Input:
  1.  ;  PXRSLT - Return value passed by reference (Required)
  1.  ;  PXFILE - Which file to pull from (Optional; Leave this null to pull entries from both files)
  1.  ;           Possible values are:
  1.  ;               "920.4" - Only return entries from IMM CONTRAINDICATION REASONS (#920.4)
  1.  ;               "920.5" - Only return entries from IMM REFUSAL REASONS (#920.5)
  1.  ;  PXFLTR - Filter (Optional; Defaults to "S:A")
  1.  ;           Possible values are:
  1.  ;               R:X   - Return entry with IEN X (PXFILE must be passed in with this option).
  1.  ;               C:X^Y - Return entry with Concept Code^Coding System X^Y (used only for #920.4).
  1.  ;               H:X   - Return entry with HL7 Code X (used only for #920.5).
  1.  ;               N:X   - Return entry with #.01 field equal to X
  1.  ;               I:X   - Return all active entries that are selectable for Immunization IEN X.
  1.  ;               S:A   - Return all active entries.
  1.  ;               S:I   - Return all inactive entries.
  1.  ;               S:B   - Return all entries (both active and inactive).
  1.  ;  PXINST - Institution IEN
  1.  ;   PXLOC - Location IEN (If Institution IEN is not passed in, the loc will be used to get the institution).
  1.  ;
  1.  ;Returns:
  1.  ;  PXRSLT(0)=Count of elements returned (0 if nothing found)
  1.  ;  For 920.4 Entry:
  1.  ;    PXRSLT(n)=IEN;PXV(920.4,^Name^Status (1:Active, 0:Inactive)^Code|Coding System^NIP004
  1.  ;              ^Contraindication/Precaution^Allergy-Related (1:Yes, 0:No)^Default Warn Until Date ("Forever" means it should be forever)
  1.  ;  For 920.5 Entry:
  1.  ;    PXRSLT(n)=IEN;PXV(920.5,^Name^Status (1:Active, 0:Inactive)^HL7 Code^Default Warn Until Date ("Forever" means it should be forever)
  1.  ;
  1.  N PXCNT,PXCODE,PXFILES,PXFLTRTYP,PXFLTRVAL,PXI,PXIEN,PXNAME,PXPAR,PXSEQARR,PXSKIP,PXSYS,PXX
  1.  ;
  1.  I $G(PXFILE)'?1(1"920.4",1"920.5") S PXFILE=""
  1.  I $P($G(PXFLTR),":",1)'?1(1"R",1"C",1"H",1"N",1"I",1"S") S PXFLTR="S:A"
  1.  I $G(PXINST)="",$G(PXLOC) S PXINST=$$INST^PXVUTIL("L:"_+PXLOC)
  1.  I '$G(PXINST) S PXINST=$$KSP^XUPARAM("INST")
  1.  S PXCNT=0
  1.  S PXFLTRTYP=$P(PXFLTR,":",1)
  1.  S PXFLTRVAL=$P(PXFLTR,":",2)
  1.  D CHKCACHE^PXVRPC2(920.5)
  1.  ;
  1.  I PXFLTRTYP="R" D
  1.  . I 'PXFILE Q
  1.  . S PXIEN=PXFLTRVAL
  1.  . I 'PXIEN Q
  1.  . I '$D(^PXV(PXFILE,PXIEN)) Q
  1.  . D ADDENTRY(.PXRSLT,.PXFILE,.PXIEN,"","",.PXCNT,PXINST)
  1.  ;
  1.  I PXFLTRTYP="C" D
  1.  . S PXFILE=920.4
  1.  . S PXCODE=$P(PXFLTRVAL,U,1)
  1.  . S PXSYS=$P(PXFLTRVAL,U,2)
  1.  . I (PXCODE="")!(PXSYS="") Q
  1.  . S PXIEN=0
  1.  . S PXX=0
  1.  . F  S PXX=$O(^PXV(PXFILE,"C",PXCODE,PXX)) Q:'PXX  D  Q:PXIEN
  1.  . . I $P($G(^PXV(PXFILE,PXX,"VUID")),U,4)=PXSYS S PXIEN=PXX
  1.  . I 'PXIEN Q
  1.  . D ADDENTRY(.PXRSLT,.PXFILE,.PXIEN,"","",.PXCNT,PXINST)
  1.  ;
  1.  I PXFLTRTYP="H" D
  1.  . S PXFILE=920.5
  1.  . I PXFLTRVAL="" Q
  1.  . S PXIEN=0
  1.  . S PXX=0
  1.  . F  S PXX=$O(^PXV(PXFILE,PXX)) Q:'PXX  D  Q:PXIEN
  1.  . . I $P($G(^PXV(PXFILE,PXX,0)),U,2)=PXFLTRVAL S PXIEN=PXX
  1.  . I 'PXIEN Q
  1.  . D ADDENTRY(.PXRSLT,.PXFILE,.PXIEN,"","",.PXCNT,PXINST)
  1.  ;
  1.  I PXFILE="" D
  1.  . S PXFILES(920.4)=""
  1.  . S PXFILES(920.5)=""
  1.  I PXFILE'="" S PXFILES(PXFILE)=""
  1.  ;
  1.  I PXFLTRTYP="N" D
  1.  . I PXFLTRVAL="" Q
  1.  . S PXIEN=0
  1.  . S PXFILE=0
  1.  . F  S PXFILE=$O(PXFILES(PXFILE)) Q:'PXFILE  D  Q:PXIEN
  1.  . . S PXIEN=$O(^PXV(PXFILE,"B",PXFLTRVAL,0))
  1.  . I 'PXIEN Q
  1.  . D ADDENTRY(.PXRSLT,.PXFILE,.PXIEN,"","",.PXCNT,PXINST)
  1.  ;
  1.  I PXFLTRTYP?1(1"S",1"I") D
  1.  . S PXFILE=0
  1.  . F  S PXFILE=$O(PXFILES(PXFILE)) Q:'PXFILE  D
  1.  . . ;
  1.  . . ; Sort entries based off the order defined in the parameter
  1.  . . S PXPAR=$S(PXFILE=920.4:"PXV CONTRA SEQUENCE",1:"PXV REFUSAL SEQUENCE")
  1.  . . K PXSEQARR
  1.  . . D GETLST^XPAR(.PXSEQARR,"ALL",PXPAR,"Q")
  1.  . . S PXI=0 F  S PXI=$O(PXSEQARR(PXI)) Q:'PXI  D
  1.  . . . S PXIEN=$P($G(PXSEQARR(PXI)),U,2)
  1.  . . . I 'PXIEN Q
  1.  . . . D ADDENTRY(.PXRSLT,.PXFILE,.PXIEN,.PXFLTRTYP,.PXFLTRVAL,.PXCNT,PXINST)
  1.  . . . S PXSKIP(PXFILE,PXIEN)=""
  1.  . . ;
  1.  . . ; Sort remaining entries in alphabetical order
  1.  . . S PXNAME=""
  1.  . . F  S PXNAME=$O(^PXV(PXFILE,"B",PXNAME)) Q:PXNAME=""  D
  1.  . . . S PXIEN=0
  1.  . . . F  S PXIEN=$O(^PXV(PXFILE,"B",PXNAME,PXIEN)) Q:'PXIEN  D
  1.  . . . . I $D(PXSKIP(PXFILE,PXIEN)) Q
  1.  . . . . D ADDENTRY(.PXRSLT,.PXFILE,.PXIEN,PXFLTRTYP,PXFLTRVAL,.PXCNT,PXINST)
  1.  ;
  1.  S PXRSLT(0)=PXCNT
  1.  ;
  1.  Q
  1.  ;
  1. ADDENTRY(PXRSLT,PXFILE,PXIEN,PXFLTRTYP,PXFLTRVAL,PXCNT,PXINST) ; Adds entry to PXVRSLT
  1.  ;
  1.  N PXFLDS,PXFLTRSTAT,PXSKIP,PXSTAT,PXWARNDATE
  1.  ;
  1.  I 'PXIEN Q
  1.  ;
  1.  S PXSKIP=0
  1.  I PXFILE=920.4,$G(PXFLTRTYP)="I",$G(PXFLTRVAL),$O(^PXV(PXFILE,PXIEN,3,0)) D
  1.  . I '$O(^PXV(PXFILE,PXIEN,3,"B",PXFLTRVAL,0)) S PXSKIP=1
  1.  I PXSKIP Q
  1.  ;
  1.  S PXFLDS=$$GETFLDS(PXFILE,PXIEN,PXINST)
  1.  S PXSTAT=$P(PXFLDS,U,3)
  1.  S PXWARNDATE=$P(PXFLDS,U,$S(PXFILE=920.5:5,1:8))
  1.  ;
  1.  S PXFLTRSTAT="A"
  1.  I $G(PXFLTRTYP)="S",$G(PXFLTRVAL)?1(1"A",1"I",1"B") S PXFLTRSTAT=PXFLTRVAL
  1.  I $G(PXFLTRSTAT)="A",'PXSTAT Q
  1.  I $G(PXFLTRSTAT)="I",PXSTAT Q
  1.  ;
  1.  ; Don't include this entry if no default warn until day is defined for it.
  1.  I $G(PXFLTRSTAT)="A",PXWARNDATE="" Q
  1.  ;
  1.  S PXCNT=PXCNT+1
  1.  S PXRSLT(PXCNT)=PXFLDS
  1.  ;
  1.  Q
  1.  ;
  1. GETFLDS(PXFILE,PXIEN,PXINST) ; Returns field values
  1.  ;
  1.  N PXCODE,PXNAME,PXNODE,PXRSLT,PXSTAT,PXWARNDT
  1.  ;
  1.  S PXNODE=$G(^PXV(PXFILE,PXIEN,0))
  1.  S PXNAME=$P(PXNODE,U,1)
  1.  S PXCODE=$P(PXNODE,U,2)
  1.  S PXSTAT=$$GETSTAT^PXVRPC2(PXFILE,PXIEN)
  1.  ;
  1.  S PXRSLT=PXIEN_";PXV("_PXFILE_","_U_PXNAME_U_PXSTAT_U_PXCODE
  1.  ;
  1.  I PXFILE=920.4 D
  1.  . S PXRSLT=PXRSLT_"|"_$P($G(^PXV(PXFILE,PXIEN,"VUID")),U,4)
  1.  . S PXRSLT=PXRSLT_U_$P(PXNODE,U,4)_U_$P(PXNODE,U,5)
  1.  . S PXRSLT=PXRSLT_U_$$ARTAPI^PXVUTIL(PXIEN)
  1.  ;
  1.  D CONDEF(.PXWARNDT,PXIEN_";PXV("_PXFILE_",",PXINST)
  1.  S PXRSLT=PXRSLT_U_$G(PXWARNDT)
  1.  ;
  1.  Q PXRSLT
  1.  ;
  1. GETVICR(PXRSLT,DFN,PXVIMM,PXDATE,PXFORMAT) ;
  1.  ;
  1.  ; Returns "active" entries from the V IMM CONTRA/REFUSAL EVENTS file (#9000010.707)
  1.  ; that are related to the given patient and immunization.
  1.  ; "Active" is defined as entries where the Event Date and Time is <= PXDATE@24
  1.  ; and the Warn Until Date is null or >= PXDATE.
  1.  ;
  1.  ;Input:
  1.  ;    PXRSLT - Return value passed by reference (Required)
  1.  ;       DFN - Pointer to file #2 (Required)
  1.  ;    PXVIMM - Pointer to #9999999.14 (Required)
  1.  ;    PXDATE - Date (without time) Used to determine if entry is "active"
  1.  ;             (Optional; Defaults to TODAY)
  1.  ;  PXFORMAT - Format that return array should be returned (Optional; Defaults to "L")
  1.  ;             Possible values are:
  1.  ;                "L": Return a caret-delimited list of entries
  1.  ;                "W": Returns a warning message.
  1.  ;
  1.  ;Returns:
  1.  ;  PXRSLT(0)=Count of elements returned (0 if nothing found)
  1.  ;  If PXFORMAT="L":
  1.  ;    PXRSLT(n)="VICR" ^ V IMM Contra/Refusal Events IEN ^ Visit IEN ^ Contra/Refusal
  1.  ;               variable pointer | Contra/Refusal Name ^ Immunization IEN | Name
  1.  ;               ^ Warn Until Date ^ D/T Recorded ^ Event D/T ^ Encounter Provider
  1.  ;               IEN | Name
  1.  ;    PXRSLT(n)="COM" ^ Comments
  1.  ;  If PXFORMAT["W":
  1.  ;    PXRSLT(n)=Warning text
  1.  ;
  1.  N PXCNT,PXEDATE,PXICRARR,PXIEN,PXSDATE,PXCONTRA,PXNODE,PXSORT,PXVIEN
  1.  ;
  1.  I (('$G(DFN))!('$G(PXVIMM))) S PXRSLT(0)=0 Q
  1.  ;
  1.  I '$G(PXDATE) S PXDATE=DT
  1.  S PXSDATE=$P(PXDATE,".",1)
  1.  S PXEDATE=9999999
  1.  I PXSDATE'=DT S PXEDATE=PXSDATE_".24"
  1.  I $G(PXFORMAT)'?1(1"W",1"L") S PXFORMAT="L"
  1.  ;
  1.  D PATICR^PXAPIIM(.PXICRARR,$G(DFN),$G(PXVIMM),PXSDATE,PXEDATE)
  1.  S PXCNT=0
  1.  ;
  1.  I PXFORMAT="W",$O(PXICRARR(0)) D
  1.  . S PXCNT=PXCNT+1
  1.  . S PXRSLT(PXCNT)="Warning: Contraindication/refusal event(s) associated with this immunization:"
  1.  ;
  1.  S PXIEN=0
  1.  F  S PXIEN=$O(PXICRARR(PXIEN)) Q:'PXIEN  D
  1.  . S PXNODE=$G(PXICRARR(PXIEN))
  1.  . S PXVIEN=$P($P(PXNODE,U,2),"|",1)
  1.  . S PXCONTRA=$G(PXICRARR(PXIEN,"CONTRAINDICATION/PRECAUTION"))
  1.  . ; PXSORT: 1 - Contraindications); 2 - Precautions; 3 - Refusals
  1.  . S PXSORT=$S($P(PXVIEN,";",2)[920.5:3,PXCONTRA="C":1,PXCONTRA="P":2,1:2)
  1.  . S PXSORT(PXSORT,PXIEN)=""
  1.  F PXSORT=1:1:3 D
  1.  . S PXIEN=0
  1.  . F  S PXIEN=$O(PXSORT(PXSORT,PXIEN)) Q:'PXIEN  D
  1.  . . D ADDVICR(.PXRSLT,.PXICRARR,.PXIEN,.PXCNT,.PXFORMAT)
  1.  ;
  1.  S PXRSLT(0)=PXCNT
  1.  ;
  1.  Q
  1.  ;
  1. ADDVICR(PXRSLT,PXICRARR,PXIEN,PXCNT,PXFORMAT) ; Add one entry to PXRSLT
  1.  ;
  1.  N PXNODE,PXWARNDT,PXX,PXVIEN,PXTITLE
  1.  ;
  1.  I PXFORMAT="L" D
  1.  . S PXCNT=PXCNT+1
  1.  . S PXRSLT(PXCNT)="VICR"_U_PXIEN_U_$G(PXICRARR(PXIEN))
  1.  . I $G(PXICRARR(PXIEN,"COMMENTS"))'="" D
  1.  . . S PXCNT=PXCNT+1
  1.  . . S PXRSLT(PXCNT)="COM"_U_$G(PXICRARR(PXIEN,"COMMENTS"))
  1.  ;
  1.  I PXFORMAT="W" D
  1.  . S PXNODE=$G(PXICRARR(PXIEN))
  1.  . S PXVIEN=$P($P(PXNODE,U,2),"|",1)
  1.  . S PXTITLE=$S($P(PXVIEN,";",2)[920.5:"Patient Refused",1:$G(PXICRARR(PXIEN,"CONTRAINDICATION/PRECAUTION")))
  1.  . S PXTITLE=$S(PXTITLE="C":"Contraindicated",PXTITLE="P":"Precaution",1:PXTITLE)
  1.  . S PXX="- "_PXTITLE_": "
  1.  . S PXX=PXX_$P($P(PXNODE,U,2),"|",2)
  1.  . S PXWARNDT=$P(PXNODE,U,4)
  1.  . I PXWARNDT S PXX=PXX_"  (Until "_$$FMTE^XLFDT(PXWARNDT,1)_")"
  1.  . S PXCNT=PXCNT+1
  1.  . S PXRSLT(PXCNT)=" "
  1.  . S PXCNT=PXCNT+1
  1.  . S PXRSLT(PXCNT)=PXX
  1.  . I $G(PXICRARR(PXIEN,"COMMENTS"))'="" D
  1.  . . S PXX="   Comment: "_PXICRARR(PXIEN,"COMMENTS")
  1.  . . S PXCNT=PXCNT+1
  1.  . . S PXRSLT(PXCNT)=PXX
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CONDEF(PXRSLT,PXENTRY,PXINST) ;
  1.  ;
  1.  N PXDAYS,PXIEN,PXIEN2,PXPRNT,PXSTA
  1.  ;
  1.  S PXRSLT=""
  1.  ;
  1.  I '$G(PXENTRY)!('$G(PXINST)) Q
  1.  I $D(PXINST(PXINST)) Q  ; Used to prevent infinite recursion
  1.  ;
  1.  S PXIEN=$O(^PXV(920.05,"AD",PXINST,PXENTRY,0))
  1.  ;
  1.  I PXIEN D
  1.  . S PXIEN2=$O(^PXV(920.05,"AD",PXINST,PXENTRY,PXIEN,0))
  1.  . I 'PXIEN2 S PXIEN="" Q
  1.  . S PXDAYS=$P($G(^PXV(920.05,PXIEN,2,PXIEN2,0)),U,2)
  1.  . I PXDAYS="" S PXIEN="" Q
  1.  . I PXDAYS=0 S PXRSLT="FOREVER"
  1.  . I PXDAYS>0 S PXRSLT=$$FMADD^XLFDT(DT,PXDAYS)
  1.  ;
  1.  ; If site did not create defaults, make recursive
  1.  ; call for parent Institution; if parent has defaults,
  1.  ; inherit from parent.
  1.  I 'PXIEN D
  1.  . S PXSTA=$$STA^XUAF4(PXINST)
  1.  . I PXSTA="" Q
  1.  . S PXPRNT=$$PRNT^XUAF4(PXSTA)
  1.  . ;
  1.  . ; If parent = self, we reached the top of the chain
  1.  . I $P(PXPRNT,U,2)=PXSTA Q
  1.  . I (+PXPRNT)=PXINST Q
  1.  . I 'PXPRNT Q
  1.  . ;
  1.  . ; Used to prevent infinite recursion
  1.  . S PXINST(PXINST)=""
  1.  . ;
  1.  . S PXINST=+PXPRNT
  1.  . D CONDEF(.PXRSLT,PXENTRY,.PXINST)
  1.  ;
  1.  Q
  1.  ;
  1.  ;