PXAIVSTV ;ISL/JVS,PKR ISA/KWP - VALIDATE THE VISIT DATA ;09/09/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**9,15,19,74,111,116,130,124,168,211**;Aug 12, 1996;Build 454
;
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
;
VALSCC ;--VALIDATE SERVICE CONNECTIVENESS
N ERR,ERR1,ERRMSG
D SCC^PXUTLSCC($G(PXAA("PATIENT")),$G(PXAA("ENC D/T")),$G(PXAA("HOS LOC")),$G(PXAVISIT),$G(AFTER800),.AFTER8A,.ERR)
;PX*1*111 - Add HNC
I $P(ERR,"^",1)=0,$P(ERR,"^",2)=0,$P(ERR,"^",3)=0,$P(ERR,"^",4)=0,$P(ERR,"^",5)=0,$P(ERR,"^",6)=0,$P(ERR,"^",7)=0,$P(ERR,"^",8)=0 Q
;
S ERRMSG(-1)="Not a valid value"
S ERRMSG(-2)="Value must be NULL"
S ERRMSG(-3)="Must be NULL because Service Connected is yes"
S ERRMSG(0)="No error"
S ERRMSG(1)="Should be a YES or NO!, not NULL"
;
S PXADI("DIALOG")=8390001.003
S PXAERRW=1
;
S PXAERR("1W")=$S($P(AFTER800,"^",1)']"":"NULL",1:$P(AFTER800,"^",1))
S PXAERR("2W")=$S($P(AFTER800,"^",2)']"":"NULL",1:$P(AFTER800,"^",2))
S PXAERR("3W")=$S($P(AFTER800,"^",3)']"":"NULL",1:$P(AFTER800,"^",3))
S PXAERR("4W")=$S($P(AFTER800,"^",4)']"":"NULL",1:$P(AFTER800,"^",4))
S PXAERR("5W")=$S($P(AFTER800,"^",5)']"":"NULL",1:$P(AFTER800,"^",5))
;PX*1*111 - Add HNC
S PXAERR("16W")=$S($P(AFTER800,"^",6)']"":"NULL",1:$P(AFTER800,"^",6))
S PXAERR("19W")=$S($P(AFTER800,"^",7)']"":"NULL",1:$P(AFTER800,"^",7))
S PXAERR("22W")=$S($P(AFTER800,"^",8)']"":"NULL",1:$P(AFTER800,"^",8))
;
S ERR1=$P(ERR,"^",1),PXAERR("6W")=ERRMSG(ERR1)
S ERR1=$P(ERR,"^",2),PXAERR("7W")=ERRMSG(ERR1)
S ERR1=$P(ERR,"^",3),PXAERR("8W")=ERRMSG(ERR1)
S ERR1=$P(ERR,"^",4),PXAERR("9W")=ERRMSG(ERR1)
S ERR1=$P(ERR,"^",5),PXAERR("10W")=ERRMSG(ERR1)
;PX*1*111 - Add HNC
S PXAERR("11W")=$S($P(AFTER8A,"^",1)']"":"NULL",1:$P(AFTER8A,"^",1))
S PXAERR("12W")=$S($P(AFTER8A,"^",2)']"":"NULL",1:$P(AFTER8A,"^",2))
S PXAERR("13W")=$S($P(AFTER8A,"^",3)']"":"NULL",1:$P(AFTER8A,"^",3))
S PXAERR("14W")=$S($P(AFTER8A,"^",4)']"":"NULL",1:$P(AFTER8A,"^",4))
S PXAERR("15W")=$S($P(AFTER8A,"^",5)']"":"NULL",1:$P(AFTER8A,"^",5))
;
S ERR1=$P(ERR,"^",6),PXAERR("17W")=ERRMSG(ERR1)
S ERR1=$P(ERR,"^",7),PXAERR("20W")=ERRMSG(ERR1)
S ERR1=$P(ERR,"^",8),PXAERR("23W")=ERRMSG(ERR1)
;PX*1*111 - Add HNC
S PXAERR("18W")=$S($P(AFTER8A,"^",6)']"":"NULL",1:$P(AFTER8A,"^",6))
S PXAERR("21W")=$S($P(AFTER8A,"^",7)']"":"NULL",1:$P(AFTER8A,"^",7))
S PXAERR("24W")=$S($P(AFTER8A,"^",8)']"":"NULL",1:$P(AFTER8A,"^",8))
D ERR^PXAI("SCC",1)
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 9874 printed Apr 09, 2024@21:31:34 Page 2
PXAIVSTV ;ISL/JVS,PKR ISA/KWP - VALIDATE THE VISIT DATA ;09/09/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,15,19,74,111,116,130,124,168,211**;Aug 12, 1996;Build 454
+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 ;
VALSCC ;--VALIDATE SERVICE CONNECTIVENESS
+1 NEW ERR,ERR1,ERRMSG
+2 DO SCC^PXUTLSCC($GET(PXAA("PATIENT")),$GET(PXAA("ENC D/T")),$GET(PXAA("HOS LOC")),$GET(PXAVISIT),$GET(AFTER800),.AFTER8A,.ERR)
+3 ;PX*1*111 - Add HNC
+4 IF $PIECE(ERR,"^",1)=0
IF $PIECE(ERR,"^",2)=0
IF $PIECE(ERR,"^",3)=0
IF $PIECE(ERR,"^",4)=0
IF $PIECE(ERR,"^",5)=0
IF $PIECE(ERR,"^",6)=0
IF $PIECE(ERR,"^",7)=0
IF $PIECE(ERR,"^",8)=0
QUIT
+5 ;
+6 SET ERRMSG(-1)="Not a valid value"
+7 SET ERRMSG(-2)="Value must be NULL"
+8 SET ERRMSG(-3)="Must be NULL because Service Connected is yes"
+9 SET ERRMSG(0)="No error"
+10 SET ERRMSG(1)="Should be a YES or NO!, not NULL"
+11 ;
+12 SET PXADI("DIALOG")=8390001.003
+13 SET PXAERRW=1
+14 ;
+15 SET PXAERR("1W")=$SELECT($PIECE(AFTER800,"^",1)']"":"NULL",1:$PIECE(AFTER800,"^",1))
+16 SET PXAERR("2W")=$SELECT($PIECE(AFTER800,"^",2)']"":"NULL",1:$PIECE(AFTER800,"^",2))
+17 SET PXAERR("3W")=$SELECT($PIECE(AFTER800,"^",3)']"":"NULL",1:$PIECE(AFTER800,"^",3))
+18 SET PXAERR("4W")=$SELECT($PIECE(AFTER800,"^",4)']"":"NULL",1:$PIECE(AFTER800,"^",4))
+19 SET PXAERR("5W")=$SELECT($PIECE(AFTER800,"^",5)']"":"NULL",1:$PIECE(AFTER800,"^",5))
+20 ;PX*1*111 - Add HNC
+21 SET PXAERR("16W")=$SELECT($PIECE(AFTER800,"^",6)']"":"NULL",1:$PIECE(AFTER800,"^",6))
+22 SET PXAERR("19W")=$SELECT($PIECE(AFTER800,"^",7)']"":"NULL",1:$PIECE(AFTER800,"^",7))
+23 SET PXAERR("22W")=$SELECT($PIECE(AFTER800,"^",8)']"":"NULL",1:$PIECE(AFTER800,"^",8))
+24 ;
+25 SET ERR1=$PIECE(ERR,"^",1)
SET PXAERR("6W")=ERRMSG(ERR1)
+26 SET ERR1=$PIECE(ERR,"^",2)
SET PXAERR("7W")=ERRMSG(ERR1)
+27 SET ERR1=$PIECE(ERR,"^",3)
SET PXAERR("8W")=ERRMSG(ERR1)
+28 SET ERR1=$PIECE(ERR,"^",4)
SET PXAERR("9W")=ERRMSG(ERR1)
+29 SET ERR1=$PIECE(ERR,"^",5)
SET PXAERR("10W")=ERRMSG(ERR1)
+30 ;PX*1*111 - Add HNC
+31 SET PXAERR("11W")=$SELECT($PIECE(AFTER8A,"^",1)']"":"NULL",1:$PIECE(AFTER8A,"^",1))
+32 SET PXAERR("12W")=$SELECT($PIECE(AFTER8A,"^",2)']"":"NULL",1:$PIECE(AFTER8A,"^",2))
+33 SET PXAERR("13W")=$SELECT($PIECE(AFTER8A,"^",3)']"":"NULL",1:$PIECE(AFTER8A,"^",3))
+34 SET PXAERR("14W")=$SELECT($PIECE(AFTER8A,"^",4)']"":"NULL",1:$PIECE(AFTER8A,"^",4))
+35 SET PXAERR("15W")=$SELECT($PIECE(AFTER8A,"^",5)']"":"NULL",1:$PIECE(AFTER8A,"^",5))
+36 ;
+37 SET ERR1=$PIECE(ERR,"^",6)
SET PXAERR("17W")=ERRMSG(ERR1)
+38 SET ERR1=$PIECE(ERR,"^",7)
SET PXAERR("20W")=ERRMSG(ERR1)
+39 SET ERR1=$PIECE(ERR,"^",8)
SET PXAERR("23W")=ERRMSG(ERR1)
+40 ;PX*1*111 - Add HNC
+41 SET PXAERR("18W")=$SELECT($PIECE(AFTER8A,"^",6)']"":"NULL",1:$PIECE(AFTER8A,"^",6))
+42 SET PXAERR("21W")=$SELECT($PIECE(AFTER8A,"^",7)']"":"NULL",1:$PIECE(AFTER8A,"^",7))
+43 SET PXAERR("24W")=$SELECT($PIECE(AFTER8A,"^",8)']"":"NULL",1:$PIECE(AFTER8A,"^",8))
+44 DO ERR^PXAI("SCC",1)
+45 QUIT
+46 ;
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
+9 ;
