PXAIIMMV ;ISL/PKR - VALIDATE IMMUNIZATION DATA ;09/16/15 22:10
;;1.0;PCE PATIENT CARE ENCOUNTER;**199,209,210**;Aug 12, 1996;Build 21
;
VAL ;Make sure the required field is present.
I '$D(PXAA("IMMUN")) D Q:$G(STOP)=1
. S STOP=1
. S PXAERRF=1
. S PXADI("DIALOG")=8390001.001
. S PXAERR(9)="IMMUNIZATION"
. S PXAERR(10)="AFTER"
. S PXAERR(11)=$G(PXAA("IMMUNIZATION"))
. S PXAERR(12)="You are missing the name of the immunization"
Q:$G(PXAA("DELETE"))=1 ; don't bother checking diagnoses if this is a deletion
; confirm valid diagnosis pointers
N DIAGNUM,DIAGSTR,ICDDATA,PXDXDATE
S PXDXDATE=$$CSDATE^PXDXUTL(PXAVISIT)
F DIAGNUM=1:1:8 D Q:$G(STOP)=1
. S DIAGSTR="DIAGNOSIS"_$S(DIAGNUM>1:" "_DIAGNUM,1:"")
. I $G(PXAA(DIAGSTR))]"" D
.. S ICDDATA=$$ICDDATA^ICDXCODE("DIAG",$G(PXAA(DIAGSTR)),PXDXDATE,"I")
.. I $P(ICDDATA,"^",1)'>0 D Q:$G(STOP)=1
... S STOP=1
... S PXAERRF=1
... S PXADI("DIALOG")=8390001.001
... S PXAERR(9)="IMMUNIZATION"
... S PXAERR(10)="AFTER"
... S PXAERR(11)=$G(PXAA(DIAGSTR))
... S PXAERR(12)="IMMUNIZATION DIAGNOSIS #"_DIAGNUM_" ("_PXAERR(11)_") is NOT a valid pointer value to the ICD DIAGNOSIS FILE #80"
.. I $P(ICDDATA,"^",10)'=1 D Q:$G(STOP)=1
... S STOP=1
... S PXAERRF=1
... S PXADI("DIALOG")=8390001.001
... S PXAERR(9)="IMMUNIZATION"
... S PXAERR(10)="AFTER"
... S PXAERR(11)=$G(PXAA(DIAGSTR))
... S PXAERR(12)="IMMUNIZATION DIAGNOSIS #"_DIAGNUM_" ("_PXAERR(11)_") is NOT an Active ICD code"
;
; PX*210
; For entries from VLER (where CVX codes was passed in to PX SAVE DATA),
; check that Immunnization is selectable (i.e., active, or inactive-but-selectable-for-historic)
N PXSRCIENS
S PXSRCIENS=(+$G(^TMP("PXK",$J,"SOR")))_","
I $$GET1^DIQ(839.7,PXSRCIENS,.01)="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=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"
;
; 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=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 4977 printed Jan 14, 2021@17:20:24 Page 2
PXAIIMMV ;ISL/PKR - VALIDATE IMMUNIZATION DATA ;09/16/15 22:10
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**199,209,210**;Aug 12, 1996;Build 21
+2 ;
VAL ;Make sure the required field is present.
+1 IF '$DATA(PXAA("IMMUN"))
Begin DoDot:1
+2 SET STOP=1
+3 SET PXAERRF=1
+4 SET PXADI("DIALOG")=8390001.001
+5 SET PXAERR(9)="IMMUNIZATION"
+6 SET PXAERR(10)="AFTER"
+7 SET PXAERR(11)=$GET(PXAA("IMMUNIZATION"))
+8 SET PXAERR(12)="You are missing the name of the immunization"
End DoDot:1
if $GET(STOP)=1
QUIT
+9 ; don't bother checking diagnoses if this is a deletion
if $GET(PXAA("DELETE"))=1
QUIT
+10 ; confirm valid diagnosis pointers
+11 NEW DIAGNUM,DIAGSTR,ICDDATA,PXDXDATE
+12 SET PXDXDATE=$$CSDATE^PXDXUTL(PXAVISIT)
+13 FOR DIAGNUM=1:1:8
Begin DoDot:1
+14 SET DIAGSTR="DIAGNOSIS"_$SELECT(DIAGNUM>1:" "_DIAGNUM,1:"")
+15 IF $GET(PXAA(DIAGSTR))]""
Begin DoDot:2
+16 SET ICDDATA=$$ICDDATA^ICDXCODE("DIAG",$GET(PXAA(DIAGSTR)),PXDXDATE,"I")
+17 IF $PIECE(ICDDATA,"^",1)'>0
Begin DoDot:3
+18 SET STOP=1
+19 SET PXAERRF=1
+20 SET PXADI("DIALOG")=8390001.001
+21 SET PXAERR(9)="IMMUNIZATION"
+22 SET PXAERR(10)="AFTER"
+23 SET PXAERR(11)=$GET(PXAA(DIAGSTR))
+24 SET PXAERR(12)="IMMUNIZATION DIAGNOSIS #"_DIAGNUM_" ("_PXAERR(11)_") is NOT a valid pointer value to the ICD DIAGNOSIS FILE #80"
End DoDot:3
if $GET(STOP)=1
QUIT
+25 IF $PIECE(ICDDATA,"^",10)'=1
Begin DoDot:3
+26 SET STOP=1
+27 SET PXAERRF=1
+28 SET PXADI("DIALOG")=8390001.001
+29 SET PXAERR(9)="IMMUNIZATION"
+30 SET PXAERR(10)="AFTER"
+31 SET PXAERR(11)=$GET(PXAA(DIAGSTR))
+32 SET PXAERR(12)="IMMUNIZATION DIAGNOSIS #"_DIAGNUM_" ("_PXAERR(11)_") is NOT an Active ICD code"
End DoDot:3
if $GET(STOP)=1
QUIT
End DoDot:2
End DoDot:1
if $GET(STOP)=1
QUIT
+33 ;
+34 ; PX*210
+35 ; For entries from VLER (where CVX codes was passed in to PX SAVE DATA),
+36 ; check that Immunnization is selectable (i.e., active, or inactive-but-selectable-for-historic)
+37 NEW PXSRCIENS
+38 SET PXSRCIENS=(+$GET(^TMP("PXK",$JOB,"SOR")))_","
+39 IF $$GET1^DIQ(839.7,PXSRCIENS,.01)="VLER E-HEALTH EXCHANGE"
IF $GET(PXAA("CVX"))'=""
Begin DoDot:1
+40 IF '$$IMMSEL^PXVUTIL(PXAA("IMMUN"),$GET(PXAVISIT))
Begin DoDot:2
+41 SET STOP=1
+42 SET PXAERRF=1
+43 SET PXADI("DIALOG")=8390001.001
+44 SET PXAERR(9)="IMMUNIZATION"
+45 SET PXAERR(10)="AFTER"
+46 SET PXAERR(11)=PXAA("IMMUN")
+47 SET PXAERR(12)="IMMUNIZATION #"_PXAA("IMMUN")_"is NOT selectable for this encounter"
End DoDot:2
End DoDot:1
if $GET(STOP)=1
QUIT
+48 ;
+49 ; Validate VIMM 2.0 fields
+50 NEW PXFLD,PXFLDNAME,PXFLDNUM,PXVAL,PXFILE,PXOK,PXNEWVAL,PXSEQ,PXVIS
+51 ;
+52 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
+53 ;
+54 SET PXFLDNAME=$PIECE(PXFLD,"^",1)
+55 SET PXFLDNUM=$PIECE(PXFLD,"^",2)
+56 ;
+57 SET PXVAL=$GET(PXAA(PXFLDNAME))
+58 IF PXVAL=""
QUIT
+59 ;
+60 SET PXFILE=9000010.11
+61 SET PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
+62 IF PXOK
Begin DoDot:2
+63 SET PXNEWVAL=$PIECE(PXOK,"^",2)
+64 IF PXNEWVAL'=""
SET PXAA(PXFLDNAME)=PXNEWVAL
End DoDot:2
+65 IF 'PXOK
Begin DoDot:2
+66 DO ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
+67 ; Don't file this field, as it's invalid
KILL PXAA(PXFLDNAME)
End DoDot:2
End DoDot:1
+68 ;
+69 ; Check VIS Multiple
+70 SET PXFLDNAME="VIS"
+71 SET PXFLDNUM=.01
+72 ;
+73 IF $GET(PXAA(PXFLDNAME))="@"
QUIT
+74 ;
+75 SET PXSEQ=0
+76 FOR
SET PXSEQ=$ORDER(PXAA(PXFLDNAME,PXSEQ))
if 'PXSEQ
QUIT
Begin DoDot:1
+77 ;
+78 SET PXVAL=$PIECE($GET(PXAA(PXFLDNAME,PXSEQ,0)),U,1)
+79 IF PXVAL=""
KILL PXAA(PXFLDNAME,PXSEQ)
QUIT
+80 ;
+81 SET PXFILE=9000010.112
+82 SET PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
+83 IF 'PXOK
Begin DoDot:2
+84 DO ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
+85 ; Don't file this field, as it's invalid
KILL PXAA(PXFLDNAME,PXSEQ)
End DoDot:2
End DoDot:1
+86 ;
+87 QUIT
+88 ;
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 ;
+2 SET STOP=$GET(PXSTOP,0)
+3 SET PXAERRF=1
+4 SET PXADI("DIALOG")=$GET(PXDLG,"8390001.002")
+5 IF $GET(PXAERR(9))'=""
Begin DoDot:1
+6 SET PXAERR(9)=PXAERR(9)_", "
+7 SET PXAERR(11)=PXAERR(11)_", "
+8 SET PXAERR(12)=PXAERR(12)_" "
End DoDot:1
+9 SET PXAERR(9)=$GET(PXAERR(9))_PXFLDNAME
+10 SET PXAERR(11)=$GET(PXAERR(11))_PXVAL
+11 SET PXAERR(12)=$GET(PXAERR(12))_"'"_PXVAL_"' is not a valid value for field "_PXFLDNAME_"."
+12 ;
+13 QUIT
