PXAISCV ;SLC/PKR - Validate a Standard Code entry. ;10/05/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
;
ERRSET ;Set the rest of the error data.
S STOP=1
S PXAERRF("SC")=1
S PXAERR(7)="STD CODES"
S PXADI("DIALOG")=8390001.001
Q
;
VAL ;Validate the input data.
I $G(PXAA("CODE"))="" D Q
. S PXAERR(9)="CODE"
. S PXAERR(12)="The Code is missing."
. D ERRSET
;
I $G(PXAA("CODING SYSTEM"))="" D Q
. S PXAERR(9)="CODING SYSTEM"
. S PXAERR(12)="The Coding System is missing."
. D ERRSET
;
;If this is a deletion no further verification is required.
I $G(PXAA("DELETE"))=1 Q
;
;Is the coding system valid?
N CODESYSL
D CODESYSL^PXLEX(.CODESYSL,0)
I '$D(CODESYSL(PXAA("CODING SYSTEM"))) D Q
. S PXAERR(9)="CODING SYSTEM"
. S PXAERR(12)="The "_PXAA("CODING SYSTEM")_" coding system is not supported for V STANDARD CODES."
. D ERRSET
;
;Is the coding system, code pair valid?
I '$$VCODE^PXLEX(PXAA("CODING SYSTEM"),PXAA("CODE")) D Q
. S PXAERR(9)="CODING SYSTEM"
. S PXAERR(11)=PXAA("CODING SYSTEM")_U_PXAA("CODE")
. S PXAERR(12)="Invalid code for the coding system."
. 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
;
;Is the code active on the date of interest?
;* N EVENTDT,SERVCAT,TEMP
;* S TEMP=^AUPNVSIT(PXAVISIT,0)
;* S SERVCAT=$P(TEMP,U,7)
;For historical encounters use the Date the Visit was created.
;* S EVENTDT=$S(SERVCAT="E":$P(TEMP,U,2),$G(PXAA("EVENT D/T"))'="":PXAA("EVENT D/T"),1:$P(TEMP,U,1))
;* I '$$ISCACT^PXLEX(PXAA("CODING SYSTEM"),PXAA("CODE"),EVENTDT) D Q
;* . S PXAERR(9)="CODE NOT ACTIVE"
;* . S PXAERR(11)=PXAA("CODING SYSTEM")_U_PXAA("CODE")_U_EVENTDT
;* . S PXAERR(12)="The code was not active on "_$$FMTE^XLFDT(EVENTDT,"5Z")_"."
;* . 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 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 a Magnitude is being input verify that it is in the allowed range.
;* N MPARAMS
;* S MPARAMS=-99999999999999_U_99999999999999_U_10
;* I $G(PXAA("MAGNITUDE"))'="",'$$MAG^PXAIVAL(PXAA("MAGNITUDE"),MPARAMS,.PXAERR) D Q
;* . D ERRSET
;
;If a UCUM code is being input verify that it is valid.
;* I $G(PXAA("UCUM CODE"))'="" D
;* . N UCUMCODE
;* . S UCUMCODE=$$UCUMCODE^LEXMUCUM(PXAA("UCUM CODE"))
;* . I UCUMCODE["unit not defined" D
;* .. S PXAERR(9)="UCUM CODE"
;* .. S PXAERR(11)=PXAA("UCUM CODE")
;* .. S PXAERR(12)=$P(UCUMCODE,U,2)
;* .. D ERRSET
;* I $G(STOP)=1 Q
;
;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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAISCV 3505 printed Apr 09, 2024@21:33:26 Page 2
PXAISCV ;SLC/PKR - Validate a Standard Code entry. ;10/05/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
+2 ;
ERRSET ;Set the rest of the error data.
+1 SET STOP=1
+2 SET PXAERRF("SC")=1
+3 SET PXAERR(7)="STD CODES"
+4 SET PXADI("DIALOG")=8390001.001
+5 QUIT
+6 ;
VAL ;Validate the input data.
+1 IF $GET(PXAA("CODE"))=""
Begin DoDot:1
+2 SET PXAERR(9)="CODE"
+3 SET PXAERR(12)="The Code is missing."
+4 DO ERRSET
End DoDot:1
QUIT
+5 ;
+6 IF $GET(PXAA("CODING SYSTEM"))=""
Begin DoDot:1
+7 SET PXAERR(9)="CODING SYSTEM"
+8 SET PXAERR(12)="The Coding System is missing."
+9 DO ERRSET
End DoDot:1
QUIT
+10 ;
+11 ;If this is a deletion no further verification is required.
+12 IF $GET(PXAA("DELETE"))=1
QUIT
+13 ;
+14 ;Is the coding system valid?
+15 NEW CODESYSL
+16 DO CODESYSL^PXLEX(.CODESYSL,0)
+17 IF '$DATA(CODESYSL(PXAA("CODING SYSTEM")))
Begin DoDot:1
+18 SET PXAERR(9)="CODING SYSTEM"
+19 SET PXAERR(12)="The "_PXAA("CODING SYSTEM")_" coding system is not supported for V STANDARD CODES."
+20 DO ERRSET
End DoDot:1
QUIT
+21 ;
+22 ;Is the coding system, code pair valid?
+23 IF '$$VCODE^PXLEX(PXAA("CODING SYSTEM"),PXAA("CODE"))
Begin DoDot:1
+24 SET PXAERR(9)="CODING SYSTEM"
+25 SET PXAERR(11)=PXAA("CODING SYSTEM")_U_PXAA("CODE")
+26 SET PXAERR(12)="Invalid code for the coding system."
+27 DO ERRSET
End DoDot:1
QUIT
+28 ;
+29 ;If Event D/T is input verify it is a valid FileMan date and not in
+30 ;the future.
+31 ;* I $G(PXAA("EVENT D/T"))'="",'$$EVENTDT^PXAIVAL(PXAA("EVENT D/T"),"T",.PXAERR) D Q
+32 ;* . D ERRSET
+33 ;
+34 ;Is the code active on the date of interest?
+35 ;* N EVENTDT,SERVCAT,TEMP
+36 ;* S TEMP=^AUPNVSIT(PXAVISIT,0)
+37 ;* S SERVCAT=$P(TEMP,U,7)
+38 ;For historical encounters use the Date the Visit was created.
+39 ;* S EVENTDT=$S(SERVCAT="E":$P(TEMP,U,2),$G(PXAA("EVENT D/T"))'="":PXAA("EVENT D/T"),1:$P(TEMP,U,1))
+40 ;* I '$$ISCACT^PXLEX(PXAA("CODING SYSTEM"),PXAA("CODE"),EVENTDT) D Q
+41 ;* . S PXAERR(9)="CODE NOT ACTIVE"
+42 ;* . S PXAERR(11)=PXAA("CODING SYSTEM")_U_PXAA("CODE")_U_EVENTDT
+43 ;* . S PXAERR(12)="The code was not active on "_$$FMTE^XLFDT(EVENTDT,"5Z")_"."
+44 ;* . D ERRSET
+45 ;
+46 ;If a Comment is passed verify it.
+47 ;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245,.PXAERR) D Q
+48 ;* . D ERRSET
+49 ;
+50 ;If an Ordering Provider is passed verify it is valid.
+51 ;* I $G(PXAA("ORD PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ORD PROVIDER"),"ORD",.PXAA,.PXAERR,PXAVISIT) D Q
+52 ;* . D ERRSET
+53 ;
+54 ;If an Encounter Provider is passed verify it is valid.
+55 ;* I $G(PXAA("ENC PROVIDER"))'="",'$$PRV^PXAIVAL(PXAA("ENC PROVIDER"),"ENC",.PXAA,.PXAERR,PXAVISIT) D Q
+56 ;* . D ERRSET
+57 ;
+58 ;If a Magnitude is being input verify that it is in the allowed range.
+59 ;* N MPARAMS
+60 ;* S MPARAMS=-99999999999999_U_99999999999999_U_10
+61 ;* I $G(PXAA("MAGNITUDE"))'="",'$$MAG^PXAIVAL(PXAA("MAGNITUDE"),MPARAMS,.PXAERR) D Q
+62 ;* . D ERRSET
+63 ;
+64 ;If a UCUM code is being input verify that it is valid.
+65 ;* I $G(PXAA("UCUM CODE"))'="" D
+66 ;* . N UCUMCODE
+67 ;* . S UCUMCODE=$$UCUMCODE^LEXMUCUM(PXAA("UCUM CODE"))
+68 ;* . I UCUMCODE["unit not defined" D
+69 ;* .. S PXAERR(9)="UCUM CODE"
+70 ;* .. S PXAERR(11)=PXAA("UCUM CODE")
+71 ;* .. S PXAERR(12)=$P(UCUMCODE,U,2)
+72 ;* .. D ERRSET
+73 ;* I $G(STOP)=1 Q
+74 ;
+75 ;If PKG is input verify it.
+76 ;* I $G(PXAA("PKG"))'="" D
+77 ;* . N PKG
+78 ;* . S PKG=$$VPKG^PXAIVAL(PXAA("PKG"),.PXAERR)
+79 ;* . I PKG=0 S PXAERR(9)="PKG" D ERRSET Q
+80 ;* . S PXAA("PKG")=PKG
+81 ;* I $G(STOP)=1 Q
+82 ;
+83 ;If SOURCE is input verify it.
+84 ;* I $G(PXAA("SOURCE"))'="" D
+85 ;* . N SRC
+86 ;* . S SRC=$$VSOURCE^PXAIVAL(PXAA("SOURCE"),.PXAERR)
+87 ;* . I SRC=0 S PXAERR(9)="SOURCE" D ERRSET Q
+88 ;* . S PXAA("SOURCE")=SRC
+89 QUIT
+90 ;
