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

TIUPRDS.m

Go to the documentation of this file.
  1. TIUPRDS ; SLC/SBW - Print Form 10-1000 Discharge Summaries ; 6/9/04
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**182**;Jun 20, 1997
  1. WRITE(TIUFLAG) ; Writes form 10-1000 data to screen or paper.
  1. N ZTRTN,%I,%T,%Y,POP
  1. S ZTRTN="ENTRY^TIUPRDS"
  1. DEVICE ; Device handling
  1. ; Call with: ZTRTN
  1. N %ZIS,IOP
  1. S:$D(TIUDEV) %ZIS("B")=TIUDEV
  1. S %ZIS="Q" D ^%ZIS Q:POP
  1. S TIUDEV=ION
  1. G:$D(IO("Q")) QUE
  1. NOQUE D @ZTRTN
  1. D ^%ZISC
  1. Q
  1. QUE ; Queue output
  1. N %,ZTDTH,ZTIO,ZTSAVE,ZTSK
  1. Q:'$D(ZTRTN) K IO("Q"),ZTSAVE F %="DA","DFN","TIU*" S ZTSAVE(%)=""
  1. S:'$D(ZTDESC) ZTDESC="PRINT DISCHARGE SUMMARY" S ZTIO=ION
  1. D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
  1. K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
  1. S IOP="HOME" D ^%ZIS
  1. Q
  1. ENTRY ; Entry point to print queued discharge summary
  1. N TIUERR,TIUI,TIUJ,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT,TIU0,TIUINI
  1. K ^TMP("TIULQ",$J)
  1. S TIUINI=1 ; Indicate initials only for transcriber
  1. I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
  1. U IO
  1. I '$D(^TMP("TIUPR",$J)) W !,"No Document Record Specified.",$C(7) Q
  1. ; -- Change variable DFN to TIUJ since not used except to sort,
  1. ; and does not equal DFN with changes to TIURA in patch 182.
  1. S TIUJ=0 F S TIUJ=$O(^TMP("TIUPR",$J,TIUJ)) Q:TIUJ="" D
  1. . S TIUI=0 F S TIUI=$O(^TMP("TIUPR",$J,TIUJ,TIUI)) Q:+TIUI'>0!$D(DIROUT) D
  1. . . N TIUDA S TIUDA=0
  1. . . F S TIUDA=+$O(^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)) Q:+TIUDA'>0!$D(DIROUT) D
  1. . . . S TIU0=$G(^TIU(8925,+TIUDA,0))
  1. . . . I +$$ISADDNDM^TIULC1(TIUDA) S TIUDA=$P(TIU0,U,6)
  1. . . . D EXTRACT^TIULQ(+TIUDA,"^TMP(""TIULQ"",$J)",.TIUERR,"","",1)
  1. . . . I +$G(TIUERR) W !,$P(TIUERR,U,2) Q
  1. . . . Q:'$D(^TMP("TIULQ",$J))
  1. . . . D PRINT^TIUPRDS1(+TIUDA,$G(TIUFLAG))
  1. . . . K ^TMP("TIULQ",$J),^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)
  1. Q