TIUPRCN.m

TIUPRCN ; SLC/JER - Driver to Print Form 513 Consult Reports ;10/5/04

 ;;1.0;TEXT INTEGRATION UTILITY;**4,182**;Jun 20, 1997

 ; Call to TIUEN^GMRCP513 supported by DBIA 3957

ENTRY ; Entry point to print SF 513

 N TIUERR,TIUI,TIUJ,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT,TIU0,TIU14,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

 ; -- P182 If no Print Group, TIUJ may begin 0$... 

 S TIUJ=0 F  S TIUJ=$O(^TMP("TIUPR",$J,TIUJ)) G:TIUJ="" ENTRYX  D

 . S TIUI=0 F  S TIUI=$O(^TMP("TIUPR",$J,TIUJ,TIUI)) Q:TIUI'>0!$D(DIROUT)  D

 . . N TIUDA,TIUCDA ;P182

 . . 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)),TIU14=$G(^(14))

 . . . I +$$ISADDNDM^TIULC1(TIUDA) S TIUDA=$P(TIU0,U,6)

 . . . S TIUCDA=+$P(TIU14,U,5)

 . . . I +TIUCDA'>0 D  Q

 . . . . ; W !!,"This Consult Result is not associated with a request.",!

 . . . . ; -- If note has no request, print that note only, using

 . . . . ;    PN Print Method (P182):

 . . . . M ^TMP("TIUTMPPR",$J)=^TMP("TIUPR",$J)

 . . . . K ^TMP("TIUPR",$J)

 . . . . S ^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)=^TMP("TIUTMPPR",$J,TIUJ,TIUI,TIUDA)

 . . . . D ENTRY^TIUPRPN

 . . . . M ^TMP("TIUPR",$J)=^TMP("TIUTMPPR",$J)

 . . . . K ^TMP("TIUTMPPR",$J)

 . . . . ; I $E(IOST)="C-",$$READ^TIUU("EA","Press RETURN to continue...")

 . . . . K ^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)

 . . . N VALMAR,VALMCNT,VALMPGE

 . . . ; -- Don't repeat if request already printed (P182):

 . . . I '$D(^TMP("TIUPRCDA",$J,TIUCDA)) D TIUEN^GMRCP513(TIUCDA) S ^TMP("TIUPRCDA",$J,TIUCDA)="" I $E(IOST)="C-",$$READ^TIUU("EA","Press RETURN to continue...")

 . . . K ^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)

ENTRYX ;

 K ^TMP("TIUPRCDA",$J)

 Q

TIUPRCN   ; SLC/JER - Driver to Print Form 513 Consult Reports ;10/5/04

 +1       ;;1.0;TEXT INTEGRATION UTILITY;**4,182**;Jun 20, 1997

 +2       ; Call to TIUEN^GMRCP513 supported by DBIA 3957

ENTRY     ; Entry point to print SF 513

 +1        NEW TIUERR,TIUI,TIUJ,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT,TIU0,TIU14,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       ; -- P182 If no Print Group, TIUJ may begin 0$... 

 +8        SET TIUJ=0

           FOR 

               SET TIUJ=$ORDER(^TMP("TIUPR",$JOB,TIUJ))

               IF TIUJ=""

                   GOTO ENTRYX

               Begin DoDot:1

 +9                SET TIUI=0

                   FOR 

                       SET TIUI=$ORDER(^TMP("TIUPR",$JOB,TIUJ,TIUI))

                       IF TIUI'>0!$DATA(DIROUT)

                           QUIT 

                       Begin DoDot:2

 +10      ;P182

                           NEW TIUDA,TIUCDA

 +11                       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))

                                   SET TIU14=$GET(^(14))

 +14                               IF +$$ISADDNDM^TIULC1(TIUDA)

                                       SET TIUDA=$PIECE(TIU0,U,6)

 +15                               SET TIUCDA=+$PIECE(TIU14,U,5)

 +16                               IF +TIUCDA'>0

                                       Begin DoDot:4

 +17      ; W !!,"This Consult Result is not associated with a request.",!

 +18      ; -- If note has no request, print that note only, using

 +19      ;    PN Print Method (P182):

 +20                                       MERGE ^TMP("TIUTMPPR",$JOB)=^TMP("TIUPR",$JOB)

 +21                                       KILL ^TMP("TIUPR",$JOB)

 +22                                       SET ^TMP("TIUPR",$JOB,TIUJ,TIUI,TIUDA)=^TMP("TIUTMPPR",$JOB,TIUJ,TIUI,TIUDA)

 +23                                       DO ENTRY^TIUPRPN

 +24                                       MERGE ^TMP("TIUPR",$JOB)=^TMP("TIUTMPPR",$JOB)

 +25                                       KILL ^TMP("TIUTMPPR",$JOB)

 +26      ; I $E(IOST)="C-",$$READ^TIUU("EA","Press RETURN to continue...")

 +27                                       KILL ^TMP("TIUPR",$JOB,TIUJ,TIUI,TIUDA)

                                       End DoDot:4

                                       QUIT 

 +28                               NEW VALMAR,VALMCNT,VALMPGE

 +29      ; -- Don't repeat if request already printed (P182):

 +30                               IF '$DATA(^TMP("TIUPRCDA",$JOB,TIUCDA))

                                       DO TIUEN^GMRCP513(TIUCDA)

                                       SET ^TMP("TIUPRCDA",$JOB,TIUCDA)=""

                                       IF $EXTRACT(IOST)="C-"

                                           IF $$READ^TIUU("EA","Press RETURN to continue...")

 +31                               KILL ^TMP("TIUPR",$JOB,TIUJ,TIUI,TIUDA)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

ENTRYX    ;

 +1        KILL ^TMP("TIUPRCDA",$JOB)

 +2        QUIT