| 1 | TIUPRDS ; SLC/SBW - Print Form 10-1000 Discharge Summaries ; 6/9/04 | 
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**182**;Jun 20, 1997 | 
|---|
| 3 | WRITE(TIUFLAG) ; Writes form 10-1000 data to screen or paper. | 
|---|
| 4 | N ZTRTN,%I,%T,%Y,POP | 
|---|
| 5 | S ZTRTN="ENTRY^TIUPRDS" | 
|---|
| 6 | DEVICE ; Device handling | 
|---|
| 7 | ; Call with: ZTRTN | 
|---|
| 8 | N %ZIS,IOP | 
|---|
| 9 | S:$D(TIUDEV) %ZIS("B")=TIUDEV | 
|---|
| 10 | S %ZIS="Q" D ^%ZIS Q:POP | 
|---|
| 11 | S TIUDEV=ION | 
|---|
| 12 | G:$D(IO("Q")) QUE | 
|---|
| 13 | NOQUE D @ZTRTN | 
|---|
| 14 | D ^%ZISC | 
|---|
| 15 | Q | 
|---|
| 16 | QUE ; Queue output | 
|---|
| 17 | N %,ZTDTH,ZTIO,ZTSAVE,ZTSK | 
|---|
| 18 | Q:'$D(ZTRTN)  K IO("Q"),ZTSAVE F %="DA","DFN","TIU*" S ZTSAVE(%)="" | 
|---|
| 19 | S:'$D(ZTDESC) ZTDESC="PRINT DISCHARGE SUMMARY" S ZTIO=ION | 
|---|
| 20 | D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!") | 
|---|
| 21 | K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC | 
|---|
| 22 | S IOP="HOME" D ^%ZIS | 
|---|
| 23 | Q | 
|---|
| 24 | ENTRY ; Entry point to print queued discharge summary | 
|---|
| 25 | N TIUERR,TIUI,TIUJ,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT,TIU0,TIUINI | 
|---|
| 26 | K ^TMP("TIULQ",$J) | 
|---|
| 27 | S TIUINI=1 ; Indicate initials only for transcriber | 
|---|
| 28 | I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry | 
|---|
| 29 | U IO | 
|---|
| 30 | I '$D(^TMP("TIUPR",$J)) W !,"No Document Record Specified.",$C(7) Q | 
|---|
| 31 | ; -- Change variable DFN to TIUJ since not used except to sort, | 
|---|
| 32 | ;    and does not equal DFN with changes to TIURA in patch 182. | 
|---|
| 33 | S TIUJ=0 F  S TIUJ=$O(^TMP("TIUPR",$J,TIUJ)) Q:TIUJ=""  D | 
|---|
| 34 | . S TIUI=0 F  S TIUI=$O(^TMP("TIUPR",$J,TIUJ,TIUI)) Q:+TIUI'>0!$D(DIROUT)  D | 
|---|
| 35 | . . N TIUDA S TIUDA=0 | 
|---|
| 36 | . . F  S TIUDA=+$O(^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA)) Q:+TIUDA'>0!$D(DIROUT)  D | 
|---|
| 37 | . . . S TIU0=$G(^TIU(8925,+TIUDA,0)) | 
|---|
| 38 | . . . I +$$ISADDNDM^TIULC1(TIUDA) S TIUDA=$P(TIU0,U,6) | 
|---|
| 39 | . . . D EXTRACT^TIULQ(+TIUDA,"^TMP(""TIULQ"",$J)",.TIUERR,"","",1) | 
|---|
| 40 | . . . I +$G(TIUERR) W !,$P(TIUERR,U,2) Q | 
|---|
| 41 | . . . Q:'$D(^TMP("TIULQ",$J)) | 
|---|
| 42 | . . . D PRINT^TIUPRDS1(+TIUDA,$G(TIUFLAG)) | 
|---|
| 43 | . . . K ^TMP("TIULQ",$J),^TMP("TIUPR",$J,TIUJ,TIUI,TIUDA) | 
|---|
| 44 | Q | 
|---|