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

PXAIIMMV.m

Go to the documentation of this file. 
  1. PXAIIMMV ;ISL/PKR - VALIDATE IMMUNIZATION DATA ;10/05/2020
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**199,209,210,211**;Aug 12, 1996;Build 454
  1.  ;
  1. ERRSET ;Set the rest of the error data.
  1.  S STOP=1
  1.  S PXAERRF("IMM")=1
  1.  S PXADI("DIALOG")=8390001.001
  1.  S PXAERR(7)="IMMUNIZATION"
  1.  Q
  1.  ;
  1. VAL ;Validate the input data.
  1.  I $G(PXAA("IMMUN"))="" D  Q
  1.  . S PXAERR(9)="IMMUNIZATION"
  1.  . S PXAERR(12)="You are missing the name of the immunization"
  1.  . D ERRSET
  1.  ;
  1.  ;If this is a deletion no further verification is required.
  1.  I $G(PXAA("DELETE"))=1 Q
  1.  ;
  1.  ;Check that it is a valid pointer.
  1.  I '$D(^AUTTIMM(PXAA("IMMUN"))) D  Q
  1.  . S PXAERR(9)="IMMUNIZATION"
  1.  . S PXAERR(11)=PXAA("IMMUN")
  1.  . S PXAERR(12)="The Immunization pointer is not valid."
  1.  . D ERRSET
  1.  ;
  1.  N SOURCE
  1.  S SOURCE=$S(+PXASOURC>0:$P($G(^PX(839.7,PXASOURC,0)),U,1),1:"")
  1.  I SOURCE="VLER E-HEALTH EXCHANGE",$G(PXAA("CVX"))'="" D  Q:$G(STOP)=1
  1.  . I '$$IMMSEL^PXVUTIL(PXAA("IMMUN"),$G(PXAVISIT)) D
  1.  .. S STOP=1
  1.  .. S PXAERRF("IMM")=1
  1.  .. S PXADI("DIALOG")=8390001.001
  1.  .. S PXAERR(9)="IMMUNIZATION"
  1.  .. S PXAERR(10)="AFTER"
  1.  .. S PXAERR(11)=PXAA("IMMUN")
  1.  .. S PXAERR(12)="IMMUNIZATION #"_PXAA("IMMUN")_"is NOT selectable for this encounter"
  1.  ;
  1.  ;Check that it is active. Inactive immunizations that are marked
  1.  ;Selectable for Historic can be used for historical encounters.
  1.  ;* I '$$IMMSEL^PXVUTIL(PXAA("IMMUN"),PXAVISIT,$G(PXAA("EVENT D/T"))) D
  1.  ;* . S PXAERR(9)="INACTIVE"
  1.  ;* . S PXAERR(11)=PXAA("IMMUN")
  1.  ;* . S PXAERR(12)="The Immunization is inactive."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Series is input validate it.
  1.  ;* I $G(PXAA("SERIES"))'="",'$$SET^PXAIVAL(9000010.11,"SERIES",.04,PXAA("SERIES"),.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Reaction is input validate it.
  1.  ;* I $G(PXAA("REACTION"))'="",'$$SET^PXAIVAL(9000010.11,"REACTION",.06,PXAA("REACTION"),.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Contraindicated is input validate it.
  1.  ;* I $G(PXAA("CONTRAINDICATED"))'="",'$$SET^PXAIVAL(9000010.11,"CONTRAINDICATED",.07,PXAA("CONTRAINDICATED"),.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If an Override Reason is passed verify it.
  1.  ;* I $G(PXAA("OVERRIDE REASON"))'="",'$$TEXT^PXAIVAL("OVERRIDE REASON",PXAA("OVERRIDE REASON"),3,245,.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If an Ordering Provider is passed verify it is valid.
  1.  ;* I $G(PXAA("ORD PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ORD PROVIDER"),"ORD",.PXAA,.PXAERR,PXAVISIT) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If an Encounter Provider is passed verify it is valid.
  1.  ;* I $G(PXAA("ENC PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ENC PROVIDER"),"ENC",.PXAA,.PXAERR,PXAVISIT) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Event D/T is input verify it is a valid FileMan date and not a
  1.  ;future date.
  1.  ;* I $G(PXAA("EVENT D/T"))'="",'$$EVENTDT^PXAIVAL(PXAA("EVENT D/T"),"T",.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If a Comment is passed verify it.
  1.  ;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245,.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If PKG is input verify it.
  1.  ;* I $G(PXAA("PKG"))'="" D
  1.  ;* . N PKG
  1.  ;* . S PKG=$$VPKG^PXAIVAL(PXAA("PKG"),.PXAERR)
  1.  ;* . I PKG=0 S PXAERR(9)="PKG" D ERRSET Q
  1.  ;* . S PXAA("PKG")=PKG
  1.  ;* I $G(STOP)=1 Q
  1.  ;
  1.  ;If SOURCE is input verify it.
  1.  ;* I $G(PXAA("SOURCE"))'="" D
  1.  ;* . N SRC
  1.  ;* . S SRC=$$VSOURCE^PXAIVAL(PXAA("SOURCE"),.PXAERR)
  1.  ;* . I SRC=0 S PXAERR(9)="SOURCE" D ERRSET Q
  1.  ;* . S PXAA("SOURCE")=SRC
  1.  ;* I $G(STOP)=1 Q
  1.  ;
  1.  ;If Lot Num is input validate it.
  1.  ;* I $G(PXAA("LOT NUM"))'="",'$D(^AUTTIML(PXAA("LOT NUM"),0)) D  Q
  1.  ;* . S PXAERR(9)="LOT NUM"
  1.  ;* . S PXAERR(11)=PXAA("LOT NUM")
  1.  ;* . S PXAERR(12)=PXAA("LOT NUM")_" is not a valid pointer to the Immunization Lot file #9999999.41."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Info Source is input validate it.
  1.  ;* I $G(PXAA("INFO SOURCE"))'="",'$D(^PXV(920.2,PXAA("INFO SOURCE"),0)) D  Q
  1.  ;* . S PXAERR(9)="INFO SOURCE"
  1.  ;* . S PXAERR(11)=PXAA("INFO SOURCE")
  1.  ;* . S PXAERR(12)=PXAA("INFO SOURCE")_" is not a valid pointer to the Immunization Info Source file #920.1."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Admin Route is input validate it.
  1.  ;* I $G(PXAA("ADMIN ROUTE"))'="",'$D(^PXV(920.2,PXAA("ADMIN ROUTE"),0)) D  Q
  1.  ;* . S PXAERR(9)="ADMIN ROUTE"
  1.  ;* . S PXAERR(11)=PXAA("ADMIN ROUTE")
  1.  ;* . S PXAERR(12)=PXAA("ADMIN ROUTE")_" is not a valid pointer to the Imm Administration Route file #920.2."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Anatomic Loc is input validate it.
  1.  ;* I $G(PXAA("ANATOMIC LOC"))'="",'$D(^PXV(920.3,PXAA("ANATOMIC LOC"),0)) D  Q
  1.  ;* . S PXAERR(9)="ANATOMIC LOC"
  1.  ;* . S PXAERR(11)=PXAA("ANATOMIC LOC")
  1.  ;* . S PXAERR(12)=PXAA("ANATOMIC LOC")_" is not a valid pointer to the Imm Administration Site file #920.3."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Dose is input validate it.
  1.  ;* I $G(PXAA("DOSE"))'="",+PXAA("DOSE")'=PXAA("DOSE")!(PXAA("DOSE")>999)!(PXAA("DOSE")<0)!(PXAA("DOSE")?.E1"."3N.N) D  Q
  1.  ;* . S PXAERR(9)="DOSE"
  1.  ;* . S PXAERR(11)=PXAA("DOSE")
  1.  ;* . S PXAERR(12)=PXAA("DOSE")_" is not a number between 0 and 999 with 2 fractional digits."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If Dose Units is input validate it.
  1.  ;* I $G(PXAA("DOSE UNITS"))'="" D
  1.  ;* . N UNITS
  1.  ;* . S UNITS=$$UCUMCODE^LEXMUCUM(PXAA("DOSE UNITS"))
  1.  ;* . I $P(UNITS,U,1)="{unit not defined}" D
  1.  ;* .. S PXAERR(9)="DOSE UNITS"
  1.  ;* .. S PXAERR(11)=PXAA("DOSE UNITS")
  1.  ;* .. S PXAERR(12)=PXAA("DOSE UNITS")_" is not a valid pointer to UCUM Codes file #757.5."
  1.  ;* .. D ERRSET
  1.  ;* I $G(STOP)=1 Q
  1.  ;
  1.  ;If Vaccine Information Statements are input validate them.
  1.  ;* I $D(PXAA("VIS")) D
  1.  ;* . N DATE,ERRORD,ERRORV,SEQ,VIS
  1.  ;* . S (ERRORD,ERRORV,SEQ)=0
  1.  ;* . F  S SEQ=+$O(PXAA("VIS",SEQ)) Q:SEQ=0  D
  1.  ;* .. S VIS=$P(PXAA("VIS",SEQ,0),U,1)
  1.  ;* .. I VIS="@" Q
  1.  ;* .. I VIS="" S ERRORV=1,PXAERR(12)="SEQ #"_SEQ_": The Vaccine Information Statement pointer is null."
  1.  ;* .. I (ERRORV=0),'$D(^AUTTIVIS(VIS,0)) S ERROR=1,PXAERR(12)="SEQ #"_SEQ_": "_VIS_" is not a valid pointer to the Vaccine Information Statement file #920."
  1.  ;* .. S DATE=$P(PXAA("VIS",SEQ,0),U,2)
  1.  ;* .. I DATE="" S ERRORD=1,PXAERR(13)="SEQ #"_SEQ_": Date Offered/Given is null."
  1.  ;* .. I (ERRORD=0),($$VFMDATE^PXDATE(DATE,"PX")=-1) S ERRORD=1,PXAERR(13)="SEQ #"_SEQ_": "_DATE_" is not a valid Date Offered/Given."
  1.  ;* .. I (ERRORD=0),$$FUTURE^PXDATE(DATE) S ERRORD=1,PXAERR(13)="SEQ #"_SEQ_": "_DATE_" is not a valid Date Offered/Given, it is the future."
  1.  ;* . I (ERRORD=1)!(ERRORV=1) S PXAERR(9)="VIS" D ERRSET
  1.  ;* I $G(STOP)=1 Q
  1.  ;
  1.  ;Remarks is word-processing, no validation required.
  1.  ;
  1.  ;Check for diagnosis input and return a warning.
  1.  ;* N DIAGNUM,DIAGSTR,NDIAG
  1.  ;* S NDIAG=0
  1.  ;* F DIAGNUM=1:1:8 D
  1.  ;* . S DIAGSTR="DIAGNOSIS"_$S(DIAGNUM>1:" "_DIAGNUM,1:"")
  1.  ;* . I $G(PXAA(DIAGSTR))]"" S NDIAG=NDIAG+1
  1.  ;* I NDIAG>0 D
  1.  ;* . S PXADI("DIALOG")=8390001.002
  1.  ;* . S PXAERRW("IMM")=1
  1.  ;* . S PXAERR(9)="DIAGNOSIS"
  1.  ;* . S PXAERR(12)="As of patch PX*1*211 diagnoses cannot be stored in V IMMUNIZATION."
  1.  ;* Q
  1.  ;
  1.  ; Validate VIMM 2.0 fields
  1.  N PXFLD,PXFLDNAME,PXFLDNUM,PXVAL,PXFILE,PXOK,PXNEWVAL,PXSEQ,PXVIS
  1.  ;
  1.  F PXFLD="SERIES^.04","LOT NUM^1207","INFO SOURCE^1301","ADMIN ROUTE^1302","ANATOMIC LOC^1303","ORD PROVIDER^1202","DOSE UNITS^1313" D
  1.  . ;
  1.  . S PXFLDNAME=$P(PXFLD,"^",1)
  1.  . S PXFLDNUM=$P(PXFLD,"^",2)
  1.  . ;
  1.  . S PXVAL=$G(PXAA(PXFLDNAME))
  1.  . I PXVAL="" Q
  1.  . ;
  1.  . S PXFILE=9000010.11
  1.  . S PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
  1.  . I PXOK D
  1.  . . S PXNEWVAL=$P(PXOK,"^",2)
  1.  . . I PXNEWVAL'="" S PXAA(PXFLDNAME)=PXNEWVAL
  1.  . I 'PXOK D
  1.  . . D ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
  1.  . . K PXAA(PXFLDNAME) ; Don't file this field, as it's invalid
  1.  ;
  1.  ; Check VIS Multiple
  1.  S PXFLDNAME="VIS"
  1.  S PXFLDNUM=.01
  1.  ;
  1.  I $G(PXAA(PXFLDNAME))="@" Q
  1.  ;
  1.  S PXSEQ=0
  1.  F  S PXSEQ=$O(PXAA(PXFLDNAME,PXSEQ)) Q:'PXSEQ  D
  1.  . ;
  1.  . S PXVAL=$P($G(PXAA(PXFLDNAME,PXSEQ,0)),U,1)
  1.  . I PXVAL="" K PXAA(PXFLDNAME,PXSEQ) Q
  1.  . ;
  1.  . S PXFILE=9000010.112
  1.  . S PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
  1.  . I 'PXOK D
  1.  . . D ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
  1.  . . K PXAA(PXFLDNAME,PXSEQ) ; Don't file this field, as it's invalid
  1.  ;
  1.  Q
  1.  ;
  1. VALFLD(PXFILE,PXFLDNUM,PXVAL) ;
  1.  ;
  1.  ; Validate field and return:
  1.  ;
  1.  ;    1   - Field is valid
  1.  ;    1^X - Field is valid, but was external value.
  1.  ;          The function will return the internal
  1.  ;          value in the 2nd piece (X).
  1.  ;    0   - Field is invalid
  1.  ;
  1.  N PXOK,PXEXT,PXCODES,PXI,PXX,PXCODE,PXCODEVAL,PXTEMP
  1.  ;
  1.  S PXOK=1
  1.  ;
  1.  I PXVAL="@" Q PXOK
  1.  ;
  1.  S PXEXT=$$EXTERNAL^DILFD(PXFILE,PXFLDNUM,,PXVAL,"PXERR")  ;using this to get around input transform
  1.  I PXFILE=9000010.11,PXFLDNUM=1313 D
  1.  . N PXRSLT,PXERR
  1.  . D CHK^DIE(PXFILE,PXFLDNUM,"E","`"_PXVAL,.PXRSLT,"PXERR")
  1.  . S PXEXT=$G(PXRSLT(0))
  1.  . I $G(PXRSLT)="^" S PXEXT=""
  1.  S PXOK=(PXEXT'="")
  1.  ;
  1.  ; If value is not valid, and field is set-of-codes,
  1.  ; check to see if external value was passed in.
  1.  ; If that was the case, set PXOK to 1,
  1.  ; and return internal value in 2nd piece of PXOK
  1.  I 'PXOK,($$GET1^DID(PXFILE,PXFLDNUM,,"TYPE",,"PXERR")="SET") D
  1.  . S PXCODES=$$GET1^DID(PXFILE,PXFLDNUM,,"POINTER",,"PXERR")
  1.  . F PXI=1:1:$L(PXCODES,";") D
  1.  . . S PXX=$P(PXCODES,";",PXI)
  1.  . . S PXCODE=$P(PXX,":",1)
  1.  . . S PXCODEVAL=$P(PXX,":",2)
  1.  . . I PXCODE=""!(PXCODEVAL="") Q
  1.  . . S PXTEMP(PXCODEVAL)=PXCODE
  1.  . S PXCODE=$G(PXTEMP(PXVAL))
  1.  . I PXCODE'="" S PXOK="1^"_PXCODE
  1.  ;
  1.  Q PXOK
  1.  ;
  1. ERRMSG(PXDLG,PXSTOP,PXVAL,PXFLDNAME) ;
  1.  S STOP=$G(PXSTOP,0)
  1.  S PXAERRF("IMM")=1
  1.  S PXADI("DIALOG")=$G(PXDLG,"8390001.002")
  1.  I $G(PXAERR(9))'="" D
  1.  . S PXAERR(9)=PXAERR(9)_", "
  1.  . S PXAERR(11)=PXAERR(11)_", "
  1.  . S PXAERR(12)=PXAERR(12)_" "
  1.  S PXAERR(9)=$G(PXAERR(9))_PXFLDNAME
  1.  S PXAERR(11)=$G(PXAERR(11))_PXVAL
  1.  S PXAERR(12)=$G(PXAERR(12))_"'"_PXVAL_"' is not a valid value for field "_PXFLDNAME_"."
  1.  Q
  1.  ;