source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPRCN.m@ 1432

Last change on this file since 1432 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1TIUPRCN ; SLC/JER - Driver to Print Form 513 Consult Reports ;10/5/04
2 ;;1.0;TEXT INTEGRATION UTILITY;**4,182**;Jun 20, 1997
3 ; Call to TIUEN^GMRCP513 supported by DBIA 3957
4ENTRY ; Entry point to print SF 513
5 N TIUERR,TIUI,TIUJ,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT,TIU0,TIU14,TIUINI
6 K ^TMP("TIULQ",$J)
7 S TIUINI=1 ; Indicate initials only for transcriber
8 I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
9 U IO
10 I '$D(^TMP("TIUPR",$J)) W !,"No Document Record Specified.",$C(7) Q
11 ; -- P182 If no Print Group, TIUJ may begin 0$...
12 S TIUJ=0 F S TIUJ=$O(^TMP("TIUPR",$J,TIUJ)) G:TIUJ="" ENTRYX D
13 . S TIUI=0 F S TIUI=$O(^TMP("TIUPR",$J,TIUJ,TIUI)) Q:TIUI'>0!$D(DIROUT) D
14 . . N TIUDA,TIUCDA ;P182
15 . . S TIUDA=0
16 . . F S TIUDA=+$O(^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)) Q:+TIUDA'>0!$D(DIROUT) D
17 . . . S TIU0=$G(^TIU(8925,+TIUDA,0)),TIU14=$G(^(14))
18 . . . I +$$ISADDNDM^TIULC1(TIUDA) S TIUDA=$P(TIU0,U,6)
19 . . . S TIUCDA=+$P(TIU14,U,5)
20 . . . I +TIUCDA'>0 D Q
21 . . . . ; W !!,"This Consult Result is not associated with a request.",!
22 . . . . ; -- If note has no request, print that note only, using
23 . . . . ; PN Print Method (P182):
24 . . . . M ^TMP("TIUTMPPR",$J)=^TMP("TIUPR",$J)
25 . . . . K ^TMP("TIUPR",$J)
26 . . . . S ^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)=^TMP("TIUTMPPR",$J,TIUJ,TIUI,TIUDA)
27 . . . . D ENTRY^TIUPRPN
28 . . . . M ^TMP("TIUPR",$J)=^TMP("TIUTMPPR",$J)
29 . . . . K ^TMP("TIUTMPPR",$J)
30 . . . . ; I $E(IOST)="C-",$$READ^TIUU("EA","Press RETURN to continue...")
31 . . . . K ^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)
32 . . . N VALMAR,VALMCNT,VALMPGE
33 . . . ; -- Don't repeat if request already printed (P182):
34 . . . 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...")
35 . . . K ^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)
36ENTRYX ;
37 K ^TMP("TIUPRCDA",$J)
38 Q
Note: See TracBrowser for help on using the repository browser.