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

PXAIICRV.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. VAL ;Make sure the required fields are present.
  1. ;
  1. N PXFLD,PXFLDNAME,PXFLDNUM,PXFILE,PXOK,PXVAL,PXFLGERR
  1. ;
  1. S PXFILE=9000010.707
  1. ;
  1. ; Validate Required fields
  1. F PXFLD="CONTRA/REFUSAL^.01","IMMUN^.04" D Q:$G(STOP)=1
  1. . S PXFLDNAME=$P(PXFLD,"^",1)
  1. . S PXFLDNUM=$P(PXFLD,"^",2)
  1. . S PXVAL=$G(PXAA(PXFLDNAME))
  1. . I PXVAL="" D Q:$G(STOP)=1
  1. . . S STOP=1
  1. . . S PXAERRF("ICR")=1
  1. . . S PXADI("DIALOG")=8390001.001
  1. . . S PXAERR(9)=PXFLDNAME
  1. . . S PXAERR(10)="AFTER"
  1. . . S PXAERR(11)=$G(PXAA(PXFLDNAME))
  1. . . S PXAERR(12)="You are missing the required field: "_PXFLDNAME
  1. . ;
  1. . I $G(STOP)=1 Q
  1. . ;
  1. . S PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
  1. . I 'PXOK D ERRMSG(8390001.001,1,PXVAL,PXFLDNAME)
  1. . ;
  1. . I ($G(STOP)=1)!(PXFLDNUM'=.04) Q
  1. . ;
  1. . I '$$IMMCRSEL^PXVUTIL(PXAA("CONTRA/REFUSAL"),PXAA("IMMUN")) D
  1. . . S STOP=1
  1. . . S PXAERRF("ICR")=1
  1. . . S PXADI("DIALOG")=8390001.001
  1. . . S PXAERR(9)=PXFLDNAME
  1. . . S PXAERR(10)="AFTER"
  1. . . S PXAERR(11)=PXAA("IMMUN")
  1. . . S PXAERR(12)="IMMUNIZATION #"_PXAA("IMMUN")_" is NOT selectable for this "_$S(PXAA("CONTRA/REFUSAL")[920.4:"Contraindication",1:"Refusal")_" Reason"
  1. ;
  1. I $G(STOP)=1 Q
  1. I $G(PXAA("DELETE"))=1 Q ; don't bother checking optional fields if this is a deletion
  1. ;
  1. ; Validate optional fields
  1. F PXFLD="WARN UNTIL DATE^.05^1","EVENT D/T^1201^0","ENC PROVIDER^1204^0" D Q:$G(STOP)=1
  1. . ;
  1. . S PXFLDNAME=$P(PXFLD,"^",1)
  1. . S PXFLDNUM=$P(PXFLD,"^",2)
  1. . S PXFLGERR=$P(PXFLD,"^",3) ; if validation fails, flag this is as error (1) or warning (0)
  1. . ;
  1. . S PXVAL=$G(PXAA(PXFLDNAME))
  1. . I PXVAL="" Q
  1. . ;
  1. . S PXOK=$$VALFLD(PXFILE,PXFLDNUM,PXVAL)
  1. . I 'PXOK D
  1. . . I PXFLGERR D ERRMSG(8390001.001,1,PXVAL,PXFLDNAME)
  1. . . I 'PXFLGERR D ERRMSG(8390001.002,0,PXVAL,PXFLDNAME)
  1. . . I $G(STOP)=1 Q
  1. . . K PXAA(PXFLDNAME) ; 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. ; 0 - Field is invalid
  1. ;
  1. N PXOK,PXEXT,PXFLDTYP,PXRSLT,PXERR
  1. ;
  1. S PXOK=1
  1. ;
  1. I PXVAL="@" Q PXOK
  1. ;
  1. S PXFLDTYP=$$GET1^DID(PXFILE,PXFLDNUM,,"TYPE",,"PXERR")
  1. I PXFLDNUM=.01,PXFLDTYP="VARIABLE-POINTER" D
  1. . I PXVAL[920.4 S PXVAL="C.`"_(+PXVAL)
  1. . I PXVAL[920.5 S PXVAL="R.`"_(+PXVAL)
  1. I PXFLDTYP="POINTER" D
  1. . S PXVAL="`"_PXVAL
  1. ;
  1. S PXEXT=""
  1. D CHK^DIE(PXFILE,PXFLDNUM,"",PXVAL,.PXRSLT,"PXERR")
  1. I $G(PXRSLT)="^" S PXOK=0
  1. ;
  1. Q PXOK
  1. ;
  1. ERRMSG(PXDLG,PXSTOP,PXVAL,PXFLDNAME) ;
  1. ;
  1. S STOP=$G(PXSTOP,0)
  1. S PXAERRF("ICR")=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. ;
  1. Q