PXAIPRVV ;ISL/JVS,PKR - VALIDATE PROVIDER DATA ;11/19/2021
;;1.0;PCE PATIENT CARE ENCOUNTER;**27,186,211,217**;Aug 12, 1996;Build 134
;
ERRSET ;Set the rest of the error data.
S STOP=1
S PXAERRF("PRV")=1
S PXADI("DIALOG")=8390001.001
S PXAERR(7)="PROVIDER"
Q
;
PRIM(VISITIEN,PXADATA,PXAERRF,PXAPREDT) ;Check there is only one primary
;provider.
N EPRIM,IND,NPPE,NPPN,NPPT,NPRIM,PPEDIT,PPLISTE,PPLISTN,PROVIEN
N STOP,TEMP,VPRVIEN
S (NPPE,VPRVIEN)=0
F S VPRVIEN=$O(^AUPNVPRV("AD",VISITIEN,VPRVIEN)) Q:VPRVIEN="" D
. S TEMP=^AUPNVPRV(VPRVIEN,0)
. S PROVIEN=$P(TEMP,U,1)
. I $P(TEMP,U,4)="P" S PPLISTE(PROVIEN)=""
;
S (IND,PPEDIT)=0
F S IND=+$O(@PXADATA@("PROVIDER",IND)) Q:IND=0 D
. S PROVIEN=@PXADATA@("PROVIDER",IND,"NAME")
. I PROVIEN="" Q
.;Check for changes to the existing primary provider.
. I $D(PPLISTE(PROVIEN)) D Q
.. I +$G(@PXADATA@("PROVIDER",IND,"DELETE"))=1 D Q
... S PPEDIT=1 K PPLISTE(PROVIEN)
.. I +$G(@PXADATA@("PROVIDER",IND,"PRIMARY"))=0 S PPEDIT=1 K PPLISTE(PROVIEN)
.;
.;Check for adding a new primary provider.
. I +$G(@PXADATA@("PROVIDER",IND,"PRIMARY"))=1 S PPLISTN(PROVIEN)=""
. I +$G(@PXADATA@("PROVIDER",IND,"DELETE"))=1 K PPLISTN(PROVIEN)
;
S NPPE=0,PROVIEN=""
F S PROVIEN=$O(PPLISTE(PROVIEN)) Q:PROVIEN="" S NPPE=NPPE+1,EPRIM(NPPE)=PROVIEN
S NPPN=0,PROVIEN=""
F S PROVIEN=$O(PPLISTN(PROVIEN)) Q:PROVIEN="" S NPPN=NPPN+1,NPRIM(NPPN)=PROVIEN
;
I NPPE>1 D Q
. S PXAERR(9)="PROVIDER"
. S PXAERR(11)="VISIT IEN="_VISITIEN
. S PXAERR(12)="This encounter already has "_NPPE_" primary provider(s), there can only be one."
. S PXAERR(12)=PXAERR(12)_" They are: "
. F IND=1:1:NPPE S PXAERR(12)=PXAERR(12)_$S(IND=1:" ",1:", ")_EPRIM(IND)
. D ERRSET
;
I (PPEDIT=1),($G(PXAPREDT)'=1) D
. S PXAERR(9)="PPEDIT"
. S PXAERR(11)=$G(PXAPREDT)
. S PXAERR(12)="Attempting to edit primary provider and PPEDIT is not 1."
. D ERRSET
;
I NPPN>1 D Q
. S PXAERR(9)="PROVIDER"
. S PXAERR(11)="VISIT IEN="_VISITIEN
. S PXAERR(12)="Attempting to add "_NPPN_" primary provider(s), there can only be one."
. S PXAERR(12)=PXAERR(12)_" They are: "
. F IND=1:1:NPPN S PXAERR(12)=PXAERR(12)_$S(IND=1:" ",1:", ")_NPRIM(IND)
. D ERRSET
;
S NPPT=NPPE+NPPN
I NPPT>1 D Q
. S PXAERR(9)="PROVIDER"
. S PXAERR(12)=NPPT_" providers have been designated as primary, there can only be one."
. S PXAERR(12)=PXAERR(12)_" They are:"
. F IND=1:1:NPPE S PXAERR(12)=PXAERR(12)_$S(IND=1:" ",1:", ")_EPRIM(IND)
. F IND=1:1:NPPN S PXAERR(12)=PXAERR(12)_$S(IND=1:" ",1:", ")_NPRIM(IND)
. D ERRSET
Q
;
VAL ;Validate the input.
I $G(PXAA("NAME"))="" D Q
. S PXAERR(9)="PROVIDER"
. S PXAERR(12)="The provider is missing."
. D ERRSET
;
;If this is a deletion no further verification is required.
I $G(PXAA("DELETE"))=1 Q
;
;Verify that the provider is valid.
I '$$VPRV^PXAIPRVV(PXAA("NAME"),.PXAA,.PXAERR,PXAVISIT) D ERRSET Q
;
;If there are comments check the length.
;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245) D
;* . 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
Q
;
VPRV(PXDUZ,PXAA,PXAERR,VISITIEN) ;Check for a valid provider.
I '$D(^VA(200,PXDUZ)) D Q 0
. S PXAERR(9)="PROVIDER"
. S PXAERR(12)="The pointer to file #200 is not valid."
;
;Check for an active Person Class.
N CLASS,EVENTDT
S PXAERR(9)="Provider"
S EVENTDT=$G(PXAA("EVENT D/T"))
I EVENTDT="" S EVENTDT=$P(^AUPNVSIT(VISITIEN,0),U,1)
S CLASS=+$$GET^XUA4A72(PXDUZ,EVENTDT)
I CLASS'>0 D Q 0
. S PXAERR(12)="The Provider (DUZ="_PXDUZ_") does not have an active person class on the date of the encounter: "_$$FMTE^XLFDT(EVENTDT)
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIPRVV 4106 printed Dec 13, 2024@02:26 Page 2
PXAIPRVV ;ISL/JVS,PKR - VALIDATE PROVIDER DATA ;11/19/2021
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,186,211,217**;Aug 12, 1996;Build 134
+2 ;
ERRSET ;Set the rest of the error data.
+1 SET STOP=1
+2 SET PXAERRF("PRV")=1
+3 SET PXADI("DIALOG")=8390001.001
+4 SET PXAERR(7)="PROVIDER"
+5 QUIT
+6 ;
PRIM(VISITIEN,PXADATA,PXAERRF,PXAPREDT) ;Check there is only one primary
+1 ;provider.
+2 NEW EPRIM,IND,NPPE,NPPN,NPPT,NPRIM,PPEDIT,PPLISTE,PPLISTN,PROVIEN
+3 NEW STOP,TEMP,VPRVIEN
+4 SET (NPPE,VPRVIEN)=0
+5 FOR
SET VPRVIEN=$ORDER(^AUPNVPRV("AD",VISITIEN,VPRVIEN))
if VPRVIEN=""
QUIT
Begin DoDot:1
+6 SET TEMP=^AUPNVPRV(VPRVIEN,0)
+7 SET PROVIEN=$PIECE(TEMP,U,1)
+8 IF $PIECE(TEMP,U,4)="P"
SET PPLISTE(PROVIEN)=""
End DoDot:1
+9 ;
+10 SET (IND,PPEDIT)=0
+11 FOR
SET IND=+$ORDER(@PXADATA@("PROVIDER",IND))
if IND=0
QUIT
Begin DoDot:1
+12 SET PROVIEN=@PXADATA@("PROVIDER",IND,"NAME")
+13 IF PROVIEN=""
QUIT
+14 ;Check for changes to the existing primary provider.
+15 IF $DATA(PPLISTE(PROVIEN))
Begin DoDot:2
+16 IF +$GET(@PXADATA@("PROVIDER",IND,"DELETE"))=1
Begin DoDot:3
+17 SET PPEDIT=1
KILL PPLISTE(PROVIEN)
End DoDot:3
QUIT
+18 IF +$GET(@PXADATA@("PROVIDER",IND,"PRIMARY"))=0
SET PPEDIT=1
KILL PPLISTE(PROVIEN)
End DoDot:2
QUIT
+19 ;
+20 ;Check for adding a new primary provider.
+21 IF +$GET(@PXADATA@("PROVIDER",IND,"PRIMARY"))=1
SET PPLISTN(PROVIEN)=""
+22 IF +$GET(@PXADATA@("PROVIDER",IND,"DELETE"))=1
KILL PPLISTN(PROVIEN)
End DoDot:1
+23 ;
+24 SET NPPE=0
SET PROVIEN=""
+25 FOR
SET PROVIEN=$ORDER(PPLISTE(PROVIEN))
if PROVIEN=""
QUIT
SET NPPE=NPPE+1
SET EPRIM(NPPE)=PROVIEN
+26 SET NPPN=0
SET PROVIEN=""
+27 FOR
SET PROVIEN=$ORDER(PPLISTN(PROVIEN))
if PROVIEN=""
QUIT
SET NPPN=NPPN+1
SET NPRIM(NPPN)=PROVIEN
+28 ;
+29 IF NPPE>1
Begin DoDot:1
+30 SET PXAERR(9)="PROVIDER"
+31 SET PXAERR(11)="VISIT IEN="_VISITIEN
+32 SET PXAERR(12)="This encounter already has "_NPPE_" primary provider(s), there can only be one."
+33 SET PXAERR(12)=PXAERR(12)_" They are: "
+34 FOR IND=1:1:NPPE
SET PXAERR(12)=PXAERR(12)_$SELECT(IND=1:" ",1:", ")_EPRIM(IND)
+35 DO ERRSET
End DoDot:1
QUIT
+36 ;
+37 IF (PPEDIT=1)
IF ($GET(PXAPREDT)'=1)
Begin DoDot:1
+38 SET PXAERR(9)="PPEDIT"
+39 SET PXAERR(11)=$GET(PXAPREDT)
+40 SET PXAERR(12)="Attempting to edit primary provider and PPEDIT is not 1."
+41 DO ERRSET
End DoDot:1
+42 ;
+43 IF NPPN>1
Begin DoDot:1
+44 SET PXAERR(9)="PROVIDER"
+45 SET PXAERR(11)="VISIT IEN="_VISITIEN
+46 SET PXAERR(12)="Attempting to add "_NPPN_" primary provider(s), there can only be one."
+47 SET PXAERR(12)=PXAERR(12)_" They are: "
+48 FOR IND=1:1:NPPN
SET PXAERR(12)=PXAERR(12)_$SELECT(IND=1:" ",1:", ")_NPRIM(IND)
+49 DO ERRSET
End DoDot:1
QUIT
+50 ;
+51 SET NPPT=NPPE+NPPN
+52 IF NPPT>1
Begin DoDot:1
+53 SET PXAERR(9)="PROVIDER"
+54 SET PXAERR(12)=NPPT_" providers have been designated as primary, there can only be one."
+55 SET PXAERR(12)=PXAERR(12)_" They are:"
+56 FOR IND=1:1:NPPE
SET PXAERR(12)=PXAERR(12)_$SELECT(IND=1:" ",1:", ")_EPRIM(IND)
+57 FOR IND=1:1:NPPN
SET PXAERR(12)=PXAERR(12)_$SELECT(IND=1:" ",1:", ")_NPRIM(IND)
+58 DO ERRSET
End DoDot:1
QUIT
+59 QUIT
+60 ;
VAL ;Validate the input.
+1 IF $GET(PXAA("NAME"))=""
Begin DoDot:1
+2 SET PXAERR(9)="PROVIDER"
+3 SET PXAERR(12)="The provider is missing."
+4 DO ERRSET
End DoDot:1
QUIT
+5 ;
+6 ;If this is a deletion no further verification is required.
+7 IF $GET(PXAA("DELETE"))=1
QUIT
+8 ;
+9 ;Verify that the provider is valid.
+10 IF '$$VPRV^PXAIPRVV(PXAA("NAME"),.PXAA,.PXAERR,PXAVISIT)
DO ERRSET
QUIT
+11 ;
+12 ;If there are comments check the length.
+13 ;* I $G(PXAA("COMMENT"))'="",'$$TEXT^PXAIVAL("COMMENT",PXAA("COMMENT"),1,245) D
+14 ;* . D ERRSET
+15 ;
+16 ;If PKG is input verify it.
+17 ;* I $G(PXAA("PKG"))'="" D
+18 ;* . N PKG
+19 ;* . S PKG=$$VPKG^PXAIVAL(PXAA("PKG"),.PXAERR)
+20 ;* . I PKG=0 S PXAERR(9)="PKG" D ERRSET Q
+21 ;* . S PXAA("PKG")=PKG
+22 ;* I $G(STOP)=1 Q
+23 ;
+24 ;If SOURCE is input verify it.
+25 ;* I $G(PXAA("SOURCE"))'="" D
+26 ;* . N SRC
+27 ;* . S SRC=$$VSOURCE^PXAIVAL(PXAA("SOURCE"),.PXAERR)
+28 ;* . I SRC=0 S PXAERR(9)="SOURCE" D ERRSET Q
+29 ;* . S PXAA("SOURCE")=SRC
+30 QUIT
+31 ;
VPRV(PXDUZ,PXAA,PXAERR,VISITIEN) ;Check for a valid provider.
+1 IF '$DATA(^VA(200,PXDUZ))
Begin DoDot:1
+2 SET PXAERR(9)="PROVIDER"
+3 SET PXAERR(12)="The pointer to file #200 is not valid."
End DoDot:1
QUIT 0
+4 ;
+5 ;Check for an active Person Class.
+6 NEW CLASS,EVENTDT
+7 SET PXAERR(9)="Provider"
+8 SET EVENTDT=$GET(PXAA("EVENT D/T"))
+9 IF EVENTDT=""
SET EVENTDT=$PIECE(^AUPNVSIT(VISITIEN,0),U,1)
+10 SET CLASS=+$$GET^XUA4A72(PXDUZ,EVENTDT)
+11 IF CLASS'>0
Begin DoDot:1
+12 SET PXAERR(12)="The Provider (DUZ="_PXDUZ_") does not have an active person class on the date of the encounter: "_$$FMTE^XLFDT(EVENTDT)
End DoDot:1
QUIT 0
+13 QUIT 1
+14 ;
