TIUPS185 ;SLC/TT - REPORT FOR TIU REASSIGNMENT DOCUMENTS; 03/17/04 [7/14/04 11:36am]
;;1.0; TEXT INTEGRATION UTILITIES;**185**;Jun 20, 1997
Q
EN ;
;
K ^TMP("TIUPS185",$J) ;ENSURE FRESH START
N TIUSAVE,DRANGE
D ASKDATE(.DRANGE) Q:$G(DRANGE("EXIT"))="YES"
S TIUSAVE("*")=""
D EN^XUTMDEVQ("REPORT^TIUPS185","REPORT FOR TIU REASSIGNMENT DOCUMENTS",.TIUSAVE)
Q
;
ASKDATE(DRANGE) ; ASK USER FOR DATE RANGE
; DRANGE - DATE RANGE FOR REPORT
;
N %DT,DIR,X,Y,POP,CNT
S %DT="AE"
F CNT=1:1:2 D
.S %DT("A")=$S(CNT=1:"ENTER STARTING DATE: ",CNT=2:"ENTER ENDING DATE: ")
.S %DT("B")=$S(CNT=1:"JAN 01, 2003",CNT=2:$P($$HTE^XLFDT($H),"@"))
.D ^%DT
.I Y=-1 S CNT=2,DRANGE("EXIT")="YES" Q
.I CNT=1 D
..I Y["0000" S Y=Y/10000,Y=Y_"0101"
..S DRANGE("START")=Y
.I CNT=2 D
..I Y["0000" S Y=Y/10000,Y=Y_"1231"
..S DRANGE("END")=Y_".24"
Q
;
REPORT ; PRINT REPORT
; AUDIEN - TIU AUDIT TRAIL IEN
; REDT - REASSIGNMENT DATE/TIME
; DOCIEN - TIU DOCUMENT IEN
; INPAT - INITIAL PATIENT
; POSTPAT - FINAL PATIENT
; DNAME - TIU DOCUMENT NAME
;
N REDT,DOCIEN,INPAT,POSTPAT,DNAME,TIME,COUNT,SEARCHN
S (DOCIEN,COUNT,SEARCHN)=0,TIME("START")=$$NOW^XLFDT
W:'$D(ZTQUEUED) !,"Searching...",!!
F S DOCIEN=$O(^TIU(8925.5,DOCIEN)) Q:DOCIEN'>0 S SEARCHN=SEARCHN+1 D
.Q:'$D(^TIU(8925.5,DOCIEN,0))
.Q:'$D(^TIU(8925.5,DOCIEN,1))
.S REDT=$P(^TIU(8925.5,DOCIEN,1),"^")
.I ((REDT'<DRANGE("START"))&(REDT'>DRANGE("END"))) D
..S INPAT=$E($$GET1^DIQ(8925.5,DOCIEN,1.03),1,19)
..S:INPAT="" INPAT="UNKNOWN"
..S POSTPAT=$E($$GET1^DIQ(8925.5,DOCIEN,1.04),1,19)
..S:POSTPAT="" POSTPAT="UNKNOWN"
..S DNAME=$E($$GET1^DIQ(8925.5,DOCIEN,.01),1,15)
..S:DNAME="" DNAME="UNKNOWN"
..S COUNT=COUNT+1
..S ^TMP("TIUPS185",$J,REDT)=DNAME_"^"_INPAT_"^"_POSTPAT
S TIME("STOP")=$$NOW^XLFDT,TIME("ELAP")=$FN($$FMDIFF^XLFDT(TIME("START"),TIME("STOP"),2)/60,"-")
I COUNT=0 W !!?20,"NO DOCUMENTS FOUND!"
E D
.D GENINFO
.D DISPLAY
Q
;
DISPLAY ;DISPLAY DATA
;
I $E(IOST,1,2)'="C-" D HDR
N INP,FINALP,DATETM,STOP,DOCNM,LINECNT,DATA
S (DATETM,STOP,LINECNT)=0
F S DATETM=$O(^TMP("TIUPS185",$J,DATETM)) Q:(DATETM="") D Q:STOP
.S DATA=$G(^TMP("TIUPS185",$J,DATETM))
.S DOCNM=$P(DATA,"^",1),INP=$P(DATA,"^",2),FINALP=$P(DATA,"^",3)
.I $E(IOST,1,2)="C-" D
..I 'LINECNT W @IOF D HDR
..W !,DOCNM,?17,INP,?38,FINALP,?58,$$FMTE^XLFDT(DATETM)
..S LINECNT=LINECNT+1
..I LINECNT=17 W ! S STOP='$$PAUSE,LINECNT=0
.E W !,DOCNM,?17,INP,?38,FINALP,?58,$$FMTE^XLFDT(DATETM)
Q
;
HDR ; REPORT HEADER
;
N TITLE
S TITLE="TIU REASSIGNMENT DOCUMENT REPORT"
W !?(IOM-$L(TITLE))/2,TITLE
W !!,"DOCUMENT NAME",?17,"INITIAL PATIENT",?38,"FINAL PATIENT",?58,"REASSIGNMENT DATE/TIME"
W !,"=============",?17,"===============",?38,"=============",?58,"======================"
Q
;
GENINFO ; GENERAL INFORMATION
;
N LINE,TXT
F LINE=1:1 S TXT=$P($T(TEXT+LINE),";;",2) Q:TXT="EOT" W @TXT,!
Q
;
PAUSE() ;
N DIR,X,Y,DTOUT,DUOUT,DIRUT
S DIR(0)="E"
D ^DIR
Q $S(Y'=1:0,1:1)
;
TEXT ;
;;"Date range searched: "_($$FMTE^XLFDT(DRANGE("START"),"D"))_" - "_($$FMTE^XLFDT(DRANGE("END"),"D"))
;;"Number of records searched: "_SEARCHN
;;"Number of records found: "_COUNT
;;"Elapsed time: "_(TIME("ELAP")\1)_" minute(s) "_($FN((TIME("ELAP")#1)*60,"-",0))_" second(s)"
;;"Current user: "_($$GET1^DIQ(200,+DUZ,.01))
;;"Current date: "_($$HTE^XLFDT($H))
;;EOT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS185 3452 printed Nov 22, 2024@17:54:10 Page 2
TIUPS185 ;SLC/TT - REPORT FOR TIU REASSIGNMENT DOCUMENTS; 03/17/04 [7/14/04 11:36am]
+1 ;;1.0; TEXT INTEGRATION UTILITIES;**185**;Jun 20, 1997
+2 QUIT
EN ;
+1 ;
+2 ;ENSURE FRESH START
KILL ^TMP("TIUPS185",$JOB)
+3 NEW TIUSAVE,DRANGE
+4 DO ASKDATE(.DRANGE)
if $GET(DRANGE("EXIT"))="YES"
QUIT
+5 SET TIUSAVE("*")=""
+6 DO EN^XUTMDEVQ("REPORT^TIUPS185","REPORT FOR TIU REASSIGNMENT DOCUMENTS",.TIUSAVE)
+7 QUIT
+8 ;
ASKDATE(DRANGE) ; ASK USER FOR DATE RANGE
+1 ; DRANGE - DATE RANGE FOR REPORT
+2 ;
+3 NEW %DT,DIR,X,Y,POP,CNT
+4 SET %DT="AE"
+5 FOR CNT=1:1:2
Begin DoDot:1
+6 SET %DT("A")=$SELECT(CNT=1:"ENTER STARTING DATE: ",CNT=2:"ENTER ENDING DATE: ")
+7 SET %DT("B")=$SELECT(CNT=1:"JAN 01, 2003",CNT=2:$PIECE($$HTE^XLFDT($HOROLOG),"@"))
+8 DO ^%DT
+9 IF Y=-1
SET CNT=2
SET DRANGE("EXIT")="YES"
QUIT
+10 IF CNT=1
Begin DoDot:2
+11 IF Y["0000"
SET Y=Y/10000
SET Y=Y_"0101"
+12 SET DRANGE("START")=Y
End DoDot:2
+13 IF CNT=2
Begin DoDot:2
+14 IF Y["0000"
SET Y=Y/10000
SET Y=Y_"1231"
+15 SET DRANGE("END")=Y_".24"
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
REPORT ; PRINT REPORT
+1 ; AUDIEN - TIU AUDIT TRAIL IEN
+2 ; REDT - REASSIGNMENT DATE/TIME
+3 ; DOCIEN - TIU DOCUMENT IEN
+4 ; INPAT - INITIAL PATIENT
+5 ; POSTPAT - FINAL PATIENT
+6 ; DNAME - TIU DOCUMENT NAME
+7 ;
+8 NEW REDT,DOCIEN,INPAT,POSTPAT,DNAME,TIME,COUNT,SEARCHN
+9 SET (DOCIEN,COUNT,SEARCHN)=0
SET TIME("START")=$$NOW^XLFDT
+10 if '$DATA(ZTQUEUED)
WRITE !,"Searching...",!!
+11 FOR
SET DOCIEN=$ORDER(^TIU(8925.5,DOCIEN))
if DOCIEN'>0
QUIT
SET SEARCHN=SEARCHN+1
Begin DoDot:1
+12 if '$DATA(^TIU(8925.5,DOCIEN,0))
QUIT
+13 if '$DATA(^TIU(8925.5,DOCIEN,1))
QUIT
+14 SET REDT=$PIECE(^TIU(8925.5,DOCIEN,1),"^")
+15 IF ((REDT'<DRANGE("START"))&(REDT'>DRANGE("END")))
Begin DoDot:2
+16 SET INPAT=$EXTRACT($$GET1^DIQ(8925.5,DOCIEN,1.03),1,19)
+17 if INPAT=""
SET INPAT="UNKNOWN"
+18 SET POSTPAT=$EXTRACT($$GET1^DIQ(8925.5,DOCIEN,1.04),1,19)
+19 if POSTPAT=""
SET POSTPAT="UNKNOWN"
+20 SET DNAME=$EXTRACT($$GET1^DIQ(8925.5,DOCIEN,.01),1,15)
+21 if DNAME=""
SET DNAME="UNKNOWN"
+22 SET COUNT=COUNT+1
+23 SET ^TMP("TIUPS185",$JOB,REDT)=DNAME_"^"_INPAT_"^"_POSTPAT
End DoDot:2
End DoDot:1
+24 SET TIME("STOP")=$$NOW^XLFDT
SET TIME("ELAP")=$FNUMBER($$FMDIFF^XLFDT(TIME("START"),TIME("STOP"),2)/60,"-")
+25 IF COUNT=0
WRITE !!?20,"NO DOCUMENTS FOUND!"
+26 IF '$TEST
Begin DoDot:1
+27 DO GENINFO
+28 DO DISPLAY
End DoDot:1
+29 QUIT
+30 ;
DISPLAY ;DISPLAY DATA
+1 ;
+2 IF $EXTRACT(IOST,1,2)'="C-"
DO HDR
+3 NEW INP,FINALP,DATETM,STOP,DOCNM,LINECNT,DATA
+4 SET (DATETM,STOP,LINECNT)=0
+5 FOR
SET DATETM=$ORDER(^TMP("TIUPS185",$JOB,DATETM))
if (DATETM="")
QUIT
Begin DoDot:1
+6 SET DATA=$GET(^TMP("TIUPS185",$JOB,DATETM))
+7 SET DOCNM=$PIECE(DATA,"^",1)
SET INP=$PIECE(DATA,"^",2)
SET FINALP=$PIECE(DATA,"^",3)
+8 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+9 IF 'LINECNT
WRITE @IOF
DO HDR
+10 WRITE !,DOCNM,?17,INP,?38,FINALP,?58,$$FMTE^XLFDT(DATETM)
+11 SET LINECNT=LINECNT+1
+12 IF LINECNT=17
WRITE !
SET STOP='$$PAUSE
SET LINECNT=0
End DoDot:2
+13 IF '$TEST
WRITE !,DOCNM,?17,INP,?38,FINALP,?58,$$FMTE^XLFDT(DATETM)
End DoDot:1
if STOP
QUIT
+14 QUIT
+15 ;
HDR ; REPORT HEADER
+1 ;
+2 NEW TITLE
+3 SET TITLE="TIU REASSIGNMENT DOCUMENT REPORT"
+4 WRITE !?(IOM-$LENGTH(TITLE))/2,TITLE
+5 WRITE !!,"DOCUMENT NAME",?17,"INITIAL PATIENT",?38,"FINAL PATIENT",?58,"REASSIGNMENT DATE/TIME"
+6 WRITE !,"=============",?17,"===============",?38,"=============",?58,"======================"
+7 QUIT
+8 ;
GENINFO ; GENERAL INFORMATION
+1 ;
+2 NEW LINE,TXT
+3 FOR LINE=1:1
SET TXT=$PIECE($TEXT(TEXT+LINE),";;",2)
if TXT="EOT"
QUIT
WRITE @TXT,!
+4 QUIT
+5 ;
PAUSE() ;
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT
+2 SET DIR(0)="E"
+3 DO ^DIR
+4 QUIT $SELECT(Y'=1:0,1:1)
+5 ;
TEXT ;
+1 ;;"Date range searched: "_($$FMTE^XLFDT(DRANGE("START"),"D"))_" - "_($$FMTE^XLFDT(DRANGE("END"),"D"))
+2 ;;"Number of records searched: "_SEARCHN
+3 ;;"Number of records found: "_COUNT
+4 ;;"Elapsed time: "_(TIME("ELAP")\1)_" minute(s) "_($FN((TIME("ELAP")#1)*60,"-",0))_" second(s)"
+5 ;;"Current user: "_($$GET1^DIQ(200,+DUZ,.01))
+6 ;;"Current date: "_($$HTE^XLFDT($H))
+7 ;;EOT
+8 QUIT
