PXAISKV.m

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 ---PXAISKV   4985     printed  Apr 09, 2024@21:32:58                                                                                                                                                                                                     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     ;