Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXUTLSCC

PXUTLSCC.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. ;
  1. SCC(PXUPAT,PXUDT,PXUHLOC,PXUTLVST,PXUIN,PXUOUT,PXUERR) ;
  1. ;+Input Parameters:
  1. ;+ PXUPAT IEN of patient
  1. ;+ PXUDT date and time of the encounter
  1. ;+ PXUHLOC Hospital Location of the enocunter
  1. ;+ PXUTLVST (optional) pointer to the visit that is being used
  1. ;+ PXUIN service connected^agent orange^ionizing radiation
  1. ;+ ^enviromental contaminants^military sexual trauma
  1. ;+ ^head and/or neck cancer
  1. ;+ where 1 ::= yes, 0 ::= no, null ::= n/a
  1. ;+
  1. ;+Output Parameters:
  1. ;+ PXUOUT this is PXUIN corrected so that the invalid answers
  1. ;+ are changed to null
  1. ;+ PXUERR this is a six piece value one for each condition as follows:
  1. ;+ 1 ::= should be yes or no, but it is null
  1. ;+ 0 ::= no error
  1. ;+ -1 ::= not valued value
  1. ;+ -2 ::= value must be null
  1. ;+ -3 ::= must be null because SC is yes
  1. ;
  1. N PXUITEM,PXUPSCC,PXUSC,PXUAO,PXUIR,PXUEC,PXUMST,PXUHNC
  1. D SCCOND(PXUPAT,PXUDT,PXUHLOC,$G(PXUTLVST),.PXUPSCC) ;Set up array of the patients SCC
  1. S PXUOUT=PXUIN
  1. S PXUERR="0^0^0^0^0^0"
  1. S PXUSC=$P(PXUIN,"^",1)
  1. I '(PXUSC=1!(PXUSC=0)!(PXUSC="")) S $P(PXUERR,"^",1)=-1 S $P(PXUOUT,"^",1)=""
  1. E I PXUSC="" D ;it is ok
  1. . I $P(PXUPSCC("SC"),"^",1) S $P(PXUERR,"^",1)=1 ;should have had a value
  1. E I PXUSC]"" D
  1. . I '$P(PXUPSCC("SC"),"^",1) S $P(PXUERR,"^",1)=-2 S $P(PXUOUT,"^",1)="" ;it must be null
  1. . E ;it is ok
  1. S PXUSC=$P(PXUOUT,"^",1)
  1. S PXUAO=$P(PXUIN,"^",2)
  1. I '(PXUAO=1!(PXUAO=0)!(PXUAO="")) S $P(PXUERR,"^",2)=-1 S $P(PXUOUT,"^",2)=""
  1. E I PXUAO="" D ;it is ok
  1. . I $P(PXUPSCC("AO"),"^",1),'PXUSC S $P(PXUERR,"^",2)=1 ;should have had a value
  1. E I PXUAO]"" D
  1. . I '$P(PXUPSCC("AO"),"^",1) S $P(PXUERR,"^",2)=-2 S $P(PXUOUT,"^",2)="" ;it must be null
  1. . E I PXUSC,PXUAO]"" S $P(PXUERR,"^",2)=-3 S $P(PXUOUT,"^",2)="" ;it is SC so it must be null
  1. . ;E ;it is ok
  1. S PXUIR=$P(PXUIN,"^",3)
  1. I '(PXUIR=1!(PXUIR=0)!(PXUIR="")) S $P(PXUERR,"^",3)=-1 S $P(PXUOUT,"^",3)=""
  1. E I PXUIR="" D ;it is ok
  1. . I $P(PXUPSCC("IR"),"^",1),'PXUSC S $P(PXUERR,"^",3)=1 ;should have had a value
  1. E I PXUIR]"" D
  1. . I '$P(PXUPSCC("IR"),"^",1) S $P(PXUERR,"^",3)=-2 S $P(PXUOUT,"^",3)="" ;it must be null
  1. . E I PXUSC,PXUIR]"" S $P(PXUERR,"^",3)=-3 S $P(PXUOUT,"^",3)="" ;it is SC so it must be null
  1. . ;E ;it is ok
  1. S PXUEC=$P(PXUIN,"^",4)
  1. I '(PXUEC=1!(PXUEC=0)!(PXUEC="")) S $P(PXUERR,"^",4)=-1 S $P(PXUOUT,"^",4)=""
  1. E I PXUEC="" D ;it is ok
  1. . I $P(PXUPSCC("EC"),"^",1),'PXUSC S $P(PXUERR,"^",4)=1 ;should have had a value
  1. E I PXUEC]"" D
  1. . I '$P(PXUPSCC("EC"),"^",1) S $P(PXUERR,"^",4)=-2 S $P(PXUOUT,"^",4)="" ;it must be null
  1. . E I PXUSC,PXUEC]"" S $P(PXUERR,"^",4)=-3 S $P(PXUOUT,"^",4)="" ;it is SC so it must be null
  1. . ;E ;it is ok
  1. S PXUMST=$P(PXUIN,"^",5) ;MST not dependent on SC question
  1. I '(PXUMST=1!(PXUMST=0)!(PXUMST="")) S $P(PXUERR,"^",5)=-1 S $P(PXUOUT,"^",5)="" ;not valid data
  1. E I PXUMST]"" D
  1. .I '$P(PXUPSCC("MST"),"^",1) S $P(PXUERR,"^",5)=-2 S $P(PXUOUT,"^",5)="" ;it must be null, not MST status
  1. ;PX*1*111 - Add Head & Neck
  1. S PXUHNC=$P(PXUIN,"^",6) ;HNC not dependent on SC question
  1. I '(PXUHNC=1!(PXUHNC=0)!(PXUHNC="")) S $P(PXUERR,"^",6)=-1 S $P(PXUOUT,"^",6)="" ;not valid data
  1. E I PXUHNC]"" D
  1. .I '$P(PXUPSCC("HNC"),"^",1) S $P(PXUERR,"^",6)=-2 S $P(PXUOUT,"^",6)="" ;it must be null, not HNC status
  1. Q
  1. ;
  1. ;
  1. SCCOND(DFN,APPDT,HLOC,VISIT,PXUDATA) ;Set up array of the patients
  1. ; Service Connected Conditions
  1. ;
  1. ;Input Parameters:
  1. ; DFN IEN of patient
  1. ; APPDT date and time of the encounter
  1. ; HLOC Hospital Location of the enocunter
  1. ; VISIT (optional) The visit that is being used
  1. ;
  1. ;Output Parameters:
  1. ; PXUDATA this is an array subscriped by "SC","AO","IR","EC","MST","HNC"
  1. ; that contains to piece each
  1. ; first: 1 if the condition can be answered
  1. ; 0 if it should be null
  1. ; second: the answer that Scheduling has if it has one
  1. ; 1 ::= yes, 0 ::= no
  1. ;
  1. N CLASSIF,XX,OUTENC,CL,END,X0,MNE
  1. S OUTENC=""
  1. I VISIT>0 D
  1. .S OUTENC=$O(^SCE("AVSIT",VISIT,0))
  1. .I OUTENC>0,$P(^SCE(OUTENC,0),U,6) S OUTENC=$P(^SCE(OUTENC,0),U,6)
  1. I 'VISIT D
  1. .; Call if they have an appointment for this hospital location
  1. .; and there is an Outpatient Encounter IEN;
  1. .; returns the answer that scheduling has if any
  1. .I $G(^DPT(DFN,"S",APPDT,0))]"" S XX=$G(^(0)) I +XX=HLOC D
  1. ..S OUTENC=$P(XX,U,20)
  1. .Q:OUTENC
  1. .;
  1. .; Find an Outpatient encouter matching DFN APPDT,HLOC if any.
  1. .S OUTENC=$$EXAE^SDOE(DFN,APPDT,APPDT) D VEROUT
  1. ;
  1. ;Do Outpatient Encounter checks
  1. I OUTENC D
  1. .I '$D(^SCE(OUTENC,0)) S OUTENC="" Q
  1. .S X0=^SCE(OUTENC,0),END=0 D ENCHK(OUTENC,X0)
  1. .I END S OUTENC=""
  1. I OUTENC>0 D CLOE^SDCO21(OUTENC,.CLASSIF)
  1. ;
  1. I '$G(OUTENC) D CL^SDCO21(DFN,APPDT,"",.CLASSIF)
  1. S XX=0
  1. F S XX=$O(^SD(409.41,XX)) Q:XX'>0 D
  1. .S MNE=$P($G(^SD(409.41,XX,0)),U,7) I $D(MNE) D
  1. ..S PXUDATA(MNE)=$D(CLASSIF(XX))_U_$P($G(CLASSIF(XX)),U,2)
  1. Q
  1. ENCHK(ENCOWNTR,X0) ;Do outpatient encounter checks
  1. N LOC,ORG,DFN
  1. S DFN=$P(X0,U,2),LOC=$P(X0,U,4),ORG=$P(X0,U,8)
  1. I $$REQ^SDM1A(+X0)'="CO" S END=1 Q ;Check MAS Check out date parameter
  1. I ORG=1,'$$CLINIC^SDAMU(+LOC) S END=1 Q ;Screen for valid clinic
  1. I "^1^2^"[("^"_ORG_"^"),$$INP^SDAM2(+DFN,+X0)="I" S END=1 Q ;Inpat chk
  1. I $$EXOE^SDCOU2(ENCOWNTR) S END=1 Q ;Chk exempt Outpt classification
  1. Q
  1. VEROUT ;verify a clinic
  1. Q:'OUTENC
  1. S CL=$$GETOE^SDOE(OUTENC) I $P(CL,U,4)'=HLOC S OUTENC=""
  1. Q
  1. ;