source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS185.m@ 1397

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