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

PXAISKV.m

Go to the documentation of this file. 
  1. PXAISKV ;ISL/PKR - VALIDATE SKIN TEST DATA ;Nov 27, 2020@13:06:12
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**199,211,217**;Aug 12, 1996;Build 134
  1.  ;
  1. ERRSET ;Set the rest of the error data.
  1.  S STOP=1
  1.  S PXAERRF("SK")=1
  1.  S PXADI("DIALOG")=8390001.001
  1.  S PXAERR(7)="SKIN TEST"
  1.  Q
  1.  ;
  1. VAL ;Validate the input data.
  1.  I '$D(PXAA("TEST")) D  Q
  1.  . S PXAERR(9)="SKIN TEST"
  1.  . S PXAERR(12)="You are missing the name of the Skin Test."
  1.  . D ERRSET
  1.  ;
  1.  I $G(PXAA("DELETE"))=1 D  Q
  1.  . N PXAIEN
  1.  . ;Check to see if there is a skin test reading linked to this entry
  1.  . S PXAIEN=+$$GETIEN^PXAISK(PXAVISIT,PXAA("TEST"))
  1.  . I '$D(^AUPNVSK("APT",PXAIEN)) Q
  1.  . S PXAERR(9)="SKIN TEST"
  1.  . S PXAERR(11)=$G(PXAA("TEST"))
  1.  . S PXAERR(12)="There is a skin test reading linked to this entry; "
  1.  . S PXAERR(12)=PXAERR(12)_"you must first delete the skin test reading entry (#"
  1.  . S PXAERR(12)=PXAERR(12)_$O(^AUPNVSK("APT",PXAIEN,0))_") before deleting this placement entry"
  1.  . D ERRSET
  1.  ;
  1.  ; if passing in placement entry, make sure the skin test and patient are the same
  1.  I $G(PXAA("PLACEMENT")) D  Q:$G(STOP)=1
  1.  . I PXAA("TEST")=$P($G(^AUPNVSK(PXAA("PLACEMENT"),0)),U,1) Q
  1.  . I $G(PATIENT)=$P($G(^AUPNVSK(PXAA("PLACEMENT"),0)),U,2) Q
  1.  . S PXAERR(9)="SKIN TEST"
  1.  . S PXAERR(11)=$G(PXAA("TEST"))
  1.  . S PXAERR(12)="The placement entry is for a different skin test"
  1.  ;
  1.  I '$D(^AUTTSK(PXAA("TEST"))) D  Q
  1.  . S PXAERR(9)="SKIN TEST"
  1.  . S PXAERR(11)=PXAA("TEST")
  1.  . S PXAERR(12)="The Skin Test pointer is not valid."
  1.  . D ERRSET
  1.  ;
  1.  N TEMP S TEMP=$G(^AUTTSK(PXAA("TEST"),0))
  1.  ;Check that the .01 is not null.
  1.  I $P(TEMP,U,1)="" D  Q
  1.  . S PXAERR(9)="SKIN TEST"
  1.  . S PXAERR(11)=PXAA("TEST")
  1.  . S PXAERR(12)="The Skin Test does not have a .01."
  1.  . D ERRSET
  1.  ;
  1.  ;Check that the test is active.
  1.  ;* I $P(TEMP,U,3)=1 D  Q
  1.  ;* . S PXAERR(9)="SKIN TEST"
  1.  ;* . S PXAERR(11)=PXAA("TEST")
  1.  ;* . S PXAERR(12)="The Skin Test is inactive."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If a Reading is input validate it.
  1.  ;* I $G(PXAA("READING"))'="",(+PXAA("READING")'=PXAA("READING")!(PXAA("READING")>40)!(PXAA("READING")<0)!(PXAA("READING")?.E1"."1N.N)) D  Q
  1.  ;* . S PXAERR(9)="READING"
  1.  ;* . S PXAERR(12)=+PXAA("READING")_" is not a whole number between 0 and 40."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If a Result is input validate it.
  1.  ;* I $G(PXAA("RESULT"))'="",'$$SET^PXAIVAL(9000010.12,"RESULT",.04,PXAA("RESULT"),.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If D/T Read is input verify it is a valid FileMan date .
  1.  ;* I $G(PXAA("D/T READ"))'="",'$$DATETIME^PXAIVAL("D/T READ",PXAA("D/T READ"),"T",.PXAERR) D  Q
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If D/T Read is input verify it is not a future date.
  1.  ;* I $G(PXAA("D/T READ"))'="",$$FUTURE^PXDATE(PXAA("D/T READ")) D  Q
  1.  ;* . S PXAERR(9)="D/T READ"
  1.  ;* . S PXAERR(11)=PXAA("D/T READ")
  1.  ;* . S PXAERR(12)=+PXAA("D/T READ")_" is a future date."
  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.  ;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 an Anatomic Location is passed verify it is valid.
  1.  ;* I $G(PXAA("ANATOMIC LOC"))'="",'$D(^PXV(920.3,PXAA("ANATOMIC LOC"),0)) D  Q
  1.  ;* . S PXAERR(9)="ANATOMIC LOC"
  1.  ;* . S PXAERR(11)=PXAA("ANATOMIC LOC")
  1.  ;* . S PXAERR(12)=PXAA("ANATOMIC LOC")_" is a not a valid pointer to the Imm Administration Site file."
  1.  ;* . D ERRSET
  1.  ;
  1.  ;If a Reading Comment is passed verify it.
  1.  ;* I $G(PXAA("READING COMMENT"))'="",'$$TEXT^PXAIVAL("READING COMMENT",PXAA("READING COMMENT"),1,245,.PXAERR) D  Q
  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 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.  ;* I $G(STOP)=1 Q
  1.  ;
  1.  ;Check for diagnosis input and return a warning.
  1.  ;* N DIAGSTR,DIAGNUM,NDIAG
  1.  ;* S NDIAG=0
  1.  ;* F DIAGNUM=1:1:8 D
  1.  ;* . S DIAGSTR="DIAGNOSIS"_$S(DIAGNUM>1:" "_DIAGNUM,1:"")
  1.  ;* . I $G(PXAA(DIAGSTR))]"" S NDIAG=NDIAG+1
  1.  ;* I NDIAG>0 D  Q
  1.  ;* . S PXADI("DIALOG")=8390001.002
  1.  ;* . S PXAERRW("SK")=1
  1.  ;* . S PXAERR(9)="DIAGNOSIS"
  1.  ;* . S PXAERR(12)="As of patch PX*1*211 diagnoses cannot be stored in V SKIN TEST."
  1.  Q
  1.  ;