ECLATESH ;ALB/DAN - Possible Late State Home Entries Report ;10/5/17 11:50
;;2.0;EVENT CAPTURE;**139**;8 May 96;Build 7
;
START ;
K ^TMP($J,"ECLATESH") ;Clear space for printed report
D GETRECS
I $G(ECPTYP)="E" S ^TMP($J,"ECRPT",1)="DSS UNIT^LOCATION^PATIENT^SSN^PROCEDURE DATE/TIME^ENTERED ON DATE/TIME^ENTERED BY^PROCEDURE^VOLUME^PRIMARY PROVIDER" K ^TMP($J,"ECLATESH") Q
D PRINT
K ^TMP($J,"ECLATESH") ;Clear space used for printed report
Q
;
GETRECS ;Find records for report
N CNT,DATE,REC,ECDATA,DSSU,PAT,PDT,IDT,USER,PROC,VOL,PROV,LOC
S CNT=1
S DATE=ECSD F S DATE=$O(^ECH("AC",DATE)) Q:'+DATE!(DATE>ECED) S REC=0 F S REC=$O(^ECH("AC",DATE,REC)) Q:'+REC D
.I $$GET1^DIQ(721,REC,46,"E")'["LATE" Q ;Only looking for records with a "l"ate status
.S CNT=CNT+1
.D GETS^DIQ(721,REC,"1;2;3;6;8;9;13;47","IE","ECDATA")
.S DSSU=$G(ECDATA(721,REC_",",6,"E")) ;DSS Unit
.S PAT=$G(ECDATA(721,REC_",",1,"E")) ;Patient Name
.S SSN=$$GETSSN^ECRDSSA(REC) ;SSN - 4 digit for printed, 9 for export
.S PDT=$$FMTE^XLFDT($G(ECDATA(721,REC_",",2,"I")),5) ;Procedure date/time
.S IDT=$$FMTE^XLFDT($G(ECDATA(721,REC_",",47,"I")),5) ;Import date/time
.S USER=$G(ECDATA(721,REC_",",13,"E")) ;Entered by
.S PROC=$$GETPROC^ECRDSSA($G(ECDATA(721,REC_",",8,"I"))) ;Procedure Name
.S VOL=$G(ECDATA(721,REC_",",9,"E")) ;Volume
.S PROV=$$GETPROV^ECRDSSA(REC) ;Primary Provider Name
.S LOC=$G(ECDATA(721,REC_",",3,"E")) ;Location
.S ^TMP($J,"ECRPT",CNT)=DSSU_U_LOC_U_PAT_U_SSN_U_PDT_U_IDT_U_USER_U_PROC_U_VOL_U_PROV ;Exported fields
.S ^TMP($J,"ECLATESH",LOC,DSSU,REC)=PAT_U_SSN_U_PDT_U_IDT_U_PROC_U_VOL_U_PROV ;Printed report fields
.K ECDATA
Q
;
PRINT ;Display results
N LOC,REC,PAGE,DSSU,TVOL,NODE
U IO
I '$D(^TMP($J,"ECLATESH")) W !,"No potentially late entered state home records were found for this date range."
S LOC="" F S LOC=$O(^TMP($J,"ECLATESH",LOC)) Q:LOC="" D
.D HDR
.S DSSU="" F S DSSU=$O(^TMP($J,"ECLATESH",LOC,DSSU)) Q:DSSU="" D
..W !,"DSS Unit: ",DSSU,!
..S REC=0 F S REC=$O(^TMP($J,"ECLATESH",LOC,DSSU,REC)) Q:'+REC D
...S NODE=^TMP($J,"ECLATESH",LOC,DSSU,REC)
...W !,$P(NODE,U),?32,$P(NODE,U,2),?38,$P(NODE,U,3),?56,$P(NODE,U,4),?76,$P(NODE,U,5),?85,$J($P(NODE,U,6),5),?93,$P(NODE,U,7) S TVOL=$G(TVOL)+$P(NODE,U,6)
...I $Y>(IOSL-4) D HDR
..W !,?85,"-----",!,"Total for DSS Unit: ",DSSU,?85,$J(TVOL,5),! S TVOL=0
Q
;
HDR ;
W @IOF W:$G(PAGE) !
S PAGE=$G(PAGE)+1
W ?40,"EVENT CAPTURE POSSIBLE LATE STATE HOME ENTRIES REPORT",?124,"PAGE:",PAGE
W !,?50,"For Location ",LOC
W !,?50,"From ",$$FMTE^XLFDT((ECSD+.0001),5)," through ",$$FMTE^XLFDT((ECED-.9999),5)
W !!,"PATIENT",?32,"SSN",?38,"PROCEDURE",?56,"ENTERED ON",?76,"PROCEDURE",?87,"VOL",?93,"PRIMARY PROVIDER"
W !,?38,"DATE/TIME",?56,"DATE/TIME"
W !,$$REPEAT^XLFSTR("-",132)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECLATESH 2845 printed Dec 13, 2024@01:57:33 Page 2
ECLATESH ;ALB/DAN - Possible Late State Home Entries Report ;10/5/17 11:50
+1 ;;2.0;EVENT CAPTURE;**139**;8 May 96;Build 7
+2 ;
START ;
+1 ;Clear space for printed report
KILL ^TMP($JOB,"ECLATESH")
+2 DO GETRECS
+3 IF $GET(ECPTYP)="E"
SET ^TMP($JOB,"ECRPT",1)="DSS UNIT^LOCATION^PATIENT^SSN^PROCEDURE DATE/TIME^ENTERED ON DATE/TIME^ENTERED BY^PROCEDURE^VOLUME^PRIMARY PROVIDER"
KILL ^TMP($JOB,"ECLATESH")
QUIT
+4 DO PRINT
+5 ;Clear space used for printed report
KILL ^TMP($JOB,"ECLATESH")
+6 QUIT
+7 ;
GETRECS ;Find records for report
+1 NEW CNT,DATE,REC,ECDATA,DSSU,PAT,PDT,IDT,USER,PROC,VOL,PROV,LOC
+2 SET CNT=1
+3 SET DATE=ECSD
FOR
SET DATE=$ORDER(^ECH("AC",DATE))
if '+DATE!(DATE>ECED)
QUIT
SET REC=0
FOR
SET REC=$ORDER(^ECH("AC",DATE,REC))
if '+REC
QUIT
Begin DoDot:1
+4 ;Only looking for records with a "l"ate status
IF $$GET1^DIQ(721,REC,46,"E")'["LATE"
QUIT
+5 SET CNT=CNT+1
+6 DO GETS^DIQ(721,REC,"1;2;3;6;8;9;13;47","IE","ECDATA")
+7 ;DSS Unit
SET DSSU=$GET(ECDATA(721,REC_",",6,"E"))
+8 ;Patient Name
SET PAT=$GET(ECDATA(721,REC_",",1,"E"))
+9 ;SSN - 4 digit for printed, 9 for export
SET SSN=$$GETSSN^ECRDSSA(REC)
+10 ;Procedure date/time
SET PDT=$$FMTE^XLFDT($GET(ECDATA(721,REC_",",2,"I")),5)
+11 ;Import date/time
SET IDT=$$FMTE^XLFDT($GET(ECDATA(721,REC_",",47,"I")),5)
+12 ;Entered by
SET USER=$GET(ECDATA(721,REC_",",13,"E"))
+13 ;Procedure Name
SET PROC=$$GETPROC^ECRDSSA($GET(ECDATA(721,REC_",",8,"I")))
+14 ;Volume
SET VOL=$GET(ECDATA(721,REC_",",9,"E"))
+15 ;Primary Provider Name
SET PROV=$$GETPROV^ECRDSSA(REC)
+16 ;Location
SET LOC=$GET(ECDATA(721,REC_",",3,"E"))
+17 ;Exported fields
SET ^TMP($JOB,"ECRPT",CNT)=DSSU_U_LOC_U_PAT_U_SSN_U_PDT_U_IDT_U_USER_U_PROC_U_VOL_U_PROV
+18 ;Printed report fields
SET ^TMP($JOB,"ECLATESH",LOC,DSSU,REC)=PAT_U_SSN_U_PDT_U_IDT_U_PROC_U_VOL_U_PROV
+19 KILL ECDATA
End DoDot:1
+20 QUIT
+21 ;
PRINT ;Display results
+1 NEW LOC,REC,PAGE,DSSU,TVOL,NODE
+2 USE IO
+3 IF '$DATA(^TMP($JOB,"ECLATESH"))
WRITE !,"No potentially late entered state home records were found for this date range."
+4 SET LOC=""
FOR
SET LOC=$ORDER(^TMP($JOB,"ECLATESH",LOC))
if LOC=""
QUIT
Begin DoDot:1
+5 DO HDR
+6 SET DSSU=""
FOR
SET DSSU=$ORDER(^TMP($JOB,"ECLATESH",LOC,DSSU))
if DSSU=""
QUIT
Begin DoDot:2
+7 WRITE !,"DSS Unit: ",DSSU,!
+8 SET REC=0
FOR
SET REC=$ORDER(^TMP($JOB,"ECLATESH",LOC,DSSU,REC))
if '+REC
QUIT
Begin DoDot:3
+9 SET NODE=^TMP($JOB,"ECLATESH",LOC,DSSU,REC)
+10 WRITE !,$PIECE(NODE,U),?32,$PIECE(NODE,U,2),?38,$PIECE(NODE,U,3),?56,$PIECE(NODE,U,4),?76,$PIECE(NODE,U,5),?85,$JUSTIFY($PIECE(NODE,U,6),5),?93,$PIECE(NODE,U,7)
SET TVOL=$GET(TVOL)+$PIECE(NODE,U,6)
+11 IF $Y>(IOSL-4)
DO HDR
End DoDot:3
+12 WRITE !,?85,"-----",!,"Total for DSS Unit: ",DSSU,?85,$JUSTIFY(TVOL,5),!
SET TVOL=0
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
HDR ;
+1 WRITE @IOF
if $GET(PAGE)
WRITE !
+2 SET PAGE=$GET(PAGE)+1
+3 WRITE ?40,"EVENT CAPTURE POSSIBLE LATE STATE HOME ENTRIES REPORT",?124,"PAGE:",PAGE
+4 WRITE !,?50,"For Location ",LOC
+5 WRITE !,?50,"From ",$$FMTE^XLFDT((ECSD+.0001),5)," through ",$$FMTE^XLFDT((ECED-.9999),5)
+6 WRITE !!,"PATIENT",?32,"SSN",?38,"PROCEDURE",?56,"ENTERED ON",?76,"PROCEDURE",?87,"VOL",?93,"PRIMARY PROVIDER"
+7 WRITE !,?38,"DATE/TIME",?56,"DATE/TIME"
+8 WRITE !,$$REPEAT^XLFSTR("-",132)
+9 QUIT
+10 ;
