PXAIVSTV ;ISL/JVS,PKR ISA/KWP - VALIDATE THE VISIT DATA ;Nov 06, 2025@14:14:33
;;1.0;PCE PATIENT CARE ENCOUNTER;**9,15,19,74,111,116,130,124,168,211,244**;Aug 12, 1996;Build 37
;
Q
ERRSET ;Set the rest of the error data.
S STOP=1
S PXAERRF=1
S PXADI("DIALOG")=8390001.001
Q
;
VAL ;--Validate the input.
;If a valid Visit pointer has been input no further validation is
;required, when this is called the Visit pointer has already been
;validated.
I $G(PXAVISIT) Q
;
;If it is a deletion then no further validation is required.
I $G(PXAA("DELETE"))=1 Q
;
;Missing the date and time of visit.
I $G(PXAA("ENC D/T"))="" D Q
. S PXAERR(9)="ENC D/T"
. S PXAERR(11)=$G(PXAA("ENC D/T"))
. S PXAERR(12)="The visit date and time is missing."
. D ERRSET
;
;Is it a valid FileMan date?
I $$VFMDATE^PXDATE(PXAA("ENC D/T"),"ST")=-1 D Q
. S PXAERR(9)="ENC D/T"
. S PXAERR(11)=PXAA("ENC D/T")
. S PXAERR(12)="The visit date and time is not a valid FileMan date and time."
. D ERRSET
;
;Missing Time and not a historical visit.
I $P(PXAA("ENC D/T"),".",2)="",$G(PXAA("SERVICE CATEGORY"))'="E" D Q
. S PXAERR(9)="ENC D/T"
. S PXAERR(11)=PXAA("ENC D/T")
. S PXAERR(12)="The visit time is missing and the visit is not historical."
. D ERRSET
;
;Missing the patient, a pointer to PATIENT/IHS FILE # 9000001
I $G(PXAA("PATIENT"))']"" D Q
. S PXAERR(9)="PATIENT"
. S PXAERR(11)=$G(PXAA("PATIENT"))
. S PXAERR(12)="Missing a pointer to the PATIENT/IHS file #9000001"
. D ERRSET
;
;Not a valid pointer to the PATIENT/IHS file #9000001
I '$D(^AUPNPAT(PXAA("PATIENT"),0)) D Q
. S PXAERR(9)="PATIENT"
. S PXAERR(11)=PXAA("PATIENT")
. S PXAERR(12)=PXAA("PATIENT")_" is not a valid pointer to the PATIENT/IHS file # 9000001."
. D ERRSET
;
;Visit date before the patient's date of birth.
I PXAA("ENC D/T")<$P(^DPT(PXAA("PATIENT"),0),U,3) D Q
. S PXAERR(9)="ENC D/T"
. S PXAERR(11)=PXAA("ENC D/T")
. S PXAERR(12)="The visit date is before the patient's date of birth"
. D ERRSET
;
;Service category is required.
I '$D(PXAA("SERVICE CATEGORY")) D Q
. S PXAERR(9)="SERVICE CATEGORY"
. S PXAERR(11)=$G(PXAA("SERVICE CATEGORY"))
. S PXAERR(12)="Service Category is a required field"
. D ERRSET
;
;Is the Service Category valid?
N EXTERNAL,MSG
S EXTERNAL=$$EXTERNAL^DILFD(9000010,.07,"",PXAA("SERVICE CATEGORY"),"MSG")
I (EXTERNAL=""),$D(MSG) D Q
. S PXAERR(9)="SERVICE CATEGORY"
. S PXAERR(11)=PXAA("SERVICE CATEGORY")
. S PXAERR(12)="This is not a valid Service Category."
. D ERRSET
;
;Hospital Location is required unless Service Category is "E".
I PXAA("SERVICE CATEGORY")'="E",$G(PXAA("HOS LOC"))="" D Q
. S PXAERR(9)="HOSPITAL LOCATION"
. S PXAERR(12)="The Hospital Location is missing and the Service Category is not ""E"""
. D ERRSET
;
;Is the pointer to Hospital Location file valid?
I $G(PXAA("HOS LOC"))'="",'$D(^SC(PXAA("HOS LOC"),0)) D Q
. S PXAERR(9)="HOSPITAL LOCATION"
. S PXAERR(11)=PXAA("HOS LOC")
. S PXAERR(12)=PXAA("HOS LOC")_" is not a valid pointer to the Hospital Location file #44."
. D ERRSET
;
;If a valid Hospital Location is passed use it to automatically
;set DSS ID.
I $G(PXAA("HOS LOC"))'="" S PXAA("DSS ID")=$P(^SC(PXAA("HOS LOC"),0),U,7)
;
;Is the pointer to Clinic Stop file valid?
I $G(PXAA("DSS ID"))'="",'$D(^DIC(40.7,PXAA("DSS ID"),0)) D Q
. S PXAERR(9)="DSS ID"
. S PXAERR(11)=PXAA("DSS ID")
. S PXAERR(12)=PXAA("DSS ID")_" is not a valid pointer to the Clinic Stop Location file #40.7."
. D ERRSET
;
;Is the pointer to the parent Visit valid?
I $G(PXAA("PARENT"))'="",'$D(^AUPNVSIT(PXAA("PARENT"),0)) D Q
. S PXAERR(9)="PARENT"
. S PXAERR(11)=PXAA("PARENT")
. S PXAERR(12)=PXAA("PARENT")_" is not a valid pointer to the Visit file #9000010."
. D ERRSET
;
;Is the Checkout D/T valid?
;* I $G(PXAA("CHECKOUT D/T"))'="" D
;* .;Is it a valid FileMan date?
;* . I $$VFMDATE^PXDATE(PXAA("CHECKOUT D/T"),"ESTXR")=-1 D Q
;* .. S PXAERR(9)="CHECKOUT D/T"
;* .. S PXAERR(11)=PXAA("CHECKOUT D/T")
;* .. S PXAERR(12)="The checkout date and time is not a valid FileMan date and time."
;* .. D ERRSET
;* . I $G(STOP)=1 Q
;* .;The checkout D/T should not be before the visit D/T.
;* . I PXAA("CHECKOUT D/T")<PXAA("ENC D/T") D
;* .. S PXAERR(9)="CHECKOUT D/T"
;* .. S PXAERR(11)=PXAA("CHECKOUT D/T")
;* .. S PXAERR(12)="The checkout D/T is before the encounter D/T."
;* .. D ERRSET
;* I $G(STOP)=1 Q
;
;Is the pointer to the eligibility file valid?
;* I $G(PXAA("ELIGIBILITY"))'="",'$D(^DIC(8,PXAA("ELIGIBILITY"),0)) D Q
;* . S PXAERR(9)="ELIGIBILITY"
;* . S PXAERR(11)=PXAA("ELIGIBILITY")
;* . S PXAERR(12)=PXAA("ELIGIBILITY")_" is not a valid pointer to the Eligibility file #8."
;* . D ERRSET
;
;Is the pointer to the Location valid?
;* I $G(PXAA("INSTITUTION"))'="",'$D(^AUTTLOC(PXAA("INSTITUTION"),0)) D Q
;* . S PXAERR(9)="INSTITUTION"
;* . S PXAERR(11)=PXAA("INSTITUTION")
;* . S PXAERR(12)=PXAA("INSTITUTION")_" is not a valid pointer to the Location file #9999999.06."
;* . D ERRSET
;
;Is the Outside Location valid?
;* I $G(PXAA("OUTSIDE LOCATION"))'="",(($L(PXAA("OUTSIDE LOCATION"))<2)!($L(PXAA("OUTSIDE LOCATION"))>50)) D Q
;* . S PXAERR(9)="OUTSIDE LOCATION"
;* . S PXAERR(11)=PXAA("OUTSIDE LOCATION")
;* . S PXAERR(12)="The length of the Outside Location is either less than 2 or greater than 50."
;* . D ERRSET
;
;Is the Comment valid?
;* I $G(PXAA("COMMENT"))'="",(($L(PXAA("COMMENT"))<1)!($L(PXAA("COMMENT"))>245)) D Q
;* . S PXAERR(9)="COMMENT"
;* . S PXAERR(11)=PXAA("COMMENT")
;* . S PXAERR(12)="The length of the Comment is either less than 2 or greater than 245."
;* . D ERRSET
;
;If an Encounter Type is being input validate it.
;* I $G(PXAA("ENCOUNTER TYPE"))'="" D
;* . N EXTERNAL,MSG
;* . S EXTERNAL=$$EXTERNAL^DILFD(9000010,15003,"",PXAA("ENCOUNTER TYPE"),"MSG")
;* . I (EXTERNAL=""),$D(MSG) D
;* .. S PXAERR(9)="ENCOUNTER TYPE"
;* .. S PXAERR(12)=MSG("DIERR",1,"TEXT",1)
;* .. S PXAERR(13)=MSG("DIERR",1,"TEXT",2)
;* .. D ERRSET
Q
;
VALSA(PXAERR,PXAVISIT,PXAA,PXSAS) ;
N CODE,INVALID,INVCODE,NOTNEED,PXARRAY,ELIG,SC,SUB,TEXT,WARNNUM,VALUE
S SC=$G(PXSAS("SC"))
D GETPATSA^PXSPECAUTH($G(PXAA("PATIENT")),$G(PXAA("ENC D/T")),$G(PXAA("HOS LOC")),$G(PXAVISIT),.PXARRAY)
I SC="" S SC=$P($G(PXARRAY("SC")),U,2)
S CODE="" F S CODE=$O(PXARRAY(CODE)) Q:CODE="" D
.S ELIG=+$P($G(PXARRAY(CODE)),U),DVALUE=$P($G(PXARRAY(CODE)),U,2)
.;SA Value not passed in, pt is eligible, a value has been stored in the outpatient classification file.
.I $G(PXSAS(CODE))="",ELIG=1,DVALUE'="" S PXSAS(CODE)=DVALUE
.S VALUE=$G(PXSAS(CODE))
.;SKIPCODE set to 1 for codes that have a relationship to SC values
.S SKIPCODE=$S(CODE="AO":1,CODE="IR":1,CODE="EC":1,1:0)
.;Only "", -1, 0, 1 are valid values
.I VALUE'="",+VALUE<-1!(+VALUE>1) S INVALID(CODE)="",PXSAS(CODE)="" Q
.;if SC true no reason to continue validate codes, that have a relationship to SC.
.I SKIPCODE,SC=1 Q
.;if not eligible, then no value should be passed in
.I 'ELIG D Q
..I VALUE=0!(VALUE=1) S NOTNEED(CODE)="",PXSAS(CODE)=""
.;If eligible only 1 or 0 should be passed in
.I VALUE=-1!(VALUE="") D
..S INVCODE(CODE)="",PXSAS(CODE)=""
;
S WARNNUM=0
S CODE="" F S CODE=$O(INVALID(CODE)) Q:CODE="" D
.S TEXT="Invalid value entered for "_CODE_"."
.S WARNNUM=WARNNUM+1,SUB=WARNNUM_"W",PXAERR(SUB)=TEXT
S CODE="" F S CODE=$O(INVCODE(CODE)) Q:CODE="" D
.S TEXT="The veteran is eligible for "_CODE_", but no values were input with the Visit or with V POV."
.S WARNNUM=WARNNUM+1,SUB=WARNNUM_"W",PXAERR(SUB)=TEXT
S CODE="" F S CODE=$O(NOTNEED(CODE)) Q:CODE="" D
.S TEXT="The veteran is not eligible for "_CODE_" but a value was input with code."
.S WARNNUM=WARNNUM+1,SUB=WARNNUM_"W",PXAERR(SUB)=TEXT
;
I WARNNUM=0 Q
S PXADI("DIALOG")=8390001.003
S PXAERRW("SCC")=1
D ERR^PXAI("SCC",1)
Q
;
VALSCC ;--VALIDATE SERVICE CONNECTIVENESS
N CODE,ERR,ERR1,ERRMSG,PXSAS,VALUE,X
F X=1:1:8 D
.S VALUE=$P(AFTER800,U,X)
.S CODE=$$NODETOCODE^PXSPECAUTH(X)
.S PXSAS(CODE)=VALUE
D VALSA(.PXAERR,$G(PXAVISIT),.PXAA,.PXSAS)
Q
;
VPKG(EPKG,PKG) ;Is the Package parameter valid?
I EPKG'="" Q EPKG
I $G(PKG)="" D Q 0
. S PXAERR(7)="ENCOUNTER"
. S PXAERR(9)="DATA2PCE parameter: PKG"
. S PXAERR(12)="PKG is required and it is NULL."
. D ERRSET
N PIEN
S PIEN=$$VPKG^PXAIVAL($G(PKG),.PXAERR)
I PIEN=0 D Q 0
. S PXAERR(7)="PACKAGE"
. D ERRSET
Q PIEN
;
VPTR(VISITIEN) ;Is the Visit pointer valid?
I '$D(^AUPNVSIT(VISITIEN,0)) D
. S PXAERR(7)="VISIT POINTER"
. S PXAERR(9)="DATA2PCE parameter: VISIT"
. S PXAERR(11)=VISITIEN
. S PXAERR(12)="The Visit pointer that was input is not valid."
. D ERRSET
Q
;
VSOURCE(PXAPKG,ESRC,SOURCE) ;Is the Data Source valid?
;Scheduling creates encounters using Visit Tracking, it does not call
;DATA2PCE and it does not set Source.
I $P(^DIC(9.4,PXAPKG,0),U,1)="SCHEDULING" Q ""
I ESRC'="" Q ESRC
I $G(SOURCE)="" D Q 0
. S PXAERR(7)="ENCOUNTER"
. S PXAERR(9)="DATA2PCE parameter: SOURCE"
. S PXAERR(12)="SOURCE is required and it is NULL."
. D ERRSET
N SRC
S SRC=$$VSOURCE^PXAIVAL($G(SOURCE),.PXAERR)
I SRC=0 D Q 0
. S PXAERR(7)="DATA SOURCE"
. D ERRSET
Q SRC
;
VUSER(USER) ;If the user is passed, validate it.
I $G(USER)="" Q
I '$D(^VA(200,USER,0)) D Q
. S PXAERR(7)="ENCOUNTER"
. S PXAERR(9)="DATA2PCE parameter USER"
. S PXAERR(11)="The value is: "_USER
. S PXAERR(12)=USER_" is not a valid pointer to the New Person file #200."
. D ERRSET
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIVSTV 9743 printed Jul 11, 2026@02:22:28 Page 2
PXAIVSTV ;ISL/JVS,PKR ISA/KWP - VALIDATE THE VISIT DATA ;Nov 06, 2025@14:14:33
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,15,19,74,111,116,130,124,168,211,244**;Aug 12, 1996;Build 37
+2 ;
+3 QUIT
ERRSET ;Set the rest of the error data.
+1 SET STOP=1
+2 SET PXAERRF=1
+3 SET PXADI("DIALOG")=8390001.001
+4 QUIT
+5 ;
VAL ;--Validate the input.
+1 ;If a valid Visit pointer has been input no further validation is
+2 ;required, when this is called the Visit pointer has already been
+3 ;validated.
+4 IF $GET(PXAVISIT)
QUIT
+5 ;
+6 ;If it is a deletion then no further validation is required.
+7 IF $GET(PXAA("DELETE"))=1
QUIT
+8 ;
+9 ;Missing the date and time of visit.
+10 IF $GET(PXAA("ENC D/T"))=""
Begin DoDot:1
+11 SET PXAERR(9)="ENC D/T"
+12 SET PXAERR(11)=$GET(PXAA("ENC D/T"))
+13 SET PXAERR(12)="The visit date and time is missing."
+14 DO ERRSET
End DoDot:1
QUIT
+15 ;
+16 ;Is it a valid FileMan date?
+17 IF $$VFMDATE^PXDATE(PXAA("ENC D/T"),"ST")=-1
Begin DoDot:1
+18 SET PXAERR(9)="ENC D/T"
+19 SET PXAERR(11)=PXAA("ENC D/T")
+20 SET PXAERR(12)="The visit date and time is not a valid FileMan date and time."
+21 DO ERRSET
End DoDot:1
QUIT
+22 ;
+23 ;Missing Time and not a historical visit.
+24 IF $PIECE(PXAA("ENC D/T"),".",2)=""
IF $GET(PXAA("SERVICE CATEGORY"))'="E"
Begin DoDot:1
+25 SET PXAERR(9)="ENC D/T"
+26 SET PXAERR(11)=PXAA("ENC D/T")
+27 SET PXAERR(12)="The visit time is missing and the visit is not historical."
+28 DO ERRSET
End DoDot:1
QUIT
+29 ;
+30 ;Missing the patient, a pointer to PATIENT/IHS FILE # 9000001
+31 IF $GET(PXAA("PATIENT"))']""
Begin DoDot:1
+32 SET PXAERR(9)="PATIENT"
+33 SET PXAERR(11)=$GET(PXAA("PATIENT"))
+34 SET PXAERR(12)="Missing a pointer to the PATIENT/IHS file #9000001"
+35 DO ERRSET
End DoDot:1
QUIT
+36 ;
+37 ;Not a valid pointer to the PATIENT/IHS file #9000001
+38 IF '$DATA(^AUPNPAT(PXAA("PATIENT"),0))
Begin DoDot:1
+39 SET PXAERR(9)="PATIENT"
+40 SET PXAERR(11)=PXAA("PATIENT")
+41 SET PXAERR(12)=PXAA("PATIENT")_" is not a valid pointer to the PATIENT/IHS file # 9000001."
+42 DO ERRSET
End DoDot:1
QUIT
+43 ;
+44 ;Visit date before the patient's date of birth.
+45 IF PXAA("ENC D/T")<$PIECE(^DPT(PXAA("PATIENT"),0),U,3)
Begin DoDot:1
+46 SET PXAERR(9)="ENC D/T"
+47 SET PXAERR(11)=PXAA("ENC D/T")
+48 SET PXAERR(12)="The visit date is before the patient's date of birth"
+49 DO ERRSET
End DoDot:1
QUIT
+50 ;
+51 ;Service category is required.
+52 IF '$DATA(PXAA("SERVICE CATEGORY"))
Begin DoDot:1
+53 SET PXAERR(9)="SERVICE CATEGORY"
+54 SET PXAERR(11)=$GET(PXAA("SERVICE CATEGORY"))
+55 SET PXAERR(12)="Service Category is a required field"
+56 DO ERRSET
End DoDot:1
QUIT
+57 ;
+58 ;Is the Service Category valid?
+59 NEW EXTERNAL,MSG
+60 SET EXTERNAL=$$EXTERNAL^DILFD(9000010,.07,"",PXAA("SERVICE CATEGORY"),"MSG")
+61 IF (EXTERNAL="")
IF $DATA(MSG)
Begin DoDot:1
+62 SET PXAERR(9)="SERVICE CATEGORY"
+63 SET PXAERR(11)=PXAA("SERVICE CATEGORY")
+64 SET PXAERR(12)="This is not a valid Service Category."
+65 DO ERRSET
End DoDot:1
QUIT
+66 ;
+67 ;Hospital Location is required unless Service Category is "E".
+68 IF PXAA("SERVICE CATEGORY")'="E"
IF $GET(PXAA("HOS LOC"))=""
Begin DoDot:1
+69 SET PXAERR(9)="HOSPITAL LOCATION"
+70 SET PXAERR(12)="The Hospital Location is missing and the Service Category is not ""E"""
+71 DO ERRSET
End DoDot:1
QUIT
+72 ;
+73 ;Is the pointer to Hospital Location file valid?
+74 IF $GET(PXAA("HOS LOC"))'=""
IF '$DATA(^SC(PXAA("HOS LOC"),0))
Begin DoDot:1
+75 SET PXAERR(9)="HOSPITAL LOCATION"
+76 SET PXAERR(11)=PXAA("HOS LOC")
+77 SET PXAERR(12)=PXAA("HOS LOC")_" is not a valid pointer to the Hospital Location file #44."
+78 DO ERRSET
End DoDot:1
QUIT
+79 ;
+80 ;If a valid Hospital Location is passed use it to automatically
+81 ;set DSS ID.
+82 IF $GET(PXAA("HOS LOC"))'=""
SET PXAA("DSS ID")=$PIECE(^SC(PXAA("HOS LOC"),0),U,7)
+83 ;
+84 ;Is the pointer to Clinic Stop file valid?
+85 IF $GET(PXAA("DSS ID"))'=""
IF '$DATA(^DIC(40.7,PXAA("DSS ID"),0))
Begin DoDot:1
+86 SET PXAERR(9)="DSS ID"
+87 SET PXAERR(11)=PXAA("DSS ID")
+88 SET PXAERR(12)=PXAA("DSS ID")_" is not a valid pointer to the Clinic Stop Location file #40.7."
+89 DO ERRSET
End DoDot:1
QUIT
+90 ;
+91 ;Is the pointer to the parent Visit valid?
+92 IF $GET(PXAA("PARENT"))'=""
IF '$DATA(^AUPNVSIT(PXAA("PARENT"),0))
Begin DoDot:1
+93 SET PXAERR(9)="PARENT"
+94 SET PXAERR(11)=PXAA("PARENT")
+95 SET PXAERR(12)=PXAA("PARENT")_" is not a valid pointer to the Visit file #9000010."
+96 DO ERRSET
End DoDot:1
QUIT
+97 ;
+98 ;Is the Checkout D/T valid?
+99 ;* I $G(PXAA("CHECKOUT D/T"))'="" D
+100 ;* .;Is it a valid FileMan date?
+101 ;* . I $$VFMDATE^PXDATE(PXAA("CHECKOUT D/T"),"ESTXR")=-1 D Q
+102 ;* .. S PXAERR(9)="CHECKOUT D/T"
+103 ;* .. S PXAERR(11)=PXAA("CHECKOUT D/T")
+104 ;* .. S PXAERR(12)="The checkout date and time is not a valid FileMan date and time."
+105 ;* .. D ERRSET
+106 ;* . I $G(STOP)=1 Q
+107 ;* .;The checkout D/T should not be before the visit D/T.
+108 ;* . I PXAA("CHECKOUT D/T")<PXAA("ENC D/T") D
+109 ;* .. S PXAERR(9)="CHECKOUT D/T"
+110 ;* .. S PXAERR(11)=PXAA("CHECKOUT D/T")
+111 ;* .. S PXAERR(12)="The checkout D/T is before the encounter D/T."
+112 ;* .. D ERRSET
+113 ;* I $G(STOP)=1 Q
+114 ;
+115 ;Is the pointer to the eligibility file valid?
+116 ;* I $G(PXAA("ELIGIBILITY"))'="",'$D(^DIC(8,PXAA("ELIGIBILITY"),0)) D Q
+117 ;* . S PXAERR(9)="ELIGIBILITY"
+118 ;* . S PXAERR(11)=PXAA("ELIGIBILITY")
+119 ;* . S PXAERR(12)=PXAA("ELIGIBILITY")_" is not a valid pointer to the Eligibility file #8."
+120 ;* . D ERRSET
+121 ;
+122 ;Is the pointer to the Location valid?
+123 ;* I $G(PXAA("INSTITUTION"))'="",'$D(^AUTTLOC(PXAA("INSTITUTION"),0)) D Q
+124 ;* . S PXAERR(9)="INSTITUTION"
+125 ;* . S PXAERR(11)=PXAA("INSTITUTION")
+126 ;* . S PXAERR(12)=PXAA("INSTITUTION")_" is not a valid pointer to the Location file #9999999.06."
+127 ;* . D ERRSET
+128 ;
+129 ;Is the Outside Location valid?
+130 ;* I $G(PXAA("OUTSIDE LOCATION"))'="",(($L(PXAA("OUTSIDE LOCATION"))<2)!($L(PXAA("OUTSIDE LOCATION"))>50)) D Q
+131 ;* . S PXAERR(9)="OUTSIDE LOCATION"
+132 ;* . S PXAERR(11)=PXAA("OUTSIDE LOCATION")
+133 ;* . S PXAERR(12)="The length of the Outside Location is either less than 2 or greater than 50."
+134 ;* . D ERRSET
+135 ;
+136 ;Is the Comment valid?
+137 ;* I $G(PXAA("COMMENT"))'="",(($L(PXAA("COMMENT"))<1)!($L(PXAA("COMMENT"))>245)) D Q
+138 ;* . S PXAERR(9)="COMMENT"
+139 ;* . S PXAERR(11)=PXAA("COMMENT")
+140 ;* . S PXAERR(12)="The length of the Comment is either less than 2 or greater than 245."
+141 ;* . D ERRSET
+142 ;
+143 ;If an Encounter Type is being input validate it.
+144 ;* I $G(PXAA("ENCOUNTER TYPE"))'="" D
+145 ;* . N EXTERNAL,MSG
+146 ;* . S EXTERNAL=$$EXTERNAL^DILFD(9000010,15003,"",PXAA("ENCOUNTER TYPE"),"MSG")
+147 ;* . I (EXTERNAL=""),$D(MSG) D
+148 ;* .. S PXAERR(9)="ENCOUNTER TYPE"
+149 ;* .. S PXAERR(12)=MSG("DIERR",1,"TEXT",1)
+150 ;* .. S PXAERR(13)=MSG("DIERR",1,"TEXT",2)
+151 ;* .. D ERRSET
+152 QUIT
+153 ;
VALSA(PXAERR,PXAVISIT,PXAA,PXSAS) ;
+1 NEW CODE,INVALID,INVCODE,NOTNEED,PXARRAY,ELIG,SC,SUB,TEXT,WARNNUM,VALUE
+2 SET SC=$GET(PXSAS("SC"))
+3 DO GETPATSA^PXSPECAUTH($GET(PXAA("PATIENT")),$GET(PXAA("ENC D/T")),$GET(PXAA("HOS LOC")),$GET(PXAVISIT),.PXARRAY)
+4 IF SC=""
SET SC=$PIECE($GET(PXARRAY("SC")),U,2)
+5 SET CODE=""
FOR
SET CODE=$ORDER(PXARRAY(CODE))
if CODE=""
QUIT
Begin DoDot:1
+6 SET ELIG=+$PIECE($GET(PXARRAY(CODE)),U)
SET DVALUE=$PIECE($GET(PXARRAY(CODE)),U,2)
+7 ;SA Value not passed in, pt is eligible, a value has been stored in the outpatient classification file.
+8 IF $GET(PXSAS(CODE))=""
IF ELIG=1
IF DVALUE'=""
SET PXSAS(CODE)=DVALUE
+9 SET VALUE=$GET(PXSAS(CODE))
+10 ;SKIPCODE set to 1 for codes that have a relationship to SC values
+11 SET SKIPCODE=$SELECT(CODE="AO":1,CODE="IR":1,CODE="EC":1,1:0)
+12 ;Only "", -1, 0, 1 are valid values
+13 IF VALUE'=""
IF +VALUE<-1!(+VALUE>1)
SET INVALID(CODE)=""
SET PXSAS(CODE)=""
QUIT
+14 ;if SC true no reason to continue validate codes, that have a relationship to SC.
+15 IF SKIPCODE
IF SC=1
QUIT
+16 ;if not eligible, then no value should be passed in
+17 IF 'ELIG
Begin DoDot:2
+18 IF VALUE=0!(VALUE=1)
SET NOTNEED(CODE)=""
SET PXSAS(CODE)=""
End DoDot:2
QUIT
+19 ;If eligible only 1 or 0 should be passed in
+20 IF VALUE=-1!(VALUE="")
Begin DoDot:2
+21 SET INVCODE(CODE)=""
SET PXSAS(CODE)=""
End DoDot:2
End DoDot:1
+22 ;
+23 SET WARNNUM=0
+24 SET CODE=""
FOR
SET CODE=$ORDER(INVALID(CODE))
if CODE=""
QUIT
Begin DoDot:1
+25 SET TEXT="Invalid value entered for "_CODE_"."
+26 SET WARNNUM=WARNNUM+1
SET SUB=WARNNUM_"W"
SET PXAERR(SUB)=TEXT
End DoDot:1
+27 SET CODE=""
FOR
SET CODE=$ORDER(INVCODE(CODE))
if CODE=""
QUIT
Begin DoDot:1
+28 SET TEXT="The veteran is eligible for "_CODE_", but no values were input with the Visit or with V POV."
+29 SET WARNNUM=WARNNUM+1
SET SUB=WARNNUM_"W"
SET PXAERR(SUB)=TEXT
End DoDot:1
+30 SET CODE=""
FOR
SET CODE=$ORDER(NOTNEED(CODE))
if CODE=""
QUIT
Begin DoDot:1
+31 SET TEXT="The veteran is not eligible for "_CODE_" but a value was input with code."
+32 SET WARNNUM=WARNNUM+1
SET SUB=WARNNUM_"W"
SET PXAERR(SUB)=TEXT
End DoDot:1
+33 ;
+34 IF WARNNUM=0
QUIT
+35 SET PXADI("DIALOG")=8390001.003
+36 SET PXAERRW("SCC")=1
+37 DO ERR^PXAI("SCC",1)
+38 QUIT
+39 ;
VALSCC ;--VALIDATE SERVICE CONNECTIVENESS
+1 NEW CODE,ERR,ERR1,ERRMSG,PXSAS,VALUE,X
+2 FOR X=1:1:8
Begin DoDot:1
+3 SET VALUE=$PIECE(AFTER800,U,X)
+4 SET CODE=$$NODETOCODE^PXSPECAUTH(X)
+5 SET PXSAS(CODE)=VALUE
End DoDot:1
+6 DO VALSA(.PXAERR,$GET(PXAVISIT),.PXAA,.PXSAS)
+7 QUIT
+8 ;
VPKG(EPKG,PKG) ;Is the Package parameter valid?
+1 IF EPKG'=""
QUIT EPKG
+2 IF $GET(PKG)=""
Begin DoDot:1
+3 SET PXAERR(7)="ENCOUNTER"
+4 SET PXAERR(9)="DATA2PCE parameter: PKG"
+5 SET PXAERR(12)="PKG is required and it is NULL."
+6 DO ERRSET
End DoDot:1
QUIT 0
+7 NEW PIEN
+8 SET PIEN=$$VPKG^PXAIVAL($GET(PKG),.PXAERR)
+9 IF PIEN=0
Begin DoDot:1
+10 SET PXAERR(7)="PACKAGE"
+11 DO ERRSET
End DoDot:1
QUIT 0
+12 QUIT PIEN
+13 ;
VPTR(VISITIEN) ;Is the Visit pointer valid?
+1 IF '$DATA(^AUPNVSIT(VISITIEN,0))
Begin DoDot:1
+2 SET PXAERR(7)="VISIT POINTER"
+3 SET PXAERR(9)="DATA2PCE parameter: VISIT"
+4 SET PXAERR(11)=VISITIEN
+5 SET PXAERR(12)="The Visit pointer that was input is not valid."
+6 DO ERRSET
End DoDot:1
+7 QUIT
+8 ;
VSOURCE(PXAPKG,ESRC,SOURCE) ;Is the Data Source valid?
+1 ;Scheduling creates encounters using Visit Tracking, it does not call
+2 ;DATA2PCE and it does not set Source.
+3 IF $PIECE(^DIC(9.4,PXAPKG,0),U,1)="SCHEDULING"
QUIT ""
+4 IF ESRC'=""
QUIT ESRC
+5 IF $GET(SOURCE)=""
Begin DoDot:1
+6 SET PXAERR(7)="ENCOUNTER"
+7 SET PXAERR(9)="DATA2PCE parameter: SOURCE"
+8 SET PXAERR(12)="SOURCE is required and it is NULL."
+9 DO ERRSET
End DoDot:1
QUIT 0
+10 NEW SRC
+11 SET SRC=$$VSOURCE^PXAIVAL($GET(SOURCE),.PXAERR)
+12 IF SRC=0
Begin DoDot:1
+13 SET PXAERR(7)="DATA SOURCE"
+14 DO ERRSET
End DoDot:1
QUIT 0
+15 QUIT SRC
+16 ;
VUSER(USER) ;If the user is passed, validate it.
+1 IF $GET(USER)=""
QUIT
+2 IF '$DATA(^VA(200,USER,0))
Begin DoDot:1
+3 SET PXAERR(7)="ENCOUNTER"
+4 SET PXAERR(9)="DATA2PCE parameter USER"
+5 SET PXAERR(11)="The value is: "_USER
+6 SET PXAERR(12)=USER_" is not a valid pointer to the New Person file #200."
+7 DO ERRSET
End DoDot:1
QUIT
+8 QUIT
