DDSPRNT ;SFISC/MKO-PRINT A FORM ;02:51 PM  18 Nov 1994
 ;;22.0;VA FileMan;;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
 ;
 N DDSFORM,DDSPBRK
 D SELFORM(.DDSFORM) Q:DDSFORM=-1
 D PAGEBRK(.DDSPBRK) Q:$D(DDSPBRK)[0
 ;
 ;Device
 S %ZIS=$S($D(^%ZTSK):"Q",1:"")
 W ! D ^%ZIS K %ZIS I $G(POP) K POP Q
 K POP
 ;
 ;Queue report
 I $D(IO("Q")),$D(^%ZTSK) D  G END
 . S ZTRTN="PRINT^DDSPRNT"
 . S ZTDESC="Report of Form "_$P(DDSFORM,U,2)
 . N I F I="DDSFORM","DDSFORM(0)","DDSPBRK" S ZTSAVE(I)=""
 . D ^%ZTLOAD
 . I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_$G(ZTSK),!
 . E  W !,"Report canceled!",!
 . K ZTSK
 . S IOP="HOME" D ^%ZIS
 ;
 U IO
 ;
PRINT ;Entry point for queued reports
 N DDSBK,DDSCOL1,DDSCOL2,DDSCOL3,DDSCRT,DDSFILE
 N DDSHLIN,DDSHBK,DDSPAGE,DDSQUE
 N DX,DY,X,Y
 ;
 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
 D INIT
 D @("HDR"_(2-DDSCRT))
 D FORM,END
 Q
 ;
FORM ;Form data
 W !
 ;
 ;Description
 D WP($NA(^DIST(.403,+DDSFORM,15))) Q:$D(DIRUT)
 ;
 ;Other properties
 D W("PRIMARY FILE: "_$P(DDSFORM(0),U,8),9) Q:$D(DIRUT)
 W ?49,"READ ACCESS: "_$P(DDSFORM(0),U,2)
 D W("DATE CREATED: "_$$EXTERNAL^DILFD(.403,4,"",$P(DDSFORM(0),U,5)),9) Q:$D(DIRUT)
 W ?48,"WRITE ACCESS: "_$P(DDSFORM(0),U,3)
 D W("DATE LAST USED: "_$$EXTERNAL^DILFD(.403,5,"",$P(DDSFORM(0),U,6)),7) Q:$D(DIRUT)
 W ?53,"CREATOR: "_$P(DDSFORM(0),U,4)
 D W() Q:$D(DIRUT)
 ;
 I $P(DDSFORM(0),U,7)]"" D W("TITLE: "_$P(DDSFORM(0),U,7),16) Q:$D(DIRUT)
 I $P($G(^DIST(.403,+DDSFORM,21)),U)]"" D W("RECORD SELECTION PAGE: "_$P(^(21),U)) Q:$D(DIRUT)
 ;
 I $X D W() Q:$D(DIRUT)
 S X=$G(^DIST(.403,+DDSFORM,11))
 I X]"" D W("PRE ACTION:",11) Q:$D(DIRUT)  D PCOL(X,23)
 S X=$G(^DIST(.403,+DDSFORM,12))
 I X]"" D W("POST ACTION:",10) Q:$D(DIRUT)  D PCOL(X,23)
 S X=$G(^DIST(.403,+DDSFORM,14))
 I X]"" D W("POST SAVE:",12) Q:$D(DIRUT)  D PCOL(X,23)
 S X=$G(^DIST(.403,+DDSFORM,20))
 I X]"" D W("DATA VALIDATION:",6) Q:$D(DIRUT)  D PCOL(X,23)
 K DDSFORM(0)
 ;
 ;Loop through all pages
 I $X D W() Q:$D(DIRUT)
 Q:'$O(^DIST(.403,+DDSFORM,40,0))
 ;
 N DDSPG,DDSPGN
 S DDSPGN="",DDSPFRST=1
 F  S DDSPGN=$O(^DIST(.403,+DDSFORM,40,"B",DDSPGN)) Q:DDSPGN=""!$D(DIRUT)  S DDSPG=0 F  S DDSPG=$O(^DIST(.403,+DDSFORM,40,"B",DDSPGN,DDSPG)) Q:'DDSPG!$D(DIRUT)  D PAGE^DDSPRNT1
 K DDSPFRST Q:$D(DIRUT)
 ;
 D:$D(DDSHBK) HBLKS^DDSPRNT1
 Q
 ;
