ECXNURS ;ALB/JAP,BIR/DMA,PTD-Nursing Extract for DSS ;9/13/10 13:59
;;3.0;DSS EXTRACTS;**8,14,22,24,33,39,46,71,107,127**;Dec 22, 1997;Build 36
BEG ;entry point from option
D SETUP I ECFILE="" Q
D ^ECXTRAC,^ECXKILL
Q
;
START ;entry when queued
;store in ^tmp by patient and date/time
N CNT,INP,FIRSTDAY,LASTDAY
S QFLG=0,CNT=0
K ^TMP("ECX",$J)
S FIRSTDAY=$P(ECSD1,".")+1,LASTDAY=$P(ECED,".")
S ECED=ECED+.3,ECD=ECSD1
F S ECD=$O(^NURSA(214.6,"B",ECD)),ECDA=0 Q:'ECD Q:ECD>ECED D Q:QFLG
.F S ECDA=$O(^NURSA(214.6,"B",ECD,ECDA)) Q:'ECDA D Q:QFLG
..K LOC S DIC=214.6,DIQ(0)="I",DA=ECDA,DIQ="LOC",DR=".01;.02;1;3;4;6;7;8"
..D EN^DIQ1 K DIQ,DIC,DA,DR
..F J=.01,.02,1,3,4,6,7,8 S EC(J)=LOC(214.6,ECDA,J,"I")
..Q:EC(8)'=""
..S INP=$$INP^ECXUTL2(EC(.02),EC(.01))
..;
..;- Don't create ^TMP record if outpatient and no treat spec
..Q:$P(INP,U)="O"&($P(INP,U,3)="")
..; retain latest classification per day per patient
..S ^TMP("ECX",$J,EC(.02),$P(EC(.01),"."))=EC(1)_U_EC(3)_U_EC(4)_U_EC(6)_U_EC(7)_U_$P(INP,U,1,6)_U_EC(.01)_U_$P(INP,U,10)
..K LOC(214.6,ECDA),EC,INP
..S CNT=CNT+1
..I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QFLG=1
I QFLG K ^TMP("ECX",$J) Q
D RESOLVE
D FILE
K ^TMP("ECX",$J)
;
RESOLVE ;process ^tmp by patient
N DFN,TM,ECD,ECDPREV,ECDNEW,OLDWARD,NEWWARD,NEWDT
S DFN=0
F S DFN=$O(^TMP("ECX",$J,DFN)) S ECD=0 Q:'DFN D
.;remove any classifications for day of discharge
.F S ECD=$O(^TMP("ECX",$J,DFN,ECD)) Q:'ECD D
..I ECD=$P($P(^TMP("ECX",$J,DFN,ECD),U,11),".") K ^TMP("ECX",$J,DFN,ECD)
.;proceed only if ^tmp remains
.Q:'$D(^TMP("ECX",$J,DFN))
.;proceed with fill-in only if processing more than 3 days' data
.Q:LASTDAY<(FIRSTDAY+2)
.;fill-in records for any missing days per inpatient episode
.K TM S ECD=0
.F S ECD=$O(^TMP("ECX",$J,DFN,ECD)) Q:'ECD D
..S TM(ECD)=$P(^TMP("ECX",$J,DFN,ECD),U,9)
.S (ECD,ECDPREV)=0
.F S ECD=$O(TM(ECD)) Q:'ECD D
..I ECDPREV=0 S ECDPREV=ECD Q
..I (ECD-ECDPREV)>1,+TM(ECD)=+TM(ECDPREV) D
...F ECDNEW=ECDPREV+1:1:ECD-1 S ^TMP("ECX",$J,DFN,ECDNEW)=^TMP("ECX",$J,DFN,ECDPREV) D
....S NEWWARD="",OLDWARD=$P(^TMP("ECX",$J,DFN,ECDPREV),U,10)
....D NEWWARD(ECDNEW,OLDWARD,.NEWWARD)
....Q:'NEWWARD
....S $P(^TMP("ECX",$J,DFN,ECDNEW),U,4)=$P(NEWWARD,U,1)
....S $P(^TMP("ECX",$J,DFN,ECDNEW),U,5)=$P(NEWWARD,U,2)
..S ECDPREV=ECD
.;fill-in to end of extract date range
.K TM S ECD=0
.F S ECD=$O(^TMP("ECX",$J,DFN,ECD)) Q:'ECD D
..S TM(ECD)=$P(^TMP("ECX",$J,DFN,ECD),U,11)
.S ECD=$O(TM(""),-1),DCDT=+TM(ECD)
.;if last day in date range is after last classification date
.I LASTDAY>ECD D
..;if there is no d/c date
..I DCDT=0 F ECDNEW=ECD+1:1:LASTDAY D Q
...I '$D(^TMP("ECX",$J,DFN,ECDNEW)) S ^TMP("ECX",$J,DFN,ECDNEW)=^TMP("ECX",$J,DFN,ECD)
...S NEWWARD="",OLDWARD=$P(^TMP("ECX",$J,DFN,ECD),U,10)
...D NEWWARD(ECDNEW,OLDWARD,.NEWWARD)
...Q:'NEWWARD
...S $P(^TMP("ECX",$J,DFN,ECDNEW),U,4)=$P(NEWWARD,U,1)
...S $P(^TMP("ECX",$J,DFN,ECDNEW),U,5)=$P(NEWWARD,U,2)
..;if d/c date is after last classification date
..I $P(DCDT,".")>ECD S NEWDT=$S($P(DCDT,".")>LASTDAY:LASTDAY,1:($P(DCDT,".")-1)) F ECDNEW=ECD+1:1:NEWDT D Q
...I '$D(^TMP("ECX",$J,DFN,ECDNEW)) S ^TMP("ECX",$J,DFN,ECDNEW)=^TMP("ECX",$J,DFN,ECD)
...S NEWWARD="",OLDWARD=$P(^TMP("ECX",$J,DFN,ECD),U,10)
...D NEWWARD(ECDNEW,OLDWARD,.NEWWARD)
...Q:'NEWWARD
...S $P(^TMP("ECX",$J,DFN,ECDNEW),U,4)=$P(NEWWARD,U,1)
...S $P(^TMP("ECX",$J,DFN,ECDNEW),U,5)=$P(NEWWARD,U,2)
Q
;
NEWWARD(ECDNEW,OLDWARD,NEWWARD) ;get new nursing location
; input ECDNEW = date of care
; OLDWARD = pointer to file #42, previous mas ward
; NEWWARD = null
; output NEWWARD = new nursing location^new nursing bedsection
; OR "^", if new ward same as previous ward or
;could not be resolved
;if the new ward is mapped to multiple nursing locations, get the
;first active location
N NEWW,NEWLOC,NEWSEC,OUT,DA,DR,DIC,DIQ,LOC,INP
S INP=$$INP^ECXUTL2(DFN,ECDNEW)
S NEWWARD=$P(INP,U,5)
I NEWWARD=OLDWARD S NEWWARD=""
Q:'NEWWARD
S (NEWW,NEWW2,NEWLOC,NEWSEC)="",OUT=0
F S NEWW=$O(^NURSF(211.4,"C",NEWWARD,NEWW)) Q:OUT Q:+NEWW<1 D
.S DIC=211.4,DIQ(0)="I",DIQ="LOC",DA=NEWW,DR="1;1.5"
.D EN^DIQ1 K DIQ,DIC,DA,DR
.Q:LOC(211.4,NEWW,1,"I")="I"
.Q:LOC(211.4,NEWW,1.5,"I")="I"
.S JJ=$O(^NURSF(211.4,"C",NEWWARD,NEWW,""))
.S DIC=211.4,DIQ(0)="I",DIQ="LOC",DA=NEWW,DA(211.41)=JJ,DR="2",DR(211.41)=".01;1"
.D EN^DIQ1 K DIQ,DIC,DA,DR
.Q:NEWWARD'=LOC(211.41,JJ,.01,"I")
.S NEWLOC=NEWW,NEWSEC=LOC(211.41,JJ,1,"I"),OUT=1
I (NEWLOC="")!(NEWSEC="") S NEWWARD="" Q
S NEWWARD=NEWLOC_U_NEWSEC
Q
;
FILE ;file extract records
;node0
;inst^dfn^ssn^name^in/out (ECXA)^date^acuity level(category)^entered by^
;classifier^nurs location^nursing bed section^mov #^treat spec^adm date^
;adm time
;node1
;mpi^dss dept ECXDSSD^dom (ECXDOM)^observ pat ind (ECXOBS)^dss
;product ECXDSSP
N DA,DIK
S EC7=$O(^ECX(ECFILE,999999999),-1)
S DFN=0,QFLG=0
F S DFN=$O(^TMP("ECX",$J,DFN)) Q:'DFN D Q:QFLG
.K ECXPAT S OK=$$PAT^ECXUTL3(DFN,DT,"1;",.ECXPAT)
.Q:'OK
.S ECXDFN=DFN,ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN")
.S ECXMPI=ECXPAT("MPI"),ECD=0
.;file patient's classification data
.F S ECD=$O(^TMP("ECX",$J,DFN,ECD)) Q:'ECD D
..S ECC=$P(^TMP("ECX",$J,DFN,ECD),U,1,5),ECMN=$P(^(ECD),U,7),ECXA=$P(^(ECD),U,6)
..S ECTS=$P(^(ECD),U,8),ECA=$P(^(ECD),U,9),ECXDOM=$P(^(ECD),U,13)
..S ECXACU=$P(ECC,U,1),ECXEB=$P(ECC,U,2),ECXCLS=$P(ECC,U,3)
..S ECXNLOC=$P(ECC,U,4),ECXNBED=$P(ECC,U,5)
..;
..;Get DSS Department and Product
..S (ECXDSSD,ECXDSSP)=""
..;I ECXLOGIC>2004 S X=$$NUR^ECXDEPT(ECD)
..;
..;- Observation patient indicator (YES/NO)
..S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECTS)
..;
..; ******* - PATCH 127, ADD PATCAT CODE ********
..S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
..;- Don't file record if outpatient and NOT an observation patient
..Q:ECXA="O"&(ECXOBS="NO")
..;
..;- If no encounter number don't file record
..S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECA,ECD,ECTS,ECXOBS,ECHEAD,,) Q:ECXENC=""
..S EC7=EC7+1
..S ECODE=EC7_U_EC23_U_ECINST_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
..S ECODE=ECODE_$$ECXDATE^ECXUTL(ECD,ECXYM)_U
..S ECODE=ECODE_ECXACU_U_ECXEB_U_ECXCLS_U_ECXNLOC_U_ECXNBED_U
..;convert specialties to PTF Codes for transmission
.. N ECXDATA
.. S ECXDATA=$$TSDATA^DGACT(42.4,+ECTS,.ECXDATA)
.. S ECTS=$G(ECXDATA(7))
..;done
..S ECODE=ECODE_ECMN_U_ECTS_U_$$ECXDATE^ECXUTL(ECA,ECXYM)_U
..S ECODE=ECODE_$$ECXTIME^ECXUTL(ECA)_U
..S ECODE1=ECXMPI_U_ECXDSSD_U_ECXDOM_U_ECXOBS_U_ECXENC_U
..S ECODE1=ECODE1_ECINST_U
..I ECXLOGIC>2004 S ECODE1=ECODE1_ECXDSSP
..I ECXLOGIC>2010 S ECODE1=ECODE1_U_ECXPATCAT ;127 ADDED PATCAT
..S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1
..S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
..I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
Q
;
SETUP ;Set required input for ECXTRAC
S ECHEAD="NUR"
D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
Q
;
QUE ; entry point for the background requeuing handled by ECXTAUTO
D SETUP,QUE^ECXTAUTO,^ECXKILL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXNURS 7223 printed Dec 13, 2024@01:53:07 Page 2
ECXNURS ;ALB/JAP,BIR/DMA,PTD-Nursing Extract for DSS ;9/13/10 13:59
+1 ;;3.0;DSS EXTRACTS;**8,14,22,24,33,39,46,71,107,127**;Dec 22, 1997;Build 36
BEG ;entry point from option
+1 DO SETUP
IF ECFILE=""
QUIT
+2 DO ^ECXTRAC
DO ^ECXKILL
+3 QUIT
+4 ;
START ;entry when queued
+1 ;store in ^tmp by patient and date/time
+2 NEW CNT,INP,FIRSTDAY,LASTDAY
+3 SET QFLG=0
SET CNT=0
+4 KILL ^TMP("ECX",$JOB)
+5 SET FIRSTDAY=$PIECE(ECSD1,".")+1
SET LASTDAY=$PIECE(ECED,".")
+6 SET ECED=ECED+.3
SET ECD=ECSD1
+7 FOR
SET ECD=$ORDER(^NURSA(214.6,"B",ECD))
SET ECDA=0
if 'ECD
QUIT
if ECD>ECED
QUIT
Begin DoDot:1
+8 FOR
SET ECDA=$ORDER(^NURSA(214.6,"B",ECD,ECDA))
if 'ECDA
QUIT
Begin DoDot:2
+9 KILL LOC
SET DIC=214.6
SET DIQ(0)="I"
SET DA=ECDA
SET DIQ="LOC"
SET DR=".01;.02;1;3;4;6;7;8"
+10 DO EN^DIQ1
KILL DIQ,DIC,DA,DR
+11 FOR J=.01,.02,1,3,4,6,7,8
SET EC(J)=LOC(214.6,ECDA,J,"I")
+12 if EC(8)'=""
QUIT
+13 SET INP=$$INP^ECXUTL2(EC(.02),EC(.01))
+14 ;
+15 ;- Don't create ^TMP record if outpatient and no treat spec
+16 if $PIECE(INP,U)="O"&($PIECE(INP,U,3)="")
QUIT
+17 ; retain latest classification per day per patient
+18 SET ^TMP("ECX",$JOB,EC(.02),$PIECE(EC(.01),"."))=EC(1)_U_EC(3)_U_EC(4)_U_EC(6)_U_EC(7)_U_$PIECE(INP,U,1,6)_U_EC(.01)_U_$PIECE(INP,U,10)
+19 KILL LOC(214.6,ECDA),EC,INP
+20 SET CNT=CNT+1
+21 IF $DATA(ZTQUEUED)
IF (CNT>499)
IF '(CNT#500)
IF $$S^%ZTLOAD
SET QFLG=1
End DoDot:2
if QFLG
QUIT
End DoDot:1
if QFLG
QUIT
+22 IF QFLG
KILL ^TMP("ECX",$JOB)
QUIT
+23 DO RESOLVE
+24 DO FILE
+25 KILL ^TMP("ECX",$JOB)
+26 ;
RESOLVE ;process ^tmp by patient
+1 NEW DFN,TM,ECD,ECDPREV,ECDNEW,OLDWARD,NEWWARD,NEWDT
+2 SET DFN=0
+3 FOR
SET DFN=$ORDER(^TMP("ECX",$JOB,DFN))
SET ECD=0
if 'DFN
QUIT
Begin DoDot:1
+4 ;remove any classifications for day of discharge
+5 FOR
SET ECD=$ORDER(^TMP("ECX",$JOB,DFN,ECD))
if 'ECD
QUIT
Begin DoDot:2
+6 IF ECD=$PIECE($PIECE(^TMP("ECX",$JOB,DFN,ECD),U,11),".")
KILL ^TMP("ECX",$JOB,DFN,ECD)
End DoDot:2
+7 ;proceed only if ^tmp remains
+8 if '$DATA(^TMP("ECX",$JOB,DFN))
QUIT
+9 ;proceed with fill-in only if processing more than 3 days' data
+10 if LASTDAY<(FIRSTDAY+2)
QUIT
+11 ;fill-in records for any missing days per inpatient episode
+12 KILL TM
SET ECD=0
+13 FOR
SET ECD=$ORDER(^TMP("ECX",$JOB,DFN,ECD))
if 'ECD
QUIT
Begin DoDot:2
+14 SET TM(ECD)=$PIECE(^TMP("ECX",$JOB,DFN,ECD),U,9)
End DoDot:2
+15 SET (ECD,ECDPREV)=0
+16 FOR
SET ECD=$ORDER(TM(ECD))
if 'ECD
QUIT
Begin DoDot:2
+17 IF ECDPREV=0
SET ECDPREV=ECD
QUIT
+18 IF (ECD-ECDPREV)>1
IF +TM(ECD)=+TM(ECDPREV)
Begin DoDot:3
+19 FOR ECDNEW=ECDPREV+1:1:ECD-1
SET ^TMP("ECX",$JOB,DFN,ECDNEW)=^TMP("ECX",$JOB,DFN,ECDPREV)
Begin DoDot:4
+20 SET NEWWARD=""
SET OLDWARD=$PIECE(^TMP("ECX",$JOB,DFN,ECDPREV),U,10)
+21 DO NEWWARD(ECDNEW,OLDWARD,.NEWWARD)
+22 if 'NEWWARD
QUIT
+23 SET $PIECE(^TMP("ECX",$JOB,DFN,ECDNEW),U,4)=$PIECE(NEWWARD,U,1)
+24 SET $PIECE(^TMP("ECX",$JOB,DFN,ECDNEW),U,5)=$PIECE(NEWWARD,U,2)
End DoDot:4
End DoDot:3
+25 SET ECDPREV=ECD
End DoDot:2
+26 ;fill-in to end of extract date range
+27 KILL TM
SET ECD=0
+28 FOR
SET ECD=$ORDER(^TMP("ECX",$JOB,DFN,ECD))
if 'ECD
QUIT
Begin DoDot:2
+29 SET TM(ECD)=$PIECE(^TMP("ECX",$JOB,DFN,ECD),U,11)
End DoDot:2
+30 SET ECD=$ORDER(TM(""),-1)
SET DCDT=+TM(ECD)
+31 ;if last day in date range is after last classification date
+32 IF LASTDAY>ECD
Begin DoDot:2
+33 ;if there is no d/c date
+34 IF DCDT=0
FOR ECDNEW=ECD+1:1:LASTDAY
Begin DoDot:3
+35 IF '$DATA(^TMP("ECX",$JOB,DFN,ECDNEW))
SET ^TMP("ECX",$JOB,DFN,ECDNEW)=^TMP("ECX",$JOB,DFN,ECD)
+36 SET NEWWARD=""
SET OLDWARD=$PIECE(^TMP("ECX",$JOB,DFN,ECD),U,10)
+37 DO NEWWARD(ECDNEW,OLDWARD,.NEWWARD)
+38 if 'NEWWARD
QUIT
+39 SET $PIECE(^TMP("ECX",$JOB,DFN,ECDNEW),U,4)=$PIECE(NEWWARD,U,1)
+40 SET $PIECE(^TMP("ECX",$JOB,DFN,ECDNEW),U,5)=$PIECE(NEWWARD,U,2)
End DoDot:3
QUIT
+41 ;if d/c date is after last classification date
+42 IF $PIECE(DCDT,".")>ECD
SET NEWDT=$SELECT($PIECE(DCDT,".")>LASTDAY:LASTDAY,1:($PIECE(DCDT,".")-1))
FOR ECDNEW=ECD+1:1:NEWDT
Begin DoDot:3
+43 IF '$DATA(^TMP("ECX",$JOB,DFN,ECDNEW))
SET ^TMP("ECX",$JOB,DFN,ECDNEW)=^TMP("ECX",$JOB,DFN,ECD)
+44 SET NEWWARD=""
SET OLDWARD=$PIECE(^TMP("ECX",$JOB,DFN,ECD),U,10)
+45 DO NEWWARD(ECDNEW,OLDWARD,.NEWWARD)
+46 if 'NEWWARD
QUIT
+47 SET $PIECE(^TMP("ECX",$JOB,DFN,ECDNEW),U,4)=$PIECE(NEWWARD,U,1)
+48 SET $PIECE(^TMP("ECX",$JOB,DFN,ECDNEW),U,5)=$PIECE(NEWWARD,U,2)
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+49 QUIT
+50 ;
NEWWARD(ECDNEW,OLDWARD,NEWWARD) ;get new nursing location
+1 ; input ECDNEW = date of care
+2 ; OLDWARD = pointer to file #42, previous mas ward
+3 ; NEWWARD = null
+4 ; output NEWWARD = new nursing location^new nursing bedsection
+5 ; OR "^", if new ward same as previous ward or
+6 ;could not be resolved
+7 ;if the new ward is mapped to multiple nursing locations, get the
+8 ;first active location
+9 NEW NEWW,NEWLOC,NEWSEC,OUT,DA,DR,DIC,DIQ,LOC,INP
+10 SET INP=$$INP^ECXUTL2(DFN,ECDNEW)
+11 SET NEWWARD=$PIECE(INP,U,5)
+12 IF NEWWARD=OLDWARD
SET NEWWARD=""
+13 if 'NEWWARD
QUIT
+14 SET (NEWW,NEWW2,NEWLOC,NEWSEC)=""
SET OUT=0
+15 FOR
SET NEWW=$ORDER(^NURSF(211.4,"C",NEWWARD,NEWW))
if OUT
QUIT
if +NEWW<1
QUIT
Begin DoDot:1
+16 SET DIC=211.4
SET DIQ(0)="I"
SET DIQ="LOC"
SET DA=NEWW
SET DR="1;1.5"
+17 DO EN^DIQ1
KILL DIQ,DIC,DA,DR
+18 if LOC(211.4,NEWW,1,"I")="I"
QUIT
+19 if LOC(211.4,NEWW,1.5,"I")="I"
QUIT
+20 SET JJ=$ORDER(^NURSF(211.4,"C",NEWWARD,NEWW,""))
+21 SET DIC=211.4
SET DIQ(0)="I"
SET DIQ="LOC"
SET DA=NEWW
SET DA(211.41)=JJ
SET DR="2"
SET DR(211.41)=".01;1"
+22 DO EN^DIQ1
KILL DIQ,DIC,DA,DR
+23 if NEWWARD'=LOC(211.41,JJ,.01,"I")
QUIT
+24 SET NEWLOC=NEWW
SET NEWSEC=LOC(211.41,JJ,1,"I")
SET OUT=1
End DoDot:1
+25 IF (NEWLOC="")!(NEWSEC="")
SET NEWWARD=""
QUIT
+26 SET NEWWARD=NEWLOC_U_NEWSEC
+27 QUIT
+28 ;
FILE ;file extract records
+1 ;node0
+2 ;inst^dfn^ssn^name^in/out (ECXA)^date^acuity level(category)^entered by^
+3 ;classifier^nurs location^nursing bed section^mov #^treat spec^adm date^
+4 ;adm time
+5 ;node1
+6 ;mpi^dss dept ECXDSSD^dom (ECXDOM)^observ pat ind (ECXOBS)^dss
+7 ;product ECXDSSP
+8 NEW DA,DIK
+9 SET EC7=$ORDER(^ECX(ECFILE,999999999),-1)
+10 SET DFN=0
SET QFLG=0
+11 FOR
SET DFN=$ORDER(^TMP("ECX",$JOB,DFN))
if 'DFN
QUIT
Begin DoDot:1
+12 KILL ECXPAT
SET OK=$$PAT^ECXUTL3(DFN,DT,"1;",.ECXPAT)
+13 if 'OK
QUIT
+14 SET ECXDFN=DFN
SET ECXPNM=ECXPAT("NAME")
SET ECXSSN=ECXPAT("SSN")
+15 SET ECXMPI=ECXPAT("MPI")
SET ECD=0
+16 ;file patient's classification data
+17 FOR
SET ECD=$ORDER(^TMP("ECX",$JOB,DFN,ECD))
if 'ECD
QUIT
Begin DoDot:2
+18 SET ECC=$PIECE(^TMP("ECX",$JOB,DFN,ECD),U,1,5)
SET ECMN=$PIECE(^(ECD),U,7)
SET ECXA=$PIECE(^(ECD),U,6)
+19 SET ECTS=$PIECE(^(ECD),U,8)
SET ECA=$PIECE(^(ECD),U,9)
SET ECXDOM=$PIECE(^(ECD),U,13)
+20 SET ECXACU=$PIECE(ECC,U,1)
SET ECXEB=$PIECE(ECC,U,2)
SET ECXCLS=$PIECE(ECC,U,3)
+21 SET ECXNLOC=$PIECE(ECC,U,4)
SET ECXNBED=$PIECE(ECC,U,5)
+22 ;
+23 ;Get DSS Department and Product
+24 SET (ECXDSSD,ECXDSSP)=""
+25 ;I ECXLOGIC>2004 S X=$$NUR^ECXDEPT(ECD)
+26 ;
+27 ;- Observation patient indicator (YES/NO)
+28 SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECTS)
+29 ;
+30 ; ******* - PATCH 127, ADD PATCAT CODE ********
+31 SET ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
+32 ;- Don't file record if outpatient and NOT an observation patient
+33 if ECXA="O"&(ECXOBS="NO")
QUIT
+34 ;
+35 ;- If no encounter number don't file record
+36 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECA,ECD,ECTS,ECXOBS,ECHEAD,,)
if ECXENC=""
QUIT
+37 SET EC7=EC7+1
+38 SET ECODE=EC7_U_EC23_U_ECINST_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
+39 SET ECODE=ECODE_$$ECXDATE^ECXUTL(ECD,ECXYM)_U
+40 SET ECODE=ECODE_ECXACU_U_ECXEB_U_ECXCLS_U_ECXNLOC_U_ECXNBED_U
+41 ;convert specialties to PTF Codes for transmission
+42 NEW ECXDATA
+43 SET ECXDATA=$$TSDATA^DGACT(42.4,+ECTS,.ECXDATA)
+44 SET ECTS=$GET(ECXDATA(7))
+45 ;done
+46 SET ECODE=ECODE_ECMN_U_ECTS_U_$$ECXDATE^ECXUTL(ECA,ECXYM)_U
+47 SET ECODE=ECODE_$$ECXTIME^ECXUTL(ECA)_U
+48 SET ECODE1=ECXMPI_U_ECXDSSD_U_ECXDOM_U_ECXOBS_U_ECXENC_U
+49 SET ECODE1=ECODE1_ECINST_U
+50 IF ECXLOGIC>2004
SET ECODE1=ECODE1_ECXDSSP
+51 ;127 ADDED PATCAT
IF ECXLOGIC>2010
SET ECODE1=ECODE1_U_ECXPATCAT
+52 SET ^ECX(ECFILE,EC7,0)=ECODE
SET ^ECX(ECFILE,EC7,1)=ECODE1
SET ECRN=ECRN+1
+53 SET DA=EC7
SET DIK="^ECX("_ECFILE_","
DO IX1^DIK
KILL DIK,DA
+54 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET QFLG=1
End DoDot:2
End DoDot:1
if QFLG
QUIT
+55 QUIT
+56 ;
SETUP ;Set required input for ECXTRAC
+1 SET ECHEAD="NUR"
+2 DO ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
+3 QUIT
+4 ;
QUE ; entry point for the background requeuing handled by ECXTAUTO
+1 DO SETUP
DO QUE^ECXTAUTO
DO ^ECXKILL
QUIT
