- 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 ;