PXAIIMMV ;ISL/PKR - VALIDATE IMMUNIZATION DATA ;10/05/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**199,209,210,211**;Aug 12, 1996;Build 454
;
ERRSET ;Set the rest of the error data.
S STOP=1
S PXAERRF("IMM")=1
S PXADI("DIALOG")=8390001.001
S PXAERR(7)="IMMUNIZATION"
Q
;
VAL ;Validate the input data.
I $G(PXAA("IMMUN"))="" D Q
. S PXAERR(9)="IMMUNIZATION"
. S PXAERR(12)="You are missing the name of the immunization"
. D ERRSET
;
;If this is a deletion no further verification is required.
I $G(PXAA("DELETE"))=1 Q
;
;Check that it is a valid pointer.
I '$D(^AUTTIMM(PXAA("IMMUN"))) D Q
. S PXAERR(9)="IMMUNIZATION"
. S PXAERR(11)=PXAA("IMMUN")
. S PXAERR(12)="The Immunization pointer is not valid."
. D ERRSET
;
N SOURCE
S SOURCE=$S(+PXASOURC>0:$P($G(^PX(839.7,PXASOURC,0)),U,1),1:"")
I SOURCE="VLER E-HEALTH EXCHANGE",$G(PXAA("CVX"))'="" D Q:$G(STOP)=1
. I '$$IMMSEL^PXVUTIL(PXAA("IMMUN"),$G(PXAVISIT)) D
.. S STOP=1
.. S PXAERRF("IMM")=1
.. S PXADI("DIALOG")=8390001.001
.. S PXAERR(9)="IMMUNIZATION"
.. S PXAERR(10)="AFTER"
.. S PXAERR(11)=PXAA("IMMUN")
.. S PXAERR(12)="IMMUNIZATION #"_PXAA("IMMUN")_"is NOT selectable for this encounter"
;
;Check that it is active. Inactive immunizations that are marked
;Selectable for Historic can be used for historical encounters.
;* I '$$IMMSEL^PXVUTIL(PXAA("IMMUN"),PXAVISIT,$G(PXAA("EVENT D/T"))) D
;* . S PXAERR(9)="INACTIVE"
;* . S PXAERR(11)=PXAA("IMMUN")
;* . S PXAERR(12)="The Immunization is inactive."
;* . D ERRSET
;
;If Series is input validate it.
;* I $G(PXAA("SERIES"))'="",'$$SET^PXAIVAL(9000010.11,"SERIES",.04,PXAA("SERIES"),.PXAERR) D Q
;* . D ERRSET
;
;If Reaction is input validate it.
;* I $G(PXAA("REACTION"))'="",'$$SET^PXAIVAL(9000010.11,"REACTION",.06,PXAA("REACTION"),.PXAERR) D Q
;* . D ERRSET
;
;If Contraindicated is input validate it.
;* I $G(PXAA("CONTRAINDICATED"))'="",'$$SET^PXAIVAL(9000010.11,"CONTRAINDICATED",.07,PXAA("CONTRAINDICATED"),.PXAERR) D Q
;* . D ERRSET
;
;If an Override Reason is passed verify it.
;* I $G(PXAA("OVERRIDE REASON"))'="",'$$TEXT^PXAIVAL("OVERRIDE REASON",PXAA("OVERRIDE REASON"),3,245,.PXAERR) D Q
;* . D ERRSET
;
;If an Ordering Provider is passed verify it is valid.
;* I $G(PXAA("ORD PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ORD PROVIDER"),"ORD",.PXAA,.PXAERR,PXAVISIT) D Q
;* . D ERRSET
;
;If an Encounter Provider is passed verify it is valid.
;* I $G(PXAA("ENC PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ENC PROVIDER"),"ENC",.PXAA,.PXAERR,PXAVISIT) D Q
;* . D ERRSET
;
;If Event D/T is input verify it is a valid FileMan date and not a
;future date.
;* I $G(PXAA("EVENT D/T"))'="",'$$EVENTDT^PXAIVAL(PXAA("EVENT D/T"),"T",.PXAERR) D Q
;* . D ERRSET
;
;If a Comment is passed verify it.
;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245,.PXAERR) D Q
;* . D ERRSET
;
;If PKG is input verify it.
;* I $G(PXAA("PKG"))'="" D
;* . N PKG
;* . S PKG=$$VPKG^PXAIVAL(PXAA("PKG"),.PXAERR)
;* . I PKG=0 S PXAERR(9)="PKG" D ERRSET Q
;* . S PXAA("PKG")=PKG
;* I $G(STOP)=1 Q
;
;If SOURCE is input verify it.
;* I $G(PXAA("SOURCE"))'="" D
;* . N SRC
;* . S SRC=$$VSOURCE^PXAIVAL(PXAA("SOURCE"),.PXAERR)
;* . I SRC=0 S PXAERR(9)="SOURCE" D ERRSET Q
;* . S PXAA("SOURCE")=SRC
;* I $G(STOP)=1 Q
;
;If Lot Num is input validate it.
;* I $G(PXAA("LOT NUM"))'="",'$D(^AUTTIML(PXAA("LOT NUM"),0)) D Q
;* . S PXAERR(9)="LOT NUM"
;* . S PXAERR(11)=PXAA("LOT NUM")
;* . S PXAERR(12)=PXAA("LOT NUM")_" is not a valid pointer to the Immunization Lot file #9999999.41."
;* . D ERRSET
;
;If Info Source is input validate it.
;* I $G(PXAA("INFO SOURCE"))'="",'$D(^PXV(920.2,PXAA("INFO SOURCE"),0)) D Q
;* . S PXAERR(9)="INFO SOURCE"
;* . S PXAERR(11)=PXAA("INFO SOURCE")
;* . S PXAERR(12)=PXAA("INFO SOURCE")_" is not a valid pointer to the Immunization Info Source file #920.1."
;* . D ERRSET
;
;If Admin Route is input validate it.
;* I $G(PXAA("ADMIN ROUTE"))'="",'$D(^PXV(920.2,PXAA("ADMIN ROUTE"),0)) D Q
;* . S PXAERR(9)="ADMIN ROUTE"
;* . S PXAERR(11)=PXAA("ADMIN ROUTE")
;* . S PXAERR(12)=PXAA("ADMIN ROUTE")_" is not a valid pointer to the Imm Administration Route file #920.2."
;* . D ERRSET
;
;If Anatomic Loc is input validate it.
;* I $G(PXAA("ANATOMIC LOC"))'="",'$D(^PXV(920.3,PXAA("ANATOMIC LOC"),0)) D Q
;* . S PXAERR(9)="ANATOMIC LOC"
;* . S PXAERR(11)=PXAA("ANATOMIC LOC")
;* . S PXAERR(12)=PXAA("ANATOMIC LOC")_" is not a valid pointer to the Imm Administration Site file #920.3."
;* . D ERRSET
;
;If Dose is input validate it.
;* I $G(PXAA("DOSE"))'="",+PXAA("DOSE")'=PXAA("DOSE")!(PXAA("DOSE")>999)!(PXAA("DOSE")<0)!(PXAA("DOSE")?.E1"."3N.N) D Q
;* . S PXAERR(9)="DOSE"
;* . S PXAERR(11)=PXAA("DOSE")
;* . S PXAERR(12)=PXAA("DOSE")_" is not a number between 0 and 999 with 2 fractional digits."
;* . D ERRSET
;
;If Dose Units is input validate it.
;* I $G(PXAA("DOSE UNITS"))'="" D
;* . N UNITS
;* . S UNITS=$$UCUMCODE^LEXMUCUM(PXAA("DOSE UNITS"))
;* . I $P(UNITS,U,1)="{unit not defined}" D
;* .. S PXAERR(9)="DOSE UNITS"
;* .. S PXAERR(11)=PXAA("DOSE UNITS")
;* .. S PXAERR(12)=PXAA("DOSE UNITS")_" is not a valid pointer to UCUM Codes file #757.5."
;* .. D ERRSET
;* I $G(STOP)=1 Q
;
;If Vaccine Information Statements are input validate them.
;* I $D(PXAA("VIS")) D
;* . N DATE,ERRORD,ERRORV,SEQ,VIS
;* . S (ERRORD,ERRORV,SEQ)=0
;* . F S SEQ=+$O(PXAA("VIS",SEQ)) Q:SEQ=0 D
;* .. S VIS=$P(PXAA("VIS",SEQ,0),U,1)
;* .. I VIS="@" Q
;* .. I VIS="" S ERRORV=1,PXAERR(12)="SEQ #"_SEQ_": The Vaccine Information Statement pointer is null."
;* .. 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."
;* .. S DATE=$P(PXAA("VIS",SEQ,0),U,2)
;* .. I DATE="" S ERRORD=1,PXAERR(13)="SEQ #"_SEQ_": Date Offered/Given is null."
;* .. I (ERRORD=0),($$VFMDATE^PXDATE(DATE,"PX")=-1) S ERRORD=1,PXAERR(13)="SEQ #"_SEQ_": "_DATE_" is not a valid Date Offered/Given."
;* .. 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."
;* . I (ERRORD=1)!(ERRORV=1) S PXAERR(9)="VIS" D ERRSET
;* I $G(STOP)=1 Q
;
;Remarks is word-processing, no validation required.
;
;Check for diagnosis input and return a warning.
;* N DIAGNUM,DIAGSTR,NDIAG
;* S NDIAG=0
;* F DIAGNUM=1:1:8 D
;* . S DIAGSTR="DIAGNOSIS"_$S(DIAGNUM>1:" "_DIAGNUM,1:"")
;* . I $G(PXAA(DIAGSTR))]"" S NDIAG=NDIAG+1
;* I NDIAG>0 D
;* . S PXADI("DIALOG")=8390001.002
;* . S PXAERRW("IMM")=1
;* . S PXAERR(9)="DIAGNOSIS"
;* . S PXAERR(12)="As of patch PX*1*211 diagnoses cannot be stored in V IMMUNIZATION."
;* Q
;
; Validate VIMM 2.0 fields
N PXFLD,PXFLDNAME,PXFLDNUM,PXVAL,PXFILE,PXOK,PXNEWVAL,PXSEQ,PXVIS
;
F PXFLD="SERIES^.04","LOT NUM^1207","INFO SOURCE^1301","ADMIN ROUTE^1302","ANATOMIC LOC^1303","ORD PROVIDER^1202","DOSE UNITS^1313" D
. ;
. S PXFLDNAME=$P(PXFLD,"^",1)
. S PXFLDNUM=$P(PXFLD,"^",2)
. ;
. S PXVAL=$G(PXAA(PXFLDNAME))
. I PXVAL="" Q
. ;
. S PXFILE=9000010.11
. S PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
. I PXOK D
. . S PXNEWVAL=$P(PXOK,"^",2)
. . I PXNEWVAL'="" S PXAA(PXFLDNAME)=PXNEWVAL
. I 'PXOK D
. . D ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
. . K PXAA(PXFLDNAME) ; Don't file this field, as it's invalid
;
; Check VIS Multiple
S PXFLDNAME="VIS"
S PXFLDNUM=.01
;
I $G(PXAA(PXFLDNAME))="@" Q
;
S PXSEQ=0
F S PXSEQ=$O(PXAA(PXFLDNAME,PXSEQ)) Q:'PXSEQ D
. ;
. S PXVAL=$P($G(PXAA(PXFLDNAME,PXSEQ,0)),U,1)
. I PXVAL="" K PXAA(PXFLDNAME,PXSEQ) Q
. ;
. S PXFILE=9000010.112
. S PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
. I 'PXOK D
. . D ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
. . K PXAA(PXFLDNAME,PXSEQ) ; Don't file this field, as it's invalid
;
Q
;
VALFLD(PXFILE,PXFLDNUM,PXVAL) ;
;
; Validate field and return:
;
; 1 - Field is valid
; 1^X - Field is valid, but was external value.
; The function will return the internal
; value in the 2nd piece (X).
; 0 - Field is invalid
;
N PXOK,PXEXT,PXCODES,PXI,PXX,PXCODE,PXCODEVAL,PXTEMP
;
S PXOK=1
;
I PXVAL="@" Q PXOK
;
S PXEXT=$$EXTERNAL^DILFD(PXFILE,PXFLDNUM,,PXVAL,"PXERR") ;using this to get around input transform
I PXFILE=9000010.11,PXFLDNUM=1313 D
. N PXRSLT,PXERR
. D CHK^DIE(PXFILE,PXFLDNUM,"E","`"_PXVAL,.PXRSLT,"PXERR")
. S PXEXT=$G(PXRSLT(0))
. I $G(PXRSLT)="^" S PXEXT=""
S PXOK=(PXEXT'="")
;
; If value is not valid, and field is set-of-codes,
; check to see if external value was passed in.
; If that was the case, set PXOK to 1,
; and return internal value in 2nd piece of PXOK
I 'PXOK,($$GET1^DID(PXFILE,PXFLDNUM,,"TYPE",,"PXERR")="SET") D
. S PXCODES=$$GET1^DID(PXFILE,PXFLDNUM,,"POINTER",,"PXERR")
. F PXI=1:1:$L(PXCODES,";") D
. . S PXX=$P(PXCODES,";",PXI)
. . S PXCODE=$P(PXX,":",1)
. . S PXCODEVAL=$P(PXX,":",2)
. . I PXCODE=""!(PXCODEVAL="") Q
. . S PXTEMP(PXCODEVAL)=PXCODE
. S PXCODE=$G(PXTEMP(PXVAL))
. I PXCODE'="" S PXOK="1^"_PXCODE
;
Q PXOK
;
ERRMSG(PXDLG,PXSTOP,PXVAL,PXFLDNAME) ;
S STOP=$G(PXSTOP,0)
S PXAERRF("IMM")=1
S PXADI("DIALOG")=$G(PXDLG,"8390001.002")
I $G(PXAERR(9))'="" D
. S PXAERR(9)=PXAERR(9)_", "
. S PXAERR(11)=PXAERR(11)_", "
. S PXAERR(12)=PXAERR(12)_" "
S PXAERR(9)=$G(PXAERR(9))_PXFLDNAME
S PXAERR(11)=$G(PXAERR(11))_PXVAL
S PXAERR(12)=$G(PXAERR(12))_"'"_PXVAL_"' is not a valid value for field "_PXFLDNAME_"."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIIMMV 9739 printed Nov 22, 2024@17:35:53 Page 2
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
+2 ;
ERRSET ;Set the rest of the error data.
+1 SET STOP=1
+2 SET PXAERRF("IMM")=1
+3 SET PXADI("DIALOG")=8390001.001
+4 SET PXAERR(7)="IMMUNIZATION"
+5 QUIT
+6 ;
VAL ;Validate the input data.
+1 IF $GET(PXAA("IMMUN"))=""
Begin DoDot:1
+2 SET PXAERR(9)="IMMUNIZATION"
+3 SET PXAERR(12)="You are missing the name of the immunization"
+4 DO ERRSET
End DoDot:1
QUIT
+5 ;
+6 ;If this is a deletion no further verification is required.
+7 IF $GET(PXAA("DELETE"))=1
QUIT
+8 ;
+9 ;Check that it is a valid pointer.
+10 IF '$DATA(^AUTTIMM(PXAA("IMMUN")))
Begin DoDot:1
+11 SET PXAERR(9)="IMMUNIZATION"
+12 SET PXAERR(11)=PXAA("IMMUN")
+13 SET PXAERR(12)="The Immunization pointer is not valid."
+14 DO ERRSET
End DoDot:1
QUIT
+15 ;
+16 NEW SOURCE
+17 SET SOURCE=$SELECT(+PXASOURC>0:$PIECE($GET(^PX(839.7,PXASOURC,0)),U,1),1:"")
+18 IF SOURCE="VLER E-HEALTH EXCHANGE"
IF $GET(PXAA("CVX"))'=""
Begin DoDot:1
+19 IF '$$IMMSEL^PXVUTIL(PXAA("IMMUN"),$GET(PXAVISIT))
Begin DoDot:2
+20 SET STOP=1
+21 SET PXAERRF("IMM")=1
+22 SET PXADI("DIALOG")=8390001.001
+23 SET PXAERR(9)="IMMUNIZATION"
+24 SET PXAERR(10)="AFTER"
+25 SET PXAERR(11)=PXAA("IMMUN")
+26 SET PXAERR(12)="IMMUNIZATION #"_PXAA("IMMUN")_"is NOT selectable for this encounter"
End DoDot:2
End DoDot:1
if $GET(STOP)=1
QUIT
+27 ;
+28 ;Check that it is active. Inactive immunizations that are marked
+29 ;Selectable for Historic can be used for historical encounters.
+30 ;* I '$$IMMSEL^PXVUTIL(PXAA("IMMUN"),PXAVISIT,$G(PXAA("EVENT D/T"))) D
+31 ;* . S PXAERR(9)="INACTIVE"
+32 ;* . S PXAERR(11)=PXAA("IMMUN")
+33 ;* . S PXAERR(12)="The Immunization is inactive."
+34 ;* . D ERRSET
+35 ;
+36 ;If Series is input validate it.
+37 ;* I $G(PXAA("SERIES"))'="",'$$SET^PXAIVAL(9000010.11,"SERIES",.04,PXAA("SERIES"),.PXAERR) D Q
+38 ;* . D ERRSET
+39 ;
+40 ;If Reaction is input validate it.
+41 ;* I $G(PXAA("REACTION"))'="",'$$SET^PXAIVAL(9000010.11,"REACTION",.06,PXAA("REACTION"),.PXAERR) D Q
+42 ;* . D ERRSET
+43 ;
+44 ;If Contraindicated is input validate it.
+45 ;* I $G(PXAA("CONTRAINDICATED"))'="",'$$SET^PXAIVAL(9000010.11,"CONTRAINDICATED",.07,PXAA("CONTRAINDICATED"),.PXAERR) D Q
+46 ;* . D ERRSET
+47 ;
+48 ;If an Override Reason is passed verify it.
+49 ;* I $G(PXAA("OVERRIDE REASON"))'="",'$$TEXT^PXAIVAL("OVERRIDE REASON",PXAA("OVERRIDE REASON"),3,245,.PXAERR) D Q
+50 ;* . D ERRSET
+51 ;
+52 ;If an Ordering Provider is passed verify it is valid.
+53 ;* I $G(PXAA("ORD PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ORD PROVIDER"),"ORD",.PXAA,.PXAERR,PXAVISIT) D Q
+54 ;* . D ERRSET
+55 ;
+56 ;If an Encounter Provider is passed verify it is valid.
+57 ;* I $G(PXAA("ENC PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ENC PROVIDER"),"ENC",.PXAA,.PXAERR,PXAVISIT) D Q
+58 ;* . D ERRSET
+59 ;
+60 ;If Event D/T is input verify it is a valid FileMan date and not a
+61 ;future date.
+62 ;* I $G(PXAA("EVENT D/T"))'="",'$$EVENTDT^PXAIVAL(PXAA("EVENT D/T"),"T",.PXAERR) D Q
+63 ;* . D ERRSET
+64 ;
+65 ;If a Comment is passed verify it.
+66 ;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245,.PXAERR) D Q
+67 ;* . D ERRSET
+68 ;
+69 ;If PKG is input verify it.
+70 ;* I $G(PXAA("PKG"))'="" D
+71 ;* . N PKG
+72 ;* . S PKG=$$VPKG^PXAIVAL(PXAA("PKG"),.PXAERR)
+73 ;* . I PKG=0 S PXAERR(9)="PKG" D ERRSET Q
+74 ;* . S PXAA("PKG")=PKG
+75 ;* I $G(STOP)=1 Q
+76 ;
+77 ;If SOURCE is input verify it.
+78 ;* I $G(PXAA("SOURCE"))'="" D
+79 ;* . N SRC
+80 ;* . S SRC=$$VSOURCE^PXAIVAL(PXAA("SOURCE"),.PXAERR)
+81 ;* . I SRC=0 S PXAERR(9)="SOURCE" D ERRSET Q
+82 ;* . S PXAA("SOURCE")=SRC
+83 ;* I $G(STOP)=1 Q
+84 ;
+85 ;If Lot Num is input validate it.
+86 ;* I $G(PXAA("LOT NUM"))'="",'$D(^AUTTIML(PXAA("LOT NUM"),0)) D Q
+87 ;* . S PXAERR(9)="LOT NUM"
+88 ;* . S PXAERR(11)=PXAA("LOT NUM")
+89 ;* . S PXAERR(12)=PXAA("LOT NUM")_" is not a valid pointer to the Immunization Lot file #9999999.41."
+90 ;* . D ERRSET
+91 ;
+92 ;If Info Source is input validate it.
+93 ;* I $G(PXAA("INFO SOURCE"))'="",'$D(^PXV(920.2,PXAA("INFO SOURCE"),0)) D Q
+94 ;* . S PXAERR(9)="INFO SOURCE"
+95 ;* . S PXAERR(11)=PXAA("INFO SOURCE")
+96 ;* . S PXAERR(12)=PXAA("INFO SOURCE")_" is not a valid pointer to the Immunization Info Source file #920.1."
+97 ;* . D ERRSET
+98 ;
+99 ;If Admin Route is input validate it.
+100 ;* I $G(PXAA("ADMIN ROUTE"))'="",'$D(^PXV(920.2,PXAA("ADMIN ROUTE"),0)) D Q
+101 ;* . S PXAERR(9)="ADMIN ROUTE"
+102 ;* . S PXAERR(11)=PXAA("ADMIN ROUTE")
+103 ;* . S PXAERR(12)=PXAA("ADMIN ROUTE")_" is not a valid pointer to the Imm Administration Route file #920.2."
+104 ;* . D ERRSET
+105 ;
+106 ;If Anatomic Loc is input validate it.
+107 ;* I $G(PXAA("ANATOMIC LOC"))'="",'$D(^PXV(920.3,PXAA("ANATOMIC LOC"),0)) D Q
+108 ;* . S PXAERR(9)="ANATOMIC LOC"
+109 ;* . S PXAERR(11)=PXAA("ANATOMIC LOC")
+110 ;* . S PXAERR(12)=PXAA("ANATOMIC LOC")_" is not a valid pointer to the Imm Administration Site file #920.3."
+111 ;* . D ERRSET
+112 ;
+113 ;If Dose is input validate it.
+114 ;* I $G(PXAA("DOSE"))'="",+PXAA("DOSE")'=PXAA("DOSE")!(PXAA("DOSE")>999)!(PXAA("DOSE")<0)!(PXAA("DOSE")?.E1"."3N.N) D Q
+115 ;* . S PXAERR(9)="DOSE"
+116 ;* . S PXAERR(11)=PXAA("DOSE")
+117 ;* . S PXAERR(12)=PXAA("DOSE")_" is not a number between 0 and 999 with 2 fractional digits."
+118 ;* . D ERRSET
+119 ;
+120 ;If Dose Units is input validate it.
+121 ;* I $G(PXAA("DOSE UNITS"))'="" D
+122 ;* . N UNITS
+123 ;* . S UNITS=$$UCUMCODE^LEXMUCUM(PXAA("DOSE UNITS"))
+124 ;* . I $P(UNITS,U,1)="{unit not defined}" D
+125 ;* .. S PXAERR(9)="DOSE UNITS"
+126 ;* .. S PXAERR(11)=PXAA("DOSE UNITS")
+127 ;* .. S PXAERR(12)=PXAA("DOSE UNITS")_" is not a valid pointer to UCUM Codes file #757.5."
+128 ;* .. D ERRSET
+129 ;* I $G(STOP)=1 Q
+130 ;
+131 ;If Vaccine Information Statements are input validate them.
+132 ;* I $D(PXAA("VIS")) D
+133 ;* . N DATE,ERRORD,ERRORV,SEQ,VIS
+134 ;* . S (ERRORD,ERRORV,SEQ)=0
+135 ;* . F S SEQ=+$O(PXAA("VIS",SEQ)) Q:SEQ=0 D
+136 ;* .. S VIS=$P(PXAA("VIS",SEQ,0),U,1)
+137 ;* .. I VIS="@" Q
+138 ;* .. I VIS="" S ERRORV=1,PXAERR(12)="SEQ #"_SEQ_": The Vaccine Information Statement pointer is null."
+139 ;* .. 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."
+140 ;* .. S DATE=$P(PXAA("VIS",SEQ,0),U,2)
+141 ;* .. I DATE="" S ERRORD=1,PXAERR(13)="SEQ #"_SEQ_": Date Offered/Given is null."
+142 ;* .. I (ERRORD=0),($$VFMDATE^PXDATE(DATE,"PX")=-1) S ERRORD=1,PXAERR(13)="SEQ #"_SEQ_": "_DATE_" is not a valid Date Offered/Given."
+143 ;* .. 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."
+144 ;* . I (ERRORD=1)!(ERRORV=1) S PXAERR(9)="VIS" D ERRSET
+145 ;* I $G(STOP)=1 Q
+146 ;
+147 ;Remarks is word-processing, no validation required.
+148 ;
+149 ;Check for diagnosis input and return a warning.
+150 ;* N DIAGNUM,DIAGSTR,NDIAG
+151 ;* S NDIAG=0
+152 ;* F DIAGNUM=1:1:8 D
+153 ;* . S DIAGSTR="DIAGNOSIS"_$S(DIAGNUM>1:" "_DIAGNUM,1:"")
+154 ;* . I $G(PXAA(DIAGSTR))]"" S NDIAG=NDIAG+1
+155 ;* I NDIAG>0 D
+156 ;* . S PXADI("DIALOG")=8390001.002
+157 ;* . S PXAERRW("IMM")=1
+158 ;* . S PXAERR(9)="DIAGNOSIS"
+159 ;* . S PXAERR(12)="As of patch PX*1*211 diagnoses cannot be stored in V IMMUNIZATION."
+160 ;* Q
+161 ;
+162 ; Validate VIMM 2.0 fields
+163 NEW PXFLD,PXFLDNAME,PXFLDNUM,PXVAL,PXFILE,PXOK,PXNEWVAL,PXSEQ,PXVIS
+164 ;
+165 FOR PXFLD="SERIES^.04","LOT NUM^1207","INFO SOURCE^1301","ADMIN ROUTE^1302","ANATOMIC LOC^1303","ORD PROVIDER^1202","DOSE UNITS^1313"
Begin DoDot:1
+166 ;
+167 SET PXFLDNAME=$PIECE(PXFLD,"^",1)
+168 SET PXFLDNUM=$PIECE(PXFLD,"^",2)
+169 ;
+170 SET PXVAL=$GET(PXAA(PXFLDNAME))
+171 IF PXVAL=""
QUIT
+172 ;
+173 SET PXFILE=9000010.11
+174 SET PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
+175 IF PXOK
Begin DoDot:2
+176 SET PXNEWVAL=$PIECE(PXOK,"^",2)
+177 IF PXNEWVAL'=""
SET PXAA(PXFLDNAME)=PXNEWVAL
End DoDot:2
+178 IF 'PXOK
Begin DoDot:2
+179 DO ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
+180 ; Don't file this field, as it's invalid
KILL PXAA(PXFLDNAME)
End DoDot:2
End DoDot:1
+181 ;
+182 ; Check VIS Multiple
+183 SET PXFLDNAME="VIS"
+184 SET PXFLDNUM=.01
+185 ;
+186 IF $GET(PXAA(PXFLDNAME))="@"
QUIT
+187 ;
+188 SET PXSEQ=0
+189 FOR
SET PXSEQ=$ORDER(PXAA(PXFLDNAME,PXSEQ))
if 'PXSEQ
QUIT
Begin DoDot:1
+190 ;
+191 SET PXVAL=$PIECE($GET(PXAA(PXFLDNAME,PXSEQ,0)),U,1)
+192 IF PXVAL=""
KILL PXAA(PXFLDNAME,PXSEQ)
QUIT
+193 ;
+194 SET PXFILE=9000010.112
+195 SET PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
+196 IF 'PXOK
Begin DoDot:2
+197 DO ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
+198 ; Don't file this field, as it's invalid
KILL PXAA(PXFLDNAME,PXSEQ)
End DoDot:2
End DoDot:1
+199 ;
+200 QUIT
+201 ;
VALFLD(PXFILE,PXFLDNUM,PXVAL) ;
+1 ;
+2 ; Validate field and return:
+3 ;
+4 ; 1 - Field is valid
+5 ; 1^X - Field is valid, but was external value.
+6 ; The function will return the internal
+7 ; value in the 2nd piece (X).
+8 ; 0 - Field is invalid
+9 ;
+10 NEW PXOK,PXEXT,PXCODES,PXI,PXX,PXCODE,PXCODEVAL,PXTEMP
+11 ;
+12 SET PXOK=1
+13 ;
+14 IF PXVAL="@"
QUIT PXOK
+15 ;
+16 ;using this to get around input transform
SET PXEXT=$$EXTERNAL^DILFD(PXFILE,PXFLDNUM,,PXVAL,"PXERR")
+17 IF PXFILE=9000010.11
IF PXFLDNUM=1313
Begin DoDot:1
+18 NEW PXRSLT,PXERR
+19 DO CHK^DIE(PXFILE,PXFLDNUM,"E","`"_PXVAL,.PXRSLT,"PXERR")
+20 SET PXEXT=$GET(PXRSLT(0))
+21 IF $GET(PXRSLT)="^"
SET PXEXT=""
End DoDot:1
+22 SET PXOK=(PXEXT'="")
+23 ;
+24 ; If value is not valid, and field is set-of-codes,
+25 ; check to see if external value was passed in.
+26 ; If that was the case, set PXOK to 1,
+27 ; and return internal value in 2nd piece of PXOK
+28 IF 'PXOK
IF ($$GET1^DID(PXFILE,PXFLDNUM,,"TYPE",,"PXERR")="SET")
Begin DoDot:1
+29 SET PXCODES=$$GET1^DID(PXFILE,PXFLDNUM,,"POINTER",,"PXERR")
+30 FOR PXI=1:1:$LENGTH(PXCODES,";")
Begin DoDot:2
+31 SET PXX=$PIECE(PXCODES,";",PXI)
+32 SET PXCODE=$PIECE(PXX,":",1)
+33 SET PXCODEVAL=$PIECE(PXX,":",2)
+34 IF PXCODE=""!(PXCODEVAL="")
QUIT
+35 SET PXTEMP(PXCODEVAL)=PXCODE
End DoDot:2
+36 SET PXCODE=$GET(PXTEMP(PXVAL))
+37 IF PXCODE'=""
SET PXOK="1^"_PXCODE
End DoDot:1
+38 ;
+39 QUIT PXOK
+40 ;
ERRMSG(PXDLG,PXSTOP,PXVAL,PXFLDNAME) ;
+1 SET STOP=$GET(PXSTOP,0)
+2 SET PXAERRF("IMM")=1
+3 SET PXADI("DIALOG")=$GET(PXDLG,"8390001.002")
+4 IF $GET(PXAERR(9))'=""
Begin DoDot:1
+5 SET PXAERR(9)=PXAERR(9)_", "
+6 SET PXAERR(11)=PXAERR(11)_", "
+7 SET PXAERR(12)=PXAERR(12)_" "
End DoDot:1
+8 SET PXAERR(9)=$GET(PXAERR(9))_PXFLDNAME
+9 SET PXAERR(11)=$GET(PXAERR(11))_PXVAL
+10 SET PXAERR(12)=$GET(PXAERR(12))_"'"_PXVAL_"' is not a valid value for field "_PXFLDNAME_"."
+11 QUIT
+12 ;
