108 lines
3.3 KiB
Mathematica
108 lines
3.3 KiB
Mathematica
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
|