- 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 Jan 18, 2025@03:26:51 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