Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUPS185

TIUPS185.m

Go to the documentation of this file. 
  1. 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
  1.  Q
  1. EN ;
  1.  ;
  1.  K ^TMP("TIUPS185",$J) ;ENSURE FRESH START
  1.  N TIUSAVE,DRANGE
  1.  D ASKDATE(.DRANGE) Q:$G(DRANGE("EXIT"))="YES"
  1.  S TIUSAVE("*")=""
  1.  D EN^XUTMDEVQ("REPORT^TIUPS185","REPORT FOR TIU REASSIGNMENT DOCUMENTS",.TIUSAVE)
  1.  Q
  1.  ;
  1. ASKDATE(DRANGE) ; ASK USER FOR DATE RANGE
  1.  ;  DRANGE - DATE RANGE FOR REPORT
  1.  ;
  1.  N %DT,DIR,X,Y,POP,CNT
  1.  S %DT="AE"
  1.  F CNT=1:1:2 D
  1.  .S %DT("A")=$S(CNT=1:"ENTER STARTING DATE: ",CNT=2:"ENTER ENDING DATE: ")
  1.  .S %DT("B")=$S(CNT=1:"JAN 01, 2003",CNT=2:$P($$HTE^XLFDT($H),"@"))
  1.  .D ^%DT
  1.  .I Y=-1 S CNT=2,DRANGE("EXIT")="YES" Q
  1.  .I CNT=1 D
  1.  ..I Y["0000" S Y=Y/10000,Y=Y_"0101"
  1.  ..S DRANGE("START")=Y
  1.  .I CNT=2 D
  1.  ..I Y["0000" S Y=Y/10000,Y=Y_"1231"
  1.  ..S DRANGE("END")=Y_".24"
  1.  Q
  1.  ;
  1. REPORT ;  PRINT REPORT 
  1.  ;  AUDIEN - TIU AUDIT TRAIL IEN
  1.  ;  REDT - REASSIGNMENT DATE/TIME
  1.  ;  DOCIEN - TIU DOCUMENT IEN
  1.  ;  INPAT - INITIAL PATIENT
  1.  ;  POSTPAT - FINAL PATIENT
  1.  ;  DNAME - TIU DOCUMENT NAME 
  1.  ;
  1.  N REDT,DOCIEN,INPAT,POSTPAT,DNAME,TIME,COUNT,SEARCHN
  1.  S (DOCIEN,COUNT,SEARCHN)=0,TIME("START")=$$NOW^XLFDT
  1.  W:'$D(ZTQUEUED) !,"Searching...",!!
  1.  F  S DOCIEN=$O(^TIU(8925.5,DOCIEN)) Q:DOCIEN'>0  S SEARCHN=SEARCHN+1  D
  1.  .Q:'$D(^TIU(8925.5,DOCIEN,0))
  1.  .Q:'$D(^TIU(8925.5,DOCIEN,1))
  1.  .S REDT=$P(^TIU(8925.5,DOCIEN,1),"^")
  1.  .I ((REDT'<DRANGE("START"))&(REDT'>DRANGE("END"))) D
  1.  ..S INPAT=$E($$GET1^DIQ(8925.5,DOCIEN,1.03),1,19)
  1.  ..S:INPAT="" INPAT="UNKNOWN"
  1.  ..S POSTPAT=$E($$GET1^DIQ(8925.5,DOCIEN,1.04),1,19)
  1.  ..S:POSTPAT="" POSTPAT="UNKNOWN"
  1.  ..S DNAME=$E($$GET1^DIQ(8925.5,DOCIEN,.01),1,15)
  1.  ..S:DNAME="" DNAME="UNKNOWN"
  1.  ..S COUNT=COUNT+1
  1.  ..S ^TMP("TIUPS185",$J,REDT)=DNAME_"^"_INPAT_"^"_POSTPAT
  1.  S TIME("STOP")=$$NOW^XLFDT,TIME("ELAP")=$FN($$FMDIFF^XLFDT(TIME("START"),TIME("STOP"),2)/60,"-")
  1.  I COUNT=0 W !!?20,"NO DOCUMENTS FOUND!"
  1.  E  D
  1.  .D GENINFO
  1.  .D DISPLAY
  1.  Q
  1.  ;
  1. DISPLAY ;DISPLAY DATA
  1.  ;
  1.  I $E(IOST,1,2)'="C-" D HDR
  1.  N INP,FINALP,DATETM,STOP,DOCNM,LINECNT,DATA
  1.  S (DATETM,STOP,LINECNT)=0
  1.  F  S DATETM=$O(^TMP("TIUPS185",$J,DATETM)) Q:(DATETM="")  D  Q:STOP
  1.  .S DATA=$G(^TMP("TIUPS185",$J,DATETM))
  1.  .S DOCNM=$P(DATA,"^",1),INP=$P(DATA,"^",2),FINALP=$P(DATA,"^",3)
  1.  .I $E(IOST,1,2)="C-" D
  1.  ..I 'LINECNT W @IOF D HDR
  1.  ..W !,DOCNM,?17,INP,?38,FINALP,?58,$$FMTE^XLFDT(DATETM)
  1.  ..S LINECNT=LINECNT+1
  1.  ..I LINECNT=17 W ! S STOP='$$PAUSE,LINECNT=0
  1.  .E  W !,DOCNM,?17,INP,?38,FINALP,?58,$$FMTE^XLFDT(DATETM)
  1.  Q
  1.  ;
  1. HDR ; REPORT HEADER
  1.  ;
  1.  N TITLE
  1.  S TITLE="TIU REASSIGNMENT DOCUMENT REPORT"
  1.  W !?(IOM-$L(TITLE))/2,TITLE
  1.  W !!,"DOCUMENT NAME",?17,"INITIAL PATIENT",?38,"FINAL PATIENT",?58,"REASSIGNMENT DATE/TIME"
  1.  W !,"=============",?17,"===============",?38,"=============",?58,"======================"
  1.  Q
  1.  ;
  1. GENINFO ; GENERAL INFORMATION
  1.  ;
  1.  N LINE,TXT
  1.  F LINE=1:1 S TXT=$P($T(TEXT+LINE),";;",2) Q:TXT="EOT"  W @TXT,!
  1.  Q
  1.  ;
  1. PAUSE() ;
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  Q $S(Y'=1:0,1:1)
  1.  ;
  1. TEXT ;
  1.  ;;"Date range searched: "_($$FMTE^XLFDT(DRANGE("START"),"D"))_" - "_($$FMTE^XLFDT(DRANGE("END"),"D"))
  1.  ;;"Number of records searched: "_SEARCHN
  1.  ;;"Number of records found: "_COUNT
  1.  ;;"Elapsed time: "_(TIME("ELAP")\1)_" minute(s) "_($FN((TIME("ELAP")#1)*60,"-",0))_" second(s)"
  1.  ;;"Current user: "_($$GET1^DIQ(200,+DUZ,.01))
  1.  ;;"Current date: "_($$HTE^XLFDT($H))
  1.  ;;EOT
  1.  Q