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

PXAISCV.m

Go to the documentation of this file. 
  1. PXAISCV ;SLC/PKR - Validate a Standard Code entry. ;10/05/2020
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
  1.  ;
  1. ERRSET ;Set the rest of the error data.
  1.  S STOP=1
  1.  S PXAERRF("SC")=1
  1.  S PXAERR(7)="STD CODES"
  1.  S PXADI("DIALOG")=8390001.001
  1.  Q
  1.  ;
  1. VAL ;Validate the input data.
  1.  I $G(PXAA("CODE"))="" D  Q
  1.  . S PXAERR(9)="CODE"
  1.  . S PXAERR(12)="The Code is missing."
  1.  . D ERRSET
  1.  ;
  1.  I $G(PXAA("CODING SYSTEM"))="" D  Q
  1.  . S PXAERR(9)="CODING SYSTEM"
  1.  . S PXAERR(12)="The Coding System is missing."
  1.  . D ERRSET
  1.  ;
  1.  ;If this is a deletion no further verification is required.
  1.  I $G(PXAA("DELETE"))=1 Q
  1.  ;
  1.  ;Is the coding system valid?
  1.  N CODESYSL
  1.  D CODESYSL^PXLEX(.CODESYSL,0)
  1.  I '$D(CODESYSL(PXAA("CODING SYSTEM"))) D  Q
  1.  . S PXAERR(9)="CODING SYSTEM"
  1.  . S PXAERR(12)="The "_PXAA("CODING SYSTEM")_" coding system is not supported for V STANDARD CODES."
  1.  . D ERRSET
  1.  ;
  1.  ;Is the coding system, code pair valid?
  1.  I '$$VCODE^PXLEX(PXAA("CODING SYSTEM"),PXAA("CODE")) D  Q
  1.  . S PXAERR(9)="CODING SYSTEM"
  1.  . S PXAERR(11)=PXAA("CODING SYSTEM")_U_PXAA("CODE")
  1.  . S PXAERR(12)="Invalid code for the coding system."
  1.  . D ERRSET
  1.  ;
  1.  ;If Event D/T is input verify it is a valid FileMan date and not in
  1.  ;the future.
  1.  ;* I $G(PXAA("EVENT D/T"))'="",'$$EVENTDT^PXAIVAL(PXAA("EVENT D/T"),"T",.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;Is the code active on the date of interest?
  1.  ;* N EVENTDT,SERVCAT,TEMP
  1.  ;* S TEMP=^AUPNVSIT(PXAVISIT,0)
  1.  ;* S SERVCAT=$P(TEMP,U,7)
  1.  ;For historical encounters use the Date the Visit was created.
  1.  ;* S EVENTDT=$S(SERVCAT="E":$P(TEMP,U,2),$G(PXAA("EVENT D/T"))'="":PXAA("EVENT D/T"),1:$P(TEMP,U,1))
  1.  ;* I '$$ISCACT^PXLEX(PXAA("CODING SYSTEM"),PXAA("CODE"),EVENTDT) D  Q
  1.  ;* . S PXAERR(9)="CODE NOT ACTIVE"
  1.  ;* . S PXAERR(11)=PXAA("CODING SYSTEM")_U_PXAA("CODE")_U_EVENTDT
  1.  ;* . S PXAERR(12)="The code was not active on "_$$FMTE^XLFDT(EVENTDT,"5Z")_"."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If a Comment is passed verify it.
  1.  ;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245,.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If an Ordering Provider is passed verify it is valid.
  1.  ;* I $G(PXAA("ORD PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ORD PROVIDER"),"ORD",.PXAA,.PXAERR,PXAVISIT) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If an Encounter Provider is passed verify it is valid.
  1.  ;* I $G(PXAA("ENC PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ENC PROVIDER"),"ENC",.PXAA,.PXAERR,PXAVISIT) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If a Magnitude is being input verify that it is in the allowed range.
  1.  ;* N MPARAMS
  1.  ;* S MPARAMS=-99999999999999_U_99999999999999_U_10
  1.  ;* I $G(PXAA("MAGNITUDE"))'="",'$$MAG^PXAIVAL(PXAA("MAGNITUDE"),MPARAMS,.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If a UCUM code is being input verify that it is valid.
  1.  ;* I $G(PXAA("UCUM CODE"))'="" D
  1.  ;* . N UCUMCODE
  1.  ;* . S UCUMCODE=$$UCUMCODE^LEXMUCUM(PXAA("UCUM CODE"))
  1.  ;* . I UCUMCODE["unit not defined" D
  1.  ;* .. S PXAERR(9)="UCUM CODE"
  1.  ;* .. S PXAERR(11)=PXAA("UCUM CODE")
  1.  ;* .. S PXAERR(12)=$P(UCUMCODE,U,2)
  1.  ;* .. D ERRSET
  1.  ;* I $G(STOP)=1 Q
  1.  ;
  1.  ;If PKG is input verify it.
  1.  ;* I $G(PXAA("PKG"))'="" D
  1.  ;* . N PKG
  1.  ;* . S PKG=$$VPKG^PXAIVAL(PXAA("PKG"),.PXAERR)
  1.  ;* . I PKG=0 S PXAERR(9)="PKG" D ERRSET Q
  1.  ;* . S PXAA("PKG")=PKG
  1.  ;* I $G(STOP)=1 Q
  1.  ;
  1.  ;If SOURCE is input verify it.
  1.  ;* I $G(PXAA("SOURCE"))'="" D
  1.  ;* . N SRC
  1.  ;* . S SRC=$$VSOURCE^PXAIVAL(PXAA("SOURCE"),.PXAERR)
  1.  ;* . I SRC=0 S PXAERR(9)="SOURCE" D ERRSET Q
  1.  ;* . S PXAA("SOURCE")=SRC
  1.  Q 
  1.  ;