PXAISKV ;ISL/PKR - VALIDATE SKIN TEST DATA ;Nov 27, 2020@13:06:12
;;1.0;PCE PATIENT CARE ENCOUNTER;**199,211,217**;Aug 12, 1996;Build 134
;
ERRSET ;Set the rest of the error data.
S STOP=1
S PXAERRF("SK")=1
S PXADI("DIALOG")=8390001.001
S PXAERR(7)="SKIN TEST"
Q
;
VAL ;Validate the input data.
I '$D(PXAA("TEST")) D Q
. S PXAERR(9)="SKIN TEST"
. S PXAERR(12)="You are missing the name of the Skin Test."
. D ERRSET
;
I $G(PXAA("DELETE"))=1 D Q
. N PXAIEN
. ;Check to see if there is a skin test reading linked to this entry
. S PXAIEN=+$$GETIEN^PXAISK(PXAVISIT,PXAA("TEST"))
. I '$D(^AUPNVSK("APT",PXAIEN)) Q
. S PXAERR(9)="SKIN TEST"
. S PXAERR(11)=$G(PXAA("TEST"))
. S PXAERR(12)="There is a skin test reading linked to this entry; "
. S PXAERR(12)=PXAERR(12)_"you must first delete the skin test reading entry (#"
. S PXAERR(12)=PXAERR(12)_$O(^AUPNVSK("APT",PXAIEN,0))_") before deleting this placement entry"
. D ERRSET
;
; if passing in placement entry, make sure the skin test and patient are the same
I $G(PXAA("PLACEMENT")) D Q:$G(STOP)=1
. I PXAA("TEST")=$P($G(^AUPNVSK(PXAA("PLACEMENT"),0)),U,1) Q
. I $G(PATIENT)=$P($G(^AUPNVSK(PXAA("PLACEMENT"),0)),U,2) Q
. S PXAERR(9)="SKIN TEST"
. S PXAERR(11)=$G(PXAA("TEST"))
. S PXAERR(12)="The placement entry is for a different skin test"
;
I '$D(^AUTTSK(PXAA("TEST"))) D Q
. S PXAERR(9)="SKIN TEST"
. S PXAERR(11)=PXAA("TEST")
. S PXAERR(12)="The Skin Test pointer is not valid."
. D ERRSET
;
N TEMP S TEMP=$G(^AUTTSK(PXAA("TEST"),0))
;Check that the .01 is not null.
I $P(TEMP,U,1)="" D Q
. S PXAERR(9)="SKIN TEST"
. S PXAERR(11)=PXAA("TEST")
. S PXAERR(12)="The Skin Test does not have a .01."
. D ERRSET
;
;Check that the test is active.
;* I $P(TEMP,U,3)=1 D Q
;* . S PXAERR(9)="SKIN TEST"
;* . S PXAERR(11)=PXAA("TEST")
;* . S PXAERR(12)="The Skin Test is inactive."
;* . D ERRSET
;
;If a Reading is input validate it.
;* I $G(PXAA("READING"))'="",(+PXAA("READING")'=PXAA("READING")!(PXAA("READING")>40)!(PXAA("READING")<0)!(PXAA("READING")?.E1"."1N.N)) D Q
;* . S PXAERR(9)="READING"
;* . S PXAERR(12)=+PXAA("READING")_" is not a whole number between 0 and 40."
;* . D ERRSET
;
;If a Result is input validate it.
;* I $G(PXAA("RESULT"))'="",'$$SET^PXAIVAL(9000010.12,"RESULT",.04,PXAA("RESULT"),.PXAERR) D Q
;* . D ERRSET
;
;If D/T Read is input verify it is a valid FileMan date .
;* I $G(PXAA("D/T READ"))'="",'$$DATETIME^PXAIVAL("D/T READ",PXAA("D/T READ"),"T",.PXAERR) D Q
;* . D ERRSET
;
;If D/T Read is input verify it is not a future date.
;* I $G(PXAA("D/T READ"))'="",$$FUTURE^PXDATE(PXAA("D/T READ")) D Q
;* . S PXAERR(9)="D/T READ"
;* . S PXAERR(11)=PXAA("D/T READ")
;* . S PXAERR(12)=+PXAA("D/T READ")_" is a future date."
;* . D ERRSET
;
;If Event D/T is input verify it is a valid FileMan date and not in
;the future.
;* I $G(PXAA("EVENT D/T"))'="",'$$EVENTDT^PXAIVAL(PXAA("EVENT D/T"),"T",.PXAERR) D Q
;* . D ERRSET
;
;If an Ordering Provider is passed verify it is valid.
;* I $G(PXAA("ORD PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ORD PROVIDER"),"ORD",.PXAA,.PXAERR,PXAVISIT) D Q
;* . D ERRSET
;
;If an Encounter Provider is passed verify it is valid.
;* I $G(PXAA("ENC PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ENC PROVIDER"),"ENC",.PXAA,.PXAERR,PXAVISIT) D Q
;* . D ERRSET
;
;If an Anatomic Location is passed verify it is valid.
;* I $G(PXAA("ANATOMIC LOC"))'="",'$D(^PXV(920.3,PXAA("ANATOMIC LOC"),0)) D Q
;* . S PXAERR(9)="ANATOMIC LOC"
;* . S PXAERR(11)=PXAA("ANATOMIC LOC")
;* . S PXAERR(12)=PXAA("ANATOMIC LOC")_" is a not a valid pointer to the Imm Administration Site file."
;* . D ERRSET
;
;If a Reading Comment is passed verify it.
;* I $G(PXAA("READING COMMENT"))'="",'$$TEXT^PXAIVAL("READING COMMENT",PXAA("READING COMMENT"),1,245,.PXAERR) D Q
;* . D ERRSET
;
;If a Comment is passed verify it.
;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245,.PXAERR) D Q
;* . D ERRSET
;
;If PKG is input verify it.
;* I $G(PXAA("PKG"))'="" D
;* . N PKG
;* . S PKG=$$VPKG^PXAIVAL(PXAA("PKG"),.PXAERR)
;* . I PKG=0 S PXAERR(9)="PKG" D ERRSET Q
;* . S PXAA("PKG")=PKG
;* I $G(STOP)=1 Q
;
;If SOURCE is input verify it.
;* I $G(PXAA("SOURCE"))'="" D
;* . N SRC
;* . S SRC=$$VSOURCE^PXAIVAL(PXAA("SOURCE"),.PXAERR)
;* . I SRC=0 S PXAERR(9)="SOURCE" D ERRSET Q
;* . S PXAA("SOURCE")=SRC
;* I $G(STOP)=1 Q
;
;Check for diagnosis input and return a warning.
;* N DIAGSTR,DIAGNUM,NDIAG
;* S NDIAG=0
;* F DIAGNUM=1:1:8 D
;* . S DIAGSTR="DIAGNOSIS"_$S(DIAGNUM>1:" "_DIAGNUM,1:"")
;* . I $G(PXAA(DIAGSTR))]"" S NDIAG=NDIAG+1
;* I NDIAG>0 D Q
;* . S PXADI("DIALOG")=8390001.002
;* . S PXAERRW("SK")=1
;* . S PXAERR(9)="DIAGNOSIS"
;* . S PXAERR(12)="As of patch PX*1*211 diagnoses cannot be stored in V SKIN TEST."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAISKV 4985 printed Dec 13, 2024@02:26:04 Page 2
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
+2 ;
ERRSET ;Set the rest of the error data.
+1 SET STOP=1
+2 SET PXAERRF("SK")=1
+3 SET PXADI("DIALOG")=8390001.001
+4 SET PXAERR(7)="SKIN TEST"
+5 QUIT
+6 ;
VAL ;Validate the input data.
+1 IF '$DATA(PXAA("TEST"))
Begin DoDot:1
+2 SET PXAERR(9)="SKIN TEST"
+3 SET PXAERR(12)="You are missing the name of the Skin Test."
+4 DO ERRSET
End DoDot:1
QUIT
+5 ;
+6 IF $GET(PXAA("DELETE"))=1
Begin DoDot:1
+7 NEW PXAIEN
+8 ;Check to see if there is a skin test reading linked to this entry
+9 SET PXAIEN=+$$GETIEN^PXAISK(PXAVISIT,PXAA("TEST"))
+10 IF '$DATA(^AUPNVSK("APT",PXAIEN))
QUIT
+11 SET PXAERR(9)="SKIN TEST"
+12 SET PXAERR(11)=$GET(PXAA("TEST"))
+13 SET PXAERR(12)="There is a skin test reading linked to this entry; "
+14 SET PXAERR(12)=PXAERR(12)_"you must first delete the skin test reading entry (#"
+15 SET PXAERR(12)=PXAERR(12)_$ORDER(^AUPNVSK("APT",PXAIEN,0))_") before deleting this placement entry"
+16 DO ERRSET
End DoDot:1
QUIT
+17 ;
+18 ; if passing in placement entry, make sure the skin test and patient are the same
+19 IF $GET(PXAA("PLACEMENT"))
Begin DoDot:1
+20 IF PXAA("TEST")=$PIECE($GET(^AUPNVSK(PXAA("PLACEMENT"),0)),U,1)
QUIT
+21 IF $GET(PATIENT)=$PIECE($GET(^AUPNVSK(PXAA("PLACEMENT"),0)),U,2)
QUIT
+22 SET PXAERR(9)="SKIN TEST"
+23 SET PXAERR(11)=$GET(PXAA("TEST"))
+24 SET PXAERR(12)="The placement entry is for a different skin test"
End DoDot:1
if $GET(STOP)=1
QUIT
+25 ;
+26 IF '$DATA(^AUTTSK(PXAA("TEST")))
Begin DoDot:1
+27 SET PXAERR(9)="SKIN TEST"
+28 SET PXAERR(11)=PXAA("TEST")
+29 SET PXAERR(12)="The Skin Test pointer is not valid."
+30 DO ERRSET
End DoDot:1
QUIT
+31 ;
+32 NEW TEMP
SET TEMP=$GET(^AUTTSK(PXAA("TEST"),0))
+33 ;Check that the .01 is not null.
+34 IF $PIECE(TEMP,U,1)=""
Begin DoDot:1
+35 SET PXAERR(9)="SKIN TEST"
+36 SET PXAERR(11)=PXAA("TEST")
+37 SET PXAERR(12)="The Skin Test does not have a .01."
+38 DO ERRSET
End DoDot:1
QUIT
+39 ;
+40 ;Check that the test is active.
+41 ;* I $P(TEMP,U,3)=1 D Q
+42 ;* . S PXAERR(9)="SKIN TEST"
+43 ;* . S PXAERR(11)=PXAA("TEST")
+44 ;* . S PXAERR(12)="The Skin Test is inactive."
+45 ;* . D ERRSET
+46 ;
+47 ;If a Reading is input validate it.
+48 ;* I $G(PXAA("READING"))'="",(+PXAA("READING")'=PXAA("READING")!(PXAA("READING")>40)!(PXAA("READING")<0)!(PXAA("READING")?.E1"."1N.N)) D Q
+49 ;* . S PXAERR(9)="READING"
+50 ;* . S PXAERR(12)=+PXAA("READING")_" is not a whole number between 0 and 40."
+51 ;* . D ERRSET
+52 ;
+53 ;If a Result is input validate it.
+54 ;* I $G(PXAA("RESULT"))'="",'$$SET^PXAIVAL(9000010.12,"RESULT",.04,PXAA("RESULT"),.PXAERR) D Q
+55 ;* . D ERRSET
+56 ;
+57 ;If D/T Read is input verify it is a valid FileMan date .
+58 ;* I $G(PXAA("D/T READ"))'="",'$$DATETIME^PXAIVAL("D/T READ",PXAA("D/T READ"),"T",.PXAERR) D Q
+59 ;* . D ERRSET
+60 ;
+61 ;If D/T Read is input verify it is not a future date.
+62 ;* I $G(PXAA("D/T READ"))'="",$$FUTURE^PXDATE(PXAA("D/T READ")) D Q
+63 ;* . S PXAERR(9)="D/T READ"
+64 ;* . S PXAERR(11)=PXAA("D/T READ")
+65 ;* . S PXAERR(12)=+PXAA("D/T READ")_" is a future date."
+66 ;* . D ERRSET
+67 ;
+68 ;If Event D/T is input verify it is a valid FileMan date and not in
+69 ;the future.
+70 ;* I $G(PXAA("EVENT D/T"))'="",'$$EVENTDT^PXAIVAL(PXAA("EVENT D/T"),"T",.PXAERR) D Q
+71 ;* . D ERRSET
+72 ;
+73 ;If an Ordering Provider is passed verify it is valid.
+74 ;* I $G(PXAA("ORD PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ORD PROVIDER"),"ORD",.PXAA,.PXAERR,PXAVISIT) D Q
+75 ;* . D ERRSET
+76 ;
+77 ;If an Encounter Provider is passed verify it is valid.
+78 ;* I $G(PXAA("ENC PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ENC PROVIDER"),"ENC",.PXAA,.PXAERR,PXAVISIT) D Q
+79 ;* . D ERRSET
+80 ;
+81 ;If an Anatomic Location is passed verify it is valid.
+82 ;* I $G(PXAA("ANATOMIC LOC"))'="",'$D(^PXV(920.3,PXAA("ANATOMIC LOC"),0)) D Q
+83 ;* . S PXAERR(9)="ANATOMIC LOC"
+84 ;* . S PXAERR(11)=PXAA("ANATOMIC LOC")
+85 ;* . S PXAERR(12)=PXAA("ANATOMIC LOC")_" is a not a valid pointer to the Imm Administration Site file."
+86 ;* . D ERRSET
+87 ;
+88 ;If a Reading Comment is passed verify it.
+89 ;* I $G(PXAA("READING COMMENT"))'="",'$$TEXT^PXAIVAL("READING COMMENT",PXAA("READING COMMENT"),1,245,.PXAERR) D Q
+90 ;* . D ERRSET
+91 ;
+92 ;If a Comment is passed verify it.
+93 ;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245,.PXAERR) D Q
+94 ;* . D ERRSET
+95 ;
+96 ;If PKG is input verify it.
+97 ;* I $G(PXAA("PKG"))'="" D
+98 ;* . N PKG
+99 ;* . S PKG=$$VPKG^PXAIVAL(PXAA("PKG"),.PXAERR)
+100 ;* . I PKG=0 S PXAERR(9)="PKG" D ERRSET Q
+101 ;* . S PXAA("PKG")=PKG
+102 ;* I $G(STOP)=1 Q
+103 ;
+104 ;If SOURCE is input verify it.
+105 ;* I $G(PXAA("SOURCE"))'="" D
+106 ;* . N SRC
+107 ;* . S SRC=$$VSOURCE^PXAIVAL(PXAA("SOURCE"),.PXAERR)
+108 ;* . I SRC=0 S PXAERR(9)="SOURCE" D ERRSET Q
+109 ;* . S PXAA("SOURCE")=SRC
+110 ;* I $G(STOP)=1 Q
+111 ;
+112 ;Check for diagnosis input and return a warning.
+113 ;* N DIAGSTR,DIAGNUM,NDIAG
+114 ;* S NDIAG=0
+115 ;* F DIAGNUM=1:1:8 D
+116 ;* . S DIAGSTR="DIAGNOSIS"_$S(DIAGNUM>1:" "_DIAGNUM,1:"")
+117 ;* . I $G(PXAA(DIAGSTR))]"" S NDIAG=NDIAG+1
+118 ;* I NDIAG>0 D Q
+119 ;* . S PXADI("DIALOG")=8390001.002
+120 ;* . S PXAERRW("SK")=1
+121 ;* . S PXAERR(9)="DIAGNOSIS"
+122 ;* . S PXAERR(12)="As of patch PX*1*211 diagnoses cannot be stored in V SKIN TEST."
+123 QUIT
+124 ;
