PXUTLSCC ;ISL/DEE,ISA/KWP - Validates and corrects the Service Connected Conditions ;Dec 31, 2025@13:19:16
;;1.0;PCE PATIENT CARE ENCOUNTER;**74,107,111,130,168,211,244**;Aug 12, 1996;Build 37
;
; Reference to $$EXAE^SDOE in ICR #2546
; Reference to $$GETOE^SDOE in ICR #2546
; Reference to CLOE^SDCO21 in ICR #1300
; Reference to CL^SDCO21 in ICR #1300
; Reference to $$REQ^SDM1A in ICR #1583
; Reference to $$CLINIC^SDAMU in ICR #1580
; Reference to $$INP^SDAM2 in ICR #1582
; Reference to $$EXOE^SDCOU2 in ICR #1015
; Reference to ^SCE("AVSIT" in ICR #2088
; Reference to ^SCE( in ICR #2065
; Reference to ^DPT( in ICR #1301
; Reference to ^SD(409.41 in ICR #2083
;
Q
;
CLEANMSG(ERRMSG) ;Cleanup the error message by removing fields with no error.
N CORR,CORRFLD,FIELD,IND,JND,TEMP,TEXT
S (CORR,IND,JND)=0
F S IND=$O(ERRMSG("DIERR",1,"TEXT",IND)) Q:IND="" D
. S TEMP=ERRMSG("DIERR",1,"TEXT",IND)
. I TEMP="" Q
. I TEMP["Corrected to" S CORR=1,JND=JND+1,TEXT(JND)=TEMP
. I TEMP["No error" Q
. I CORR=0 S JND=JND+1,TEXT(JND)=TEMP,CORRFLD($P(TEMP,".",1))=""
. I CORR=1 D
.. S FIELD=$P(TEMP,".",1)
.. I $D(CORRFLD(FIELD)) S JND=JND+1,TEXT(JND)=TEMP
K ERRMSG("DIERR")
M ERRMSG("DIERR",1,"TEXT")=TEXT
Q
;
SCC(PXUPAT,PXUDT,PXUHLOC,PXUTLVST,PXUIN,PXUOUT,PXUERR) ;
;+Input Parameters:
;+ PXUPAT IEN of patient
;+ PXUDT date and time of the encounter
;+ PXUHLOC Hospital Location of the encounter
;+ PXUTLVST (optional) pointer to the visit that is being used
;+ PXUIN service connected^agent orange^ionizing radiation
;+ ^enviromental contaminants^military sexual trauma
;+ ^head and/or neck cancer
;+ where 1 ::= yes, 0 ::= no, null ::= n/a
;+
;+Output Parameters:
;+ PXUOUT this is PXUIN corrected so that the invalid answers
;+ are changed to null
;+ PXUERR this is a six piece value one for each condition as follows:
;+ 1 ::= should be yes or no, but it is null
;+ 0 ::= no error
;+ -1 ::= not valued value
;+ -2 ::= value must be null
;+ -3 ::= must be null because SC is yes
;
N CODE,PXAA,VALUE,X
S PXAA("PATIENT")=PXUPAT,PXAA("ENC D/T")=PXUDT,PXAA("HOS LOC")=PXUHLOC
F X=1:1:8 D
.S VALUE=$P(PXUIN,U,X)
.S CODE=$$NODETOCODE^PXSPECAUTH(X)
.S PXUOUT(CODE)=VALUE
D VALSA^PXAIVSTV(.PXUERR,$G(PXUTLVST),.PXAA,.PXUOUT)
Q
;
;
SCCOND(DFN,APPDT,HLOC,VISIT,PXUDATA) ;Set up array of the patients
; Service Connected Conditions
;
;Input Parameters:
; DFN IEN of patient
; APPDT date and time of the encounter
; HLOC Hospital Location of the enocunter
; VISIT (optional) The visit that is being used
;
;Output Parameters:
; PXUDATA this is an array subscripted by "SC","AO","IR","EC","MST",
; "HNC" that contains to piece each
; first: 1 if the condition can be answered
; 0 if it should be null
; second: the answer that Scheduling has if it has one
; 1 ::= yes, 0 ::= no
;
N CLASSIF,XX,OUTENC,CL,END,X0,MNE
S OUTENC=""
I VISIT>0 D
.S OUTENC=$O(^SCE("AVSIT",VISIT,0))
.I OUTENC>0,$P(^SCE(OUTENC,0),U,6) S OUTENC=$P(^SCE(OUTENC,0),U,6)
I 'VISIT D
.; Call if they have an appointment for this hospital location
.; and there is an Outpatient Encounter IEN;
.; returns the answer that scheduling has if any
.I $G(^DPT(DFN,"S",APPDT,0))]"" S XX=$G(^(0)) I +XX=HLOC D
..S OUTENC=$P(XX,U,20)
.Q:OUTENC
.;
.; Find an Outpatient encounter matching DFN APPDT,HLOC if any.
.S OUTENC=$$EXAE^SDOE(DFN,APPDT,APPDT) D VEROUT
;
;Do Outpatient Encounter checks
I OUTENC D
.I '$D(^SCE(OUTENC,0)) S OUTENC="" Q
.S X0=^SCE(OUTENC,0),END=0 D ENCHK(OUTENC,X0)
.I END S OUTENC=""
I OUTENC>0 D CLOE^SDCO21(OUTENC,.CLASSIF)
;
I '$G(OUTENC) D CL^SDCO21(DFN,APPDT,"",.CLASSIF)
S XX=0
F S XX=$O(^SD(409.41,XX)) Q:XX'>0 D
.S MNE=$P($G(^SD(409.41,XX,0)),U,7) I $D(MNE) D
..S PXUDATA(MNE)=$D(CLASSIF(XX))_U_$P($G(CLASSIF(XX)),U,2)
Q
ENCHK(ENCOWNTR,X0) ;Do outpatient encounter checks
N LOC,ORG,DFN
S DFN=$P(X0,U,2),LOC=$P(X0,U,4),ORG=$P(X0,U,8)
I $$REQ^SDM1A(+X0)'="CO" S END=1 Q ;Check MAS Check out date parameter
I ORG=1,'$$CLINIC^SDAMU(+LOC) S END=1 Q ;Screen for valid clinic
I "^1^2^"[("^"_ORG_"^"),$$INP^SDAM2(+DFN,+X0)="I" S END=1 Q ;Inpat chk
I $$EXOE^SDCOU2(ENCOWNTR) S END=1 Q ;Chk exempt Outpt classification
Q
VEROUT ;verify a clinic
Q:'OUTENC
S CL=$$GETOE^SDOE(OUTENC) I $P(CL,U,4)'=HLOC S OUTENC=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXUTLSCC 4578 printed Jul 11, 2026@02:28:02 Page 2
PXUTLSCC ;ISL/DEE,ISA/KWP - Validates and corrects the Service Connected Conditions ;Dec 31, 2025@13:19:16
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**74,107,111,130,168,211,244**;Aug 12, 1996;Build 37
+2 ;
+3 ; Reference to $$EXAE^SDOE in ICR #2546
+4 ; Reference to $$GETOE^SDOE in ICR #2546
+5 ; Reference to CLOE^SDCO21 in ICR #1300
+6 ; Reference to CL^SDCO21 in ICR #1300
+7 ; Reference to $$REQ^SDM1A in ICR #1583
+8 ; Reference to $$CLINIC^SDAMU in ICR #1580
+9 ; Reference to $$INP^SDAM2 in ICR #1582
+10 ; Reference to $$EXOE^SDCOU2 in ICR #1015
+11 ; Reference to ^SCE("AVSIT" in ICR #2088
+12 ; Reference to ^SCE( in ICR #2065
+13 ; Reference to ^DPT( in ICR #1301
+14 ; Reference to ^SD(409.41 in ICR #2083
+15 ;
+16 QUIT
+17 ;
CLEANMSG(ERRMSG) ;Cleanup the error message by removing fields with no error.
+1 NEW CORR,CORRFLD,FIELD,IND,JND,TEMP,TEXT
+2 SET (CORR,IND,JND)=0
+3 FOR
SET IND=$ORDER(ERRMSG("DIERR",1,"TEXT",IND))
if IND=""
QUIT
Begin DoDot:1
+4 SET TEMP=ERRMSG("DIERR",1,"TEXT",IND)
+5 IF TEMP=""
QUIT
+6 IF TEMP["Corrected to"
SET CORR=1
SET JND=JND+1
SET TEXT(JND)=TEMP
+7 IF TEMP["No error"
QUIT
+8 IF CORR=0
SET JND=JND+1
SET TEXT(JND)=TEMP
SET CORRFLD($PIECE(TEMP,".",1))=""
+9 IF CORR=1
Begin DoDot:2
+10 SET FIELD=$PIECE(TEMP,".",1)
+11 IF $DATA(CORRFLD(FIELD))
SET JND=JND+1
SET TEXT(JND)=TEMP
End DoDot:2
End DoDot:1
+12 KILL ERRMSG("DIERR")
+13 MERGE ERRMSG("DIERR",1,"TEXT")=TEXT
+14 QUIT
+15 ;
SCC(PXUPAT,PXUDT,PXUHLOC,PXUTLVST,PXUIN,PXUOUT,PXUERR) ;
+1 ;+Input Parameters:
+2 ;+ PXUPAT IEN of patient
+3 ;+ PXUDT date and time of the encounter
+4 ;+ PXUHLOC Hospital Location of the encounter
+5 ;+ PXUTLVST (optional) pointer to the visit that is being used
+6 ;+ PXUIN service connected^agent orange^ionizing radiation
+7 ;+ ^enviromental contaminants^military sexual trauma
+8 ;+ ^head and/or neck cancer
+9 ;+ where 1 ::= yes, 0 ::= no, null ::= n/a
+10 ;+
+11 ;+Output Parameters:
+12 ;+ PXUOUT this is PXUIN corrected so that the invalid answers
+13 ;+ are changed to null
+14 ;+ PXUERR this is a six piece value one for each condition as follows:
+15 ;+ 1 ::= should be yes or no, but it is null
+16 ;+ 0 ::= no error
+17 ;+ -1 ::= not valued value
+18 ;+ -2 ::= value must be null
+19 ;+ -3 ::= must be null because SC is yes
+20 ;
+21 NEW CODE,PXAA,VALUE,X
+22 SET PXAA("PATIENT")=PXUPAT
SET PXAA("ENC D/T")=PXUDT
SET PXAA("HOS LOC")=PXUHLOC
+23 FOR X=1:1:8
Begin DoDot:1
+24 SET VALUE=$PIECE(PXUIN,U,X)
+25 SET CODE=$$NODETOCODE^PXSPECAUTH(X)
+26 SET PXUOUT(CODE)=VALUE
End DoDot:1
+27 DO VALSA^PXAIVSTV(.PXUERR,$GET(PXUTLVST),.PXAA,.PXUOUT)
+28 QUIT
+29 ;
+30 ;
SCCOND(DFN,APPDT,HLOC,VISIT,PXUDATA) ;Set up array of the patients
+1 ; Service Connected Conditions
+2 ;
+3 ;Input Parameters:
+4 ; DFN IEN of patient
+5 ; APPDT date and time of the encounter
+6 ; HLOC Hospital Location of the enocunter
+7 ; VISIT (optional) The visit that is being used
+8 ;
+9 ;Output Parameters:
+10 ; PXUDATA this is an array subscripted by "SC","AO","IR","EC","MST",
+11 ; "HNC" that contains to piece each
+12 ; first: 1 if the condition can be answered
+13 ; 0 if it should be null
+14 ; second: the answer that Scheduling has if it has one
+15 ; 1 ::= yes, 0 ::= no
+16 ;
+17 NEW CLASSIF,XX,OUTENC,CL,END,X0,MNE
+18 SET OUTENC=""
+19 IF VISIT>0
Begin DoDot:1
+20 SET OUTENC=$ORDER(^SCE("AVSIT",VISIT,0))
+21 IF OUTENC>0
IF $PIECE(^SCE(OUTENC,0),U,6)
SET OUTENC=$PIECE(^SCE(OUTENC,0),U,6)
End DoDot:1
+22 IF 'VISIT
Begin DoDot:1
+23 ; Call if they have an appointment for this hospital location
+24 ; and there is an Outpatient Encounter IEN;
+25 ; returns the answer that scheduling has if any
+26 IF $GET(^DPT(DFN,"S",APPDT,0))]""
SET XX=$GET(^(0))
IF +XX=HLOC
Begin DoDot:2
+27 SET OUTENC=$PIECE(XX,U,20)
End DoDot:2
+28 if OUTENC
QUIT
+29 ;
+30 ; Find an Outpatient encounter matching DFN APPDT,HLOC if any.
+31 SET OUTENC=$$EXAE^SDOE(DFN,APPDT,APPDT)
DO VEROUT
End DoDot:1
+32 ;
+33 ;Do Outpatient Encounter checks
+34 IF OUTENC
Begin DoDot:1
+35 IF '$DATA(^SCE(OUTENC,0))
SET OUTENC=""
QUIT
+36 SET X0=^SCE(OUTENC,0)
SET END=0
DO ENCHK(OUTENC,X0)
+37 IF END
SET OUTENC=""
End DoDot:1
+38 IF OUTENC>0
DO CLOE^SDCO21(OUTENC,.CLASSIF)
+39 ;
+40 IF '$GET(OUTENC)
DO CL^SDCO21(DFN,APPDT,"",.CLASSIF)
+41 SET XX=0
+42 FOR
SET XX=$ORDER(^SD(409.41,XX))
if XX'>0
QUIT
Begin DoDot:1
+43 SET MNE=$PIECE($GET(^SD(409.41,XX,0)),U,7)
IF $DATA(MNE)
Begin DoDot:2
+44 SET PXUDATA(MNE)=$DATA(CLASSIF(XX))_U_$PIECE($GET(CLASSIF(XX)),U,2)
End DoDot:2
End DoDot:1
+45 QUIT
ENCHK(ENCOWNTR,X0) ;Do outpatient encounter checks
+1 NEW LOC,ORG,DFN
+2 SET DFN=$PIECE(X0,U,2)
SET LOC=$PIECE(X0,U,4)
SET ORG=$PIECE(X0,U,8)
+3 ;Check MAS Check out date parameter
IF $$REQ^SDM1A(+X0)'="CO"
SET END=1
QUIT
+4 ;Screen for valid clinic
IF ORG=1
IF '$$CLINIC^SDAMU(+LOC)
SET END=1
QUIT
+5 ;Inpat chk
IF "^1^2^"[("^"_ORG_"^")
IF $$INP^SDAM2(+DFN,+X0)="I"
SET END=1
QUIT
+6 ;Chk exempt Outpt classification
IF $$EXOE^SDCOU2(ENCOWNTR)
SET END=1
QUIT
+7 QUIT
VEROUT ;verify a clinic
+1 if 'OUTENC
QUIT
+2 SET CL=$$GETOE^SDOE(OUTENC)
IF $PIECE(CL,U,4)'=HLOC
SET OUTENC=""
+3 QUIT
+4 ;
