TIUPRDS.m

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

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