PXUTLSCC ;ISL/dee,ISA/KWP - Validates and corrects the Service Connected Conditions ;11/21/2019
;;1.0;PCE PATIENT CARE ENCOUNTER;**74,107,111,130,168,211**;Aug 12, 1996;Build 454
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 PXUCV,PXUITEM,PXUPSCC,PXUSC,PXUAO,PXUIR,PXUEC,PXUMST,PXUHNC,PXUSHAD
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^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,$P(PXUOUT,"^",1)=$P(PXUPSCC("SC"),"^",2) ;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,$P(PXUOUT,"^",2)=$P(PXUPSCC("AO"),"^",2) ;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,$P(PXUOUT,"^",3)=$P(PXUPSCC("IR"),"^",2) ;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,$P(PXUOUT,"^",4)=$P(PXUPSCC("EC"),"^",2) ;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 ;it is ok
. I $P(PXUPSCC("MST"),"^",1) S $P(PXUERR,"^",5)=1,$P(PXUOUT,"^",5)=$P(PXUPSCC("MST"),"^",2) ;should have had a value
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 ;it is ok
. I $P(PXUPSCC("HNC"),"^",1) S $P(PXUERR,"^",6)=1,$P(PXUOUT,"^",6)=$P(PXUPSCC("HNC"),"^",2) ;should have had a value
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
S PXUCV=$P(PXUIN,"^",7) ;CV not dependent on SC question
I '(PXUCV=1!(PXUCV=0)!(PXUCV="")) S $P(PXUERR,"^",7)=-1 S $P(PXUOUT,"^",7)="" ;not valid data
E I PXUCV="" D ;it is ok
. I $P(PXUPSCC("CV"),"^",1) S $P(PXUERR,"^",7)=1,$P(PXUOUT,"^",7)=$P(PXUPSCC("CV"),"^",2) ;should have had a value
E I PXUCV]"" D
.I '$P(PXUPSCC("CV"),"^",1) S $P(PXUERR,"^",7)=-2 S $P(PXUOUT,"^",7)="" ;it must be null, not CV status
S PXUSHAD=$P(PXUIN,"^",8) ;SHAD not dependent on SC question
I '(PXUSHAD=1!(PXUSHAD=0)!(PXUSHAD="")) S $P(PXUERR,"^",8)=-1 S $P(PXUOUT,"^",8)="" ;not valid data
E I PXUSHAD="" D ;it is ok
. I $P(PXUPSCC("SHAD"),"^",1) S $P(PXUERR,"^",8)=1,$P(PXUOUT,"^",8)=$P(PXUPSCC("SHAD"),"^",2) ;should have had a value
E I PXUSHAD]"" D
.I '$P(PXUPSCC("SHAD"),"^",1) S $P(PXUERR,"^",8)=-2 S $P(PXUOUT,"^",8)="" ;it must be null, not SHAD 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 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 7649 printed Apr 09, 2024@21:31:01 Page 2
PXUTLSCC ;ISL/dee,ISA/KWP - Validates and corrects the Service Connected Conditions ;11/21/2019
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**74,107,111,130,168,211**;Aug 12, 1996;Build 454
+2 QUIT
+3 ;
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 PXUCV,PXUITEM,PXUPSCC,PXUSC,PXUAO,PXUIR,PXUEC,PXUMST,PXUHNC,PXUSHAD
+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^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
SET $PIECE(PXUOUT,"^",1)=$PIECE(PXUPSCC("SC"),"^",2)
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
SET $PIECE(PXUOUT,"^",2)=$PIECE(PXUPSCC("AO"),"^",2)
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
SET $PIECE(PXUOUT,"^",3)=$PIECE(PXUPSCC("IR"),"^",2)
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
SET $PIECE(PXUOUT,"^",4)=$PIECE(PXUPSCC("EC"),"^",2)
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 ;it is ok
IF '$TEST
IF PXUMST=""
Begin DoDot:1
+60 ;should have had a value
IF $PIECE(PXUPSCC("MST"),"^",1)
SET $PIECE(PXUERR,"^",5)=1
SET $PIECE(PXUOUT,"^",5)=$PIECE(PXUPSCC("MST"),"^",2)
End DoDot:1
+61 IF '$TEST
IF PXUMST]""
Begin DoDot:1
+62 ;it must be null, not MST status
IF '$PIECE(PXUPSCC("MST"),"^",1)
SET $PIECE(PXUERR,"^",5)=-2
SET $PIECE(PXUOUT,"^",5)=""
End DoDot:1
+63 ;PX*1*111 - Add Head & Neck
+64 ;HNC not dependent on SC question
SET PXUHNC=$PIECE(PXUIN,"^",6)
+65 ;not valid data
IF '(PXUHNC=1!(PXUHNC=0)!(PXUHNC=""))
SET $PIECE(PXUERR,"^",6)=-1
SET $PIECE(PXUOUT,"^",6)=""
+66 ;it is ok
IF '$TEST
IF PXUHNC=""
Begin DoDot:1
+67 ;should have had a value
IF $PIECE(PXUPSCC("HNC"),"^",1)
SET $PIECE(PXUERR,"^",6)=1
SET $PIECE(PXUOUT,"^",6)=$PIECE(PXUPSCC("HNC"),"^",2)
End DoDot:1
+68 IF '$TEST
IF PXUHNC]""
Begin DoDot:1
+69 ;it must be null, not HNC status
IF '$PIECE(PXUPSCC("HNC"),"^",1)
SET $PIECE(PXUERR,"^",6)=-2
SET $PIECE(PXUOUT,"^",6)=""
End DoDot:1
+70 ;CV not dependent on SC question
SET PXUCV=$PIECE(PXUIN,"^",7)
+71 ;not valid data
IF '(PXUCV=1!(PXUCV=0)!(PXUCV=""))
SET $PIECE(PXUERR,"^",7)=-1
SET $PIECE(PXUOUT,"^",7)=""
+72 ;it is ok
IF '$TEST
IF PXUCV=""
Begin DoDot:1
+73 ;should have had a value
IF $PIECE(PXUPSCC("CV"),"^",1)
SET $PIECE(PXUERR,"^",7)=1
SET $PIECE(PXUOUT,"^",7)=$PIECE(PXUPSCC("CV"),"^",2)
End DoDot:1
+74 IF '$TEST
IF PXUCV]""
Begin DoDot:1
+75 ;it must be null, not CV status
IF '$PIECE(PXUPSCC("CV"),"^",1)
SET $PIECE(PXUERR,"^",7)=-2
SET $PIECE(PXUOUT,"^",7)=""
End DoDot:1
+76 ;SHAD not dependent on SC question
SET PXUSHAD=$PIECE(PXUIN,"^",8)
+77 ;not valid data
IF '(PXUSHAD=1!(PXUSHAD=0)!(PXUSHAD=""))
SET $PIECE(PXUERR,"^",8)=-1
SET $PIECE(PXUOUT,"^",8)=""
+78 ;it is ok
IF '$TEST
IF PXUSHAD=""
Begin DoDot:1
+79 ;should have had a value
IF $PIECE(PXUPSCC("SHAD"),"^",1)
SET $PIECE(PXUERR,"^",8)=1
SET $PIECE(PXUOUT,"^",8)=$PIECE(PXUPSCC("SHAD"),"^",2)
End DoDot:1
+80 IF '$TEST
IF PXUSHAD]""
Begin DoDot:1
+81 ;it must be null, not SHAD status
IF '$PIECE(PXUPSCC("SHAD"),"^",1)
SET $PIECE(PXUERR,"^",8)=-2
SET $PIECE(PXUOUT,"^",8)=""
End DoDot:1
+82 QUIT
+83 ;
+84 ;
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 ;
