PXAIICRV ;BPFO/LMT - VALIDATE IMM CONTRA/REFUSAL DATA ;10/05/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**215,211**;Aug 12, 1996;Build 454
;
VAL ;Make sure the required fields are present.
;
N PXFLD,PXFLDNAME,PXFLDNUM,PXFILE,PXOK,PXVAL,PXFLGERR
;
S PXFILE=9000010.707
;
; Validate Required fields
F PXFLD="CONTRA/REFUSAL^.01","IMMUN^.04" D Q:$G(STOP)=1
. S PXFLDNAME=$P(PXFLD,"^",1)
. S PXFLDNUM=$P(PXFLD,"^",2)
. S PXVAL=$G(PXAA(PXFLDNAME))
. I PXVAL="" D Q:$G(STOP)=1
. . S STOP=1
. . S PXAERRF("ICR")=1
. . S PXADI("DIALOG")=8390001.001
. . S PXAERR(9)=PXFLDNAME
. . S PXAERR(10)="AFTER"
. . S PXAERR(11)=$G(PXAA(PXFLDNAME))
. . S PXAERR(12)="You are missing the required field: "_PXFLDNAME
. ;
. I $G(STOP)=1 Q
. ;
. S PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
. I 'PXOK D ERRMSG(8390001.001,1,PXVAL,PXFLDNAME)
. ;
. I ($G(STOP)=1)!(PXFLDNUM'=.04) Q
. ;
. I '$$IMMCRSEL^PXVUTIL(PXAA("CONTRA/REFUSAL"),PXAA("IMMUN")) D
. . S STOP=1
. . S PXAERRF("ICR")=1
. . S PXADI("DIALOG")=8390001.001
. . S PXAERR(9)=PXFLDNAME
. . S PXAERR(10)="AFTER"
. . S PXAERR(11)=PXAA("IMMUN")
. . S PXAERR(12)="IMMUNIZATION #"_PXAA("IMMUN")_" is NOT selectable for this "_$S(PXAA("CONTRA/REFUSAL")[920.4:"Contraindication",1:"Refusal")_" Reason"
;
I $G(STOP)=1 Q
I $G(PXAA("DELETE"))=1 Q ; don't bother checking optional fields if this is a deletion
;
; Validate optional fields
F PXFLD="WARN UNTIL DATE^.05^1","EVENT D/T^1201^0","ENC PROVIDER^1204^0" D Q:$G(STOP)=1
. ;
. S PXFLDNAME=$P(PXFLD,"^",1)
. S PXFLDNUM=$P(PXFLD,"^",2)
. S PXFLGERR=$P(PXFLD,"^",3) ; if validation fails, flag this is as error (1) or warning (0)
. ;
. S PXVAL=$G(PXAA(PXFLDNAME))
. I PXVAL="" Q
. ;
. S PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
. I 'PXOK D
. . I PXFLGERR D ERRMSG(8390001.001,1,PXVAL,PXFLDNAME)
. . I 'PXFLGERR D ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
. . I $G(STOP)=1 Q
. . K PXAA(PXFLDNAME) ; Don't file this field, as it's invalid
;
Q
;
VALFLD(PXFILE,PXFLDNUM,PXVAL) ;
;
; Validate field and return:
;
; 1 - Field is valid
; 0 - Field is invalid
;
N PXOK,PXEXT,PXFLDTYP,PXRSLT,PXERR
;
S PXOK=1
;
I PXVAL="@" Q PXOK
;
S PXFLDTYP=$$GET1^DID(PXFILE,PXFLDNUM,,"TYPE",,"PXERR")
I PXFLDNUM=.01,PXFLDTYP="VARIABLE-POINTER" D
. I PXVAL[920.4 S PXVAL="C.`"_(+PXVAL)
. I PXVAL[920.5 S PXVAL="R.`"_(+PXVAL)
I PXFLDTYP="POINTER" D
. S PXVAL="`"_PXVAL
;
S PXEXT=""
D CHK^DIE(PXFILE,PXFLDNUM,"",PXVAL,.PXRSLT,"PXERR")
I $G(PXRSLT)="^" S PXOK=0
;
Q PXOK
;
ERRMSG(PXDLG,PXSTOP,PXVAL,PXFLDNAME) ;
;
S STOP=$G(PXSTOP,0)
S PXAERRF("ICR")=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[HPXAIICRV 3011 printed Oct 16, 2024@18:26:33 Page 2
PXAIICRV ;BPFO/LMT - VALIDATE IMM CONTRA/REFUSAL DATA ;10/05/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215,211**;Aug 12, 1996;Build 454
+2 ;
VAL ;Make sure the required fields are present.
+1 ;
+2 NEW PXFLD,PXFLDNAME,PXFLDNUM,PXFILE,PXOK,PXVAL,PXFLGERR
+3 ;
+4 SET PXFILE=9000010.707
+5 ;
+6 ; Validate Required fields
+7 FOR PXFLD="CONTRA/REFUSAL^.01","IMMUN^.04"
Begin DoDot:1
+8 SET PXFLDNAME=$PIECE(PXFLD,"^",1)
+9 SET PXFLDNUM=$PIECE(PXFLD,"^",2)
+10 SET PXVAL=$GET(PXAA(PXFLDNAME))
+11 IF PXVAL=""
Begin DoDot:2
+12 SET STOP=1
+13 SET PXAERRF("ICR")=1
+14 SET PXADI("DIALOG")=8390001.001
+15 SET PXAERR(9)=PXFLDNAME
+16 SET PXAERR(10)="AFTER"
+17 SET PXAERR(11)=$GET(PXAA(PXFLDNAME))
+18 SET PXAERR(12)="You are missing the required field: "_PXFLDNAME
End DoDot:2
if $GET(STOP)=1
QUIT
+19 ;
+20 IF $GET(STOP)=1
QUIT
+21 ;
+22 SET PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
+23 IF 'PXOK
DO ERRMSG(8390001.001,1,PXVAL,PXFLDNAME)
+24 ;
+25 IF ($GET(STOP)=1)!(PXFLDNUM'=.04)
QUIT
+26 ;
+27 IF '$$IMMCRSEL^PXVUTIL(PXAA("CONTRA/REFUSAL"),PXAA("IMMUN"))
Begin DoDot:2
+28 SET STOP=1
+29 SET PXAERRF("ICR")=1
+30 SET PXADI("DIALOG")=8390001.001
+31 SET PXAERR(9)=PXFLDNAME
+32 SET PXAERR(10)="AFTER"
+33 SET PXAERR(11)=PXAA("IMMUN")
+34 SET PXAERR(12)="IMMUNIZATION #"_PXAA("IMMUN")_" is NOT selectable for this "_$SELECT(PXAA("CONTRA/REFUSAL")[920.4:"Contraindication",1:"Refusal")_" Reason"
End DoDot:2
End DoDot:1
if $GET(STOP)=1
QUIT
+35 ;
+36 IF $GET(STOP)=1
QUIT
+37 ; don't bother checking optional fields if this is a deletion
IF $GET(PXAA("DELETE"))=1
QUIT
+38 ;
+39 ; Validate optional fields
+40 FOR PXFLD="WARN UNTIL DATE^.05^1","EVENT D/T^1201^0","ENC PROVIDER^1204^0"
Begin DoDot:1
+41 ;
+42 SET PXFLDNAME=$PIECE(PXFLD,"^",1)
+43 SET PXFLDNUM=$PIECE(PXFLD,"^",2)
+44 ; if validation fails, flag this is as error (1) or warning (0)
SET PXFLGERR=$PIECE(PXFLD,"^",3)
+45 ;
+46 SET PXVAL=$GET(PXAA(PXFLDNAME))
+47 IF PXVAL=""
QUIT
+48 ;
+49 SET PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
+50 IF 'PXOK
Begin DoDot:2
+51 IF PXFLGERR
DO ERRMSG(8390001.001,1,PXVAL,PXFLDNAME)
+52 IF 'PXFLGERR
DO ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
+53 IF $GET(STOP)=1
QUIT
+54 ; Don't file this field, as it's invalid
KILL PXAA(PXFLDNAME)
End DoDot:2
End DoDot:1
if $GET(STOP)=1
QUIT
+55 ;
+56 QUIT
+57 ;
VALFLD(PXFILE,PXFLDNUM,PXVAL) ;
+1 ;
+2 ; Validate field and return:
+3 ;
+4 ; 1 - Field is valid
+5 ; 0 - Field is invalid
+6 ;
+7 NEW PXOK,PXEXT,PXFLDTYP,PXRSLT,PXERR
+8 ;
+9 SET PXOK=1
+10 ;
+11 IF PXVAL="@"
QUIT PXOK
+12 ;
+13 SET PXFLDTYP=$$GET1^DID(PXFILE,PXFLDNUM,,"TYPE",,"PXERR")
+14 IF PXFLDNUM=.01
IF PXFLDTYP="VARIABLE-POINTER"
Begin DoDot:1
+15 IF PXVAL[920.4
SET PXVAL="C.`"_(+PXVAL)
+16 IF PXVAL[920.5
SET PXVAL="R.`"_(+PXVAL)
End DoDot:1
+17 IF PXFLDTYP="POINTER"
Begin DoDot:1
+18 SET PXVAL="`"_PXVAL
End DoDot:1
+19 ;
+20 SET PXEXT=""
+21 DO CHK^DIE(PXFILE,PXFLDNUM,"",PXVAL,.PXRSLT,"PXERR")
+22 IF $GET(PXRSLT)="^"
SET PXOK=0
+23 ;
+24 QUIT PXOK
+25 ;
ERRMSG(PXDLG,PXSTOP,PXVAL,PXFLDNAME) ;
+1 ;
+2 SET STOP=$GET(PXSTOP,0)
+3 SET PXAERRF("ICR")=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