WR(DDSLAB,DDSVAL,DDSFLG) ;Write label and value
 I DDSVAL="",'$G(DDSFLG) Q
 ;
 D W() Q:$D(DIRUT)
 W ?DDSCOL2,DDSLAB
 ;
 I $X>DDSCOL3 N DDSCOL3 S DDSCOL3=$X+1
 D PCOL(DDSVAL,DDSCOL3)
 Q
 ;
PCOL(DDSVAL,DDSCOL) ;Print DDSVAL
 N DDSWIDTH,DDSIND
 S DDSWIDTH=IOM-DDSCOL-1
 F DDSIND=1:DDSWIDTH:$L(DDSVAL) D  Q:$D(DIRUT)
 . I DDSIND>1 D W() Q:$D(DIRUT)
 . W ?DDSCOL,$E(DDSVAL,DDSIND,DDSIND+DDSWIDTH-1)
 Q
 ;
WP(DDSWP,DIWL,DDSLF) ;Print text in array @DDSWP
 ;DDSLF [ A : LF after (def)
 ;        B : LF feed before
 ;
 Q:'$P($G(@DDSWP@(0)),U,3)
 N DIW,DIWF,DIWI,DIWR,DIWT,DIWTC,DIWX,DN
 N DDSI,DDSCNT,I,X,Z
 ;
 K ^UTILITY($J,"W")
 S:'$G(DIWL) DIWL=1
 S DIWR=IOM-1
 S:'$D(DDSLF) DDSLF="A"
 ;
 S DDSCNT=$P($G(@DDSWP@(0)),U,3)
 I DDSCNT D
 . F DDSI=1:1:DDSCNT I $D(@DDSWP@(DDSI,0))#2 S X=^(0) D ^DIWP
 . ;
 . I DDSLF'["B" D
 .. W ?DIWL-1,$G(^UTILITY($J,"W",DIWL,1,0))
 .. S DDSCNT=1
 . E  S DDSCNT=0
 . F  S DDSCNT=$O(^UTILITY($J,"W",DIWL,DDSCNT)) Q:'DDSCNT!$D(DIRUT)  D
 .. D W($G(^UTILITY($J,"W",DIWL,DDSCNT,0)),DIWL-1)
 ;
 K ^UTILITY($J,"W")
 D:DDSLF["A" W()
 Q
 ;
W(DDSSTR,DDSCOL) ;Write DDSSTR
 I $Y+3'<IOSL D HEADER Q:$D(DIRUT)
 W !?+$G(DDSCOL),$G(DDSSTR)
 Q
 ;
HEADER ;All headers except first
 I DDSCRT D  Q:$D(DIRUT)
 . N DIR,X,Y
 . S DIR(0)="E" W ! D ^DIR
 I DDSQUE,$$S^%ZTLOAD S (ZTSTOP,DIRUT)=1 Q
 ;
HDR1 ;First header for CRTs
 W @IOF
 ;
HDR2 ;First header for non-CRTs
 ;
 S DDSPAGE=$G(DDSPAGE)+1
 W "FORM LISTING - "_$P(DDSFORM,U,2)_" (#"_+DDSFORM_")"
 W !,"FILE: "_DDSFILE
 W ?(IOM-$L(DDSHLIN)-$L(DDSPAGE)-1),DDSHLIN_DDSPAGE
 W !,$TR($J("",IOM-1)," ","-")
 Q
 ;
SELFORM(DDSFORM) ;Select form
 N %,%W,%Y,C,I,Q,DDH,DIC,X,Y
 S DIC="^DIST(.403,",DIC(0)="QEAMZ"
 D ^DIC K DIC
 S DDSFORM=Y,DDSFORM(0)=$G(Y(0))
 Q
 ;
PAGEBRK(DDSPBRK) ;Prompt
 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
 S DIR(0)="YO"
 S DIR("A")="Start each page of the form on a new page"
 S DIR("B")="Yes"
 W ! D ^DIR Q:$D(DIRUT)
 S DDSPBRK=Y
 Q
 ;
INIT ;Setup
 N %,%H,X,Y
 S %H=$H D YX^%DTC
 S DDSHLIN=$P(Y,"@")_"  "_$P($P(Y,"@",2),":",1,2)_"    PAGE "
 S DDSFILE=$P(DDSFORM(0),U,8)
 I DDSFILE,$D(^DIC(DDSFILE,0))#2 S DDSFILE=$P(^(0),U)_" (#"_DDSFILE_")"
 E  S DDSFILE=""
 S DDSCRT=$E(IOST,1,2)="C-"
 S DDSQUE=$D(ZTQUEUED)
 Q
 ;
END ;Finish up
 I $D(ZTQUEUED) S ZTREQ="@"
 E  X $G(^%ZIS("C"))
 K DIRUT,DUOUT,DTOUT
 Q