PXUTLSCC ;ISL/dee,ISA/KWP - Validates and corrects the Service Connected Conditions ;7/23/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**74,107,111**;Aug 12, 1996
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 enocunter
;+ 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 PXUITEM,PXUPSCC,PXUSC,PXUAO,PXUIR,PXUEC,PXUMST,PXUHNC
D SCCOND(PXUPAT,PXUDT,PXUHLOC,$G(PXUTLVST),.PXUPSCC) ;Set up array of the patients SCC
S PXUOUT=PXUIN
S PXUERR="0^0^0^0^0^0"
S PXUSC=$P(PXUIN,"^",1)
I '(PXUSC=1!(PXUSC=0)!(PXUSC="")) S $P(PXUERR,"^",1)=-1 S $P(PXUOUT,"^",1)=""
E I PXUSC="" D ;it is ok
. I $P(PXUPSCC("SC"),"^",1) S $P(PXUERR,"^",1)=1 ;should have had a value
E I PXUSC]"" D
. I '$P(PXUPSCC("SC"),"^",1) S $P(PXUERR,"^",1)=-2 S $P(PXUOUT,"^",1)="" ;it must be null
. E ;it is ok
S PXUSC=$P(PXUOUT,"^",1)
S PXUAO=$P(PXUIN,"^",2)
I '(PXUAO=1!(PXUAO=0)!(PXUAO="")) S $P(PXUERR,"^",2)=-1 S $P(PXUOUT,"^",2)=""
E I PXUAO="" D ;it is ok
. I $P(PXUPSCC("AO"),"^",1),'PXUSC S $P(PXUERR,"^",2)=1 ;should have had a value
E I PXUAO]"" D
. I '$P(PXUPSCC("AO"),"^",1) S $P(PXUERR,"^",2)=-2 S $P(PXUOUT,"^",2)="" ;it must be null
. E I PXUSC,PXUAO]"" S $P(PXUERR,"^",2)=-3 S $P(PXUOUT,"^",2)="" ;it is SC so it must be null
. ;E ;it is ok
S PXUIR=$P(PXUIN,"^",3)
I '(PXUIR=1!(PXUIR=0)!(PXUIR="")) S $P(PXUERR,"^",3)=-1 S $P(PXUOUT,"^",3)=""
E I PXUIR="" D ;it is ok
. I $P(PXUPSCC("IR"),"^",1),'PXUSC S $P(PXUERR,"^",3)=1 ;should have had a value
E I PXUIR]"" D
. I '$P(PXUPSCC("IR"),"^",1) S $P(PXUERR,"^",3)=-2 S $P(PXUOUT,"^",3)="" ;it must be null
. E I PXUSC,PXUIR]"" S $P(PXUERR,"^",3)=-3 S $P(PXUOUT,"^",3)="" ;it is SC so it must be null
. ;E ;it is ok
S PXUEC=$P(PXUIN,"^",4)
I '(PXUEC=1!(PXUEC=0)!(PXUEC="")) S $P(PXUERR,"^",4)=-1 S $P(PXUOUT,"^",4)=""
E I PXUEC="" D ;it is ok
. I $P(PXUPSCC("EC"),"^",1),'PXUSC S $P(PXUERR,"^",4)=1 ;should have had a value
E I PXUEC]"" D
. I '$P(PXUPSCC("EC"),"^",1) S $P(PXUERR,"^",4)=-2 S $P(PXUOUT,"^",4)="" ;it must be null
. E I PXUSC,PXUEC]"" S $P(PXUERR,"^",4)=-3 S $P(PXUOUT,"^",4)="" ;it is SC so it must be null
. ;E ;it is ok
S PXUMST=$P(PXUIN,"^",5) ;MST not dependent on SC question
I '(PXUMST=1!(PXUMST=0)!(PXUMST="")) S $P(PXUERR,"^",5)=-1 S $P(PXUOUT,"^",5)="" ;not valid data
E I PXUMST]"" D
.I '$P(PXUPSCC("MST"),"^",1) S $P(PXUERR,"^",5)=-2 S $P(PXUOUT,"^",5)="" ;it must be null, not MST status
;PX*1*111 - Add Head & Neck
S PXUHNC=$P(PXUIN,"^",6) ;HNC not dependent on SC question
I '(PXUHNC=1!(PXUHNC=0)!(PXUHNC="")) S $P(PXUERR,"^",6)=-1 S $P(PXUOUT,"^",6)="" ;not valid data
E I PXUHNC]"" D
.I '$P(PXUPSCC("HNC"),"^",1) S $P(PXUERR,"^",6)=-2 S $P(PXUOUT,"^",6)="" ;it must be null, not HNC status
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 subscriped 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 encouter 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
;
PXUTLSCC ;ISL/dee,ISA/KWP - Validates and corrects the Service Connected Conditions ;7/23/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**74,107,111**;Aug 12, 1996
+2 QUIT
+3 ;
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 enocunter
+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 PXUITEM,PXUPSCC,PXUSC,PXUAO,PXUIR,PXUEC,PXUMST,PXUHNC
+22 ;Set up array of the patients SCC
DO SCCOND(PXUPAT,PXUDT,PXUHLOC,$GET(PXUTLVST),.PXUPSCC)
+23 SET PXUOUT=PXUIN
+24 SET PXUERR="0^0^0^0^0^0"
+25 SET PXUSC=$PIECE(PXUIN,"^",1)
+26 IF '(PXUSC=1!(PXUSC=0)!(PXUSC=""))
SET $PIECE(PXUERR,"^",1)=-1
SET $PIECE(PXUOUT,"^",1)=""
+27 ;it is ok
IF '$TEST
IF PXUSC=""
Begin DoDot:1
+28 ;should have had a value
IF $PIECE(PXUPSCC("SC"),"^",1)
SET $PIECE(PXUERR,"^",1)=1
End DoDot:1
+29 IF '$TEST
IF PXUSC]""
Begin DoDot:1
+30 ;it must be null
IF '$PIECE(PXUPSCC("SC"),"^",1)
SET $PIECE(PXUERR,"^",1)=-2
SET $PIECE(PXUOUT,"^",1)=""
+31 ;it is ok
IF '$TEST
End DoDot:1
+32 SET PXUSC=$PIECE(PXUOUT,"^",1)
+33 SET PXUAO=$PIECE(PXUIN,"^",2)
+34 IF '(PXUAO=1!(PXUAO=0)!(PXUAO=""))
SET $PIECE(PXUERR,"^",2)=-1
SET $PIECE(PXUOUT,"^",2)=""
+35 ;it is ok
IF '$TEST
IF PXUAO=""
Begin DoDot:1
+36 ;should have had a value
IF $PIECE(PXUPSCC("AO"),"^",1)
IF 'PXUSC
SET $PIECE(PXUERR,"^",2)=1
End DoDot:1
+37 IF '$TEST
IF PXUAO]""
Begin DoDot:1
+38 ;it must be null
IF '$PIECE(PXUPSCC("AO"),"^",1)
SET $PIECE(PXUERR,"^",2)=-2
SET $PIECE(PXUOUT,"^",2)=""
+39 ;it is SC so it must be null
IF '$TEST
IF PXUSC
IF PXUAO]""
SET $PIECE(PXUERR,"^",2)=-3
SET $PIECE(PXUOUT,"^",2)=""
+40 ;E ;it is ok
End DoDot:1
+41 SET PXUIR=$PIECE(PXUIN,"^",3)
+42 IF '(PXUIR=1!(PXUIR=0)!(PXUIR=""))
SET $PIECE(PXUERR,"^",3)=-1
SET $PIECE(PXUOUT,"^",3)=""
+43 ;it is ok
IF '$TEST
IF PXUIR=""
Begin DoDot:1
+44 ;should have had a value
IF $PIECE(PXUPSCC("IR"),"^",1)
IF 'PXUSC
SET $PIECE(PXUERR,"^",3)=1
End DoDot:1
+45 IF '$TEST
IF PXUIR]""
Begin DoDot:1
+46 ;it must be null
IF '$PIECE(PXUPSCC("IR"),"^",1)
SET $PIECE(PXUERR,"^",3)=-2
SET $PIECE(PXUOUT,"^",3)=""
+47 ;it is SC so it must be null
IF '$TEST
IF PXUSC
IF PXUIR]""
SET $PIECE(PXUERR,"^",3)=-3
SET $PIECE(PXUOUT,"^",3)=""
+48 ;E ;it is ok
End DoDot:1
+49 SET PXUEC=$PIECE(PXUIN,"^",4)
+50 IF '(PXUEC=1!(PXUEC=0)!(PXUEC=""))
SET $PIECE(PXUERR,"^",4)=-1
SET $PIECE(PXUOUT,"^",4)=""
+51 ;it is ok
IF '$TEST
IF PXUEC=""
Begin DoDot:1
+52 ;should have had a value
IF $PIECE(PXUPSCC("EC"),"^",1)
IF 'PXUSC
SET $PIECE(PXUERR,"^",4)=1
End DoDot:1
+53 IF '$TEST
IF PXUEC]""
Begin DoDot:1
+54 ;it must be null
IF '$PIECE(PXUPSCC("EC"),"^",1)
SET $PIECE(PXUERR,"^",4)=-2
SET $PIECE(PXUOUT,"^",4)=""
+55 ;it is SC so it must be null
IF '$TEST
IF PXUSC
IF PXUEC]""
SET $PIECE(PXUERR,"^",4)=-3
SET $PIECE(PXUOUT,"^",4)=""
+56 ;E ;it is ok
End DoDot:1
+57 ;MST not dependent on SC question
SET PXUMST=$PIECE(PXUIN,"^",5)
+58 ;not valid data
IF '(PXUMST=1!(PXUMST=0)!(PXUMST=""))
SET $PIECE(PXUERR,"^",5)=-1
SET $PIECE(PXUOUT,"^",5)=""
+59 IF '$TEST
IF PXUMST]""
Begin DoDot:1
+60 ;it must be null, not MST status
IF '$PIECE(PXUPSCC("MST"),"^",1)
SET $PIECE(PXUERR,"^",5)=-2
SET $PIECE(PXUOUT,"^",5)=""
End DoDot:1
+61 ;PX*1*111 - Add Head & Neck
+62 ;HNC not dependent on SC question
SET PXUHNC=$PIECE(PXUIN,"^",6)
+63 ;not valid data
IF '(PXUHNC=1!(PXUHNC=0)!(PXUHNC=""))
SET $PIECE(PXUERR,"^",6)=-1
SET $PIECE(PXUOUT,"^",6)=""
+64 IF '$TEST
IF PXUHNC]""
Begin DoDot:1
+65 ;it must be null, not HNC status
IF '$PIECE(PXUPSCC("HNC"),"^",1)
SET $PIECE(PXUERR,"^",6)=-2
SET $PIECE(PXUOUT,"^",6)=""
End DoDot:1
+66 QUIT
+67 ;
+68 ;
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 subscriped by "SC","AO","IR","EC","MST","HNC"
+11 ; 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 encouter 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 ;
