- 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 Feb 19, 2025@00:10:05 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