TIUPRDS ; SLC/SBW - Print Form 10-1000 Discharge Summaries ; 6/9/04
;;1.0;TEXT INTEGRATION UTILITIES;**182**;Jun 20, 1997
WRITE(TIUFLAG) ; Writes form 10-1000 data to screen or paper.
N ZTRTN,%I,%T,%Y,POP
S ZTRTN="ENTRY^TIUPRDS"
DEVICE ; Device handling
; Call with: ZTRTN
N %ZIS,IOP
S:$D(TIUDEV) %ZIS("B")=TIUDEV
S %ZIS="Q" D ^%ZIS Q:POP
S TIUDEV=ION
G:$D(IO("Q")) QUE
NOQUE D @ZTRTN
D ^%ZISC
Q
QUE ; Queue output
N %,ZTDTH,ZTIO,ZTSAVE,ZTSK
Q:'$D(ZTRTN) K IO("Q"),ZTSAVE F %="DA","DFN","TIU*" S ZTSAVE(%)=""
S:'$D(ZTDESC) ZTDESC="PRINT DISCHARGE SUMMARY" S ZTIO=ION
D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
S IOP="HOME" D ^%ZIS
Q
ENTRY ; Entry point to print queued discharge summary
N TIUERR,TIUI,TIUJ,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT,TIU0,TIUINI
K ^TMP("TIULQ",$J)
S TIUINI=1 ; Indicate initials only for transcriber
I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
U IO
I '$D(^TMP("TIUPR",$J)) W !,"No Document Record Specified.",$C(7) Q
; -- Change variable DFN to TIUJ since not used except to sort,
; and does not equal DFN with changes to TIURA in patch 182.
S TIUJ=0 F S TIUJ=$O(^TMP("TIUPR",$J,TIUJ)) Q:TIUJ="" D
. S TIUI=0 F S TIUI=$O(^TMP("TIUPR",$J,TIUJ,TIUI)) Q:+TIUI'>0!$D(DIROUT) D
. . N TIUDA S TIUDA=0
. . F S TIUDA=+$O(^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)) Q:+TIUDA'>0!$D(DIROUT) D
. . . S TIU0=$G(^TIU(8925,+TIUDA,0))
. . . I +$$ISADDNDM^TIULC1(TIUDA) S TIUDA=$P(TIU0,U,6)
. . . D EXTRACT^TIULQ(+TIUDA,"^TMP(""TIULQ"",$J)",.TIUERR,"","",1)
. . . I +$G(TIUERR) W !,$P(TIUERR,U,2) Q
. . . Q:'$D(^TMP("TIULQ",$J))
. . . D PRINT^TIUPRDS1(+TIUDA,$G(TIUFLAG))
. . . K ^TMP("TIULQ",$J),^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRDS 1815 printed Dec 13, 2024@02:43:36 Page 2
TIUPRDS ; SLC/SBW - Print Form 10-1000 Discharge Summaries ; 6/9/04
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**182**;Jun 20, 1997
WRITE(TIUFLAG) ; Writes form 10-1000 data to screen or paper.
+1 NEW ZTRTN,%I,%T,%Y,POP
+2 SET ZTRTN="ENTRY^TIUPRDS"
DEVICE ; Device handling
+1 ; Call with: ZTRTN
+2 NEW %ZIS,IOP
+3 if $DATA(TIUDEV)
SET %ZIS("B")=TIUDEV
+4 SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+5 SET TIUDEV=ION
+6 if $DATA(IO("Q"))
GOTO QUE
NOQUE DO @ZTRTN
+1 DO ^%ZISC
+2 QUIT
QUE ; Queue output
+1 NEW %,ZTDTH,ZTIO,ZTSAVE,ZTSK
+2 if '$DATA(ZTRTN)
QUIT
KILL IO("Q"),ZTSAVE
FOR %="DA","DFN","TIU*"
SET ZTSAVE(%)=""
+3 if '$DATA(ZTDESC)
SET ZTDESC="PRINT DISCHARGE SUMMARY"
SET ZTIO=ION
+4 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
+5 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
DO ^%ZISC
+6 SET IOP="HOME"
DO ^%ZIS
+7 QUIT
ENTRY ; Entry point to print queued discharge summary
+1 NEW TIUERR,TIUI,TIUJ,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT,TIU0,TIUINI
+2 KILL ^TMP("TIULQ",$JOB)
+3 ; Indicate initials only for transcriber
SET TIUINI=1
+4 ; Tell TaskMan to delete Task log entry
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 USE IO
+6 IF '$DATA(^TMP("TIUPR",$JOB))
WRITE !,"No Document Record Specified.",$CHAR(7)
QUIT
+7 ; -- Change variable DFN to TIUJ since not used except to sort,
+8 ; and does not equal DFN with changes to TIURA in patch 182.
+9 SET TIUJ=0
FOR
SET TIUJ=$ORDER(^TMP("TIUPR",$JOB,TIUJ))
if TIUJ=""
QUIT
Begin DoDot:1
+10 SET TIUI=0
FOR
SET TIUI=$ORDER(^TMP("TIUPR",$JOB,TIUJ,TIUI))
if +TIUI'>0!$DATA(DIROUT)
QUIT
Begin DoDot:2
+11 NEW TIUDA
SET TIUDA=0
+12 FOR
SET TIUDA=+$ORDER(^TMP("TIUPR",$JOB,TIUJ,TIUI,TIUDA))
if +TIUDA'>0!$DATA(DIROUT)
QUIT
Begin DoDot:3
+13 SET TIU0=$GET(^TIU(8925,+TIUDA,0))
+14 IF +$$ISADDNDM^TIULC1(TIUDA)
SET TIUDA=$PIECE(TIU0,U,6)
+15 DO EXTRACT^TIULQ(+TIUDA,"^TMP(""TIULQ"",$J)",.TIUERR,"","",1)
+16 IF +$GET(TIUERR)
WRITE !,$PIECE(TIUERR,U,2)
QUIT
+17 if '$DATA(^TMP("TIULQ",$JOB))
QUIT
+18 DO PRINT^TIUPRDS1(+TIUDA,$GET(TIUFLAG))
+19 KILL ^TMP("TIULQ",$JOB),^TMP("TIUPR",$JOB,TIUJ,TIUI,TIUDA)
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
