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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRCN 1905 printed Oct 16, 2024@18:44:09 Page 2
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
