Return to DDSPRNT.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSPRNT	;SFISC/MKO-PRINT A FORM ;02:51 PM  18 Nov 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
    6: 	;
    7: 	N DDSFORM,DDSPBRK
    8: 	D SELFORM(.DDSFORM) Q:DDSFORM=-1
    9: 	D PAGEBRK(.DDSPBRK) Q:$D(DDSPBRK)[0
   10: 	;
   11: 	;Device
   12: 	S %ZIS=$S($D(^%ZTSK):"Q",1:"")
   13: 	W ! D ^%ZIS K %ZIS I $G(POP) K POP Q
   14: 	K POP
   15: 	;
   16: 	;Queue report
   17: 	I $D(IO("Q")),$D(^%ZTSK) D  G END
   18: 	. S ZTRTN="PRINT^DDSPRNT"
   19: 	. S ZTDESC="Report of Form "_$P(DDSFORM,U,2)
   20: 	. N I F I="DDSFORM","DDSFORM(0)","DDSPBRK" S ZTSAVE(I)=""
   21: 	. D ^%ZTLOAD
   22: 	. I $D(ZTSK)#2 W !,"Report queued!",!,"Task number: "_$G(ZTSK),!
   23: 	. E  W !,"Report canceled!",!
   24: 	. K ZTSK
   25: 	. S IOP="HOME" D ^%ZIS
   26: 	;
   27: 	U IO
   28: 	;
   29: PRINT	;Entry point for queued reports
   30: 	N DDSBK,DDSCOL1,DDSCOL2,DDSCOL3,DDSCRT,DDSFILE
   31: 	N DDSHLIN,DDSHBK,DDSPAGE,DDSQUE
   32: 	N DX,DY,X,Y
   33: 	;
   34: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
   35: 	D INIT
   36: 	D @("HDR"_(2-DDSCRT))
   37: 	D FORM,END
   38: 	Q
   39: 	;
   40: FORM	;Form data
   41: 	W !
   42: 	;
   43: 	;Description
   44: 	D WP($NA(^DIST(.403,+DDSFORM,15))) Q:$D(DIRUT)
   45: 	;
   46: 	;Other properties
   47: 	D W("PRIMARY FILE: "_$P(DDSFORM(0),U,8),9) Q:$D(DIRUT)
   48: 	W ?49,"READ ACCESS: "_$P(DDSFORM(0),U,2)
   49: 	D W("DATE CREATED: "_$$EXTERNAL^DILFD(.403,4,"",$P(DDSFORM(0),U,5)),9) Q:$D(DIRUT)
   50: 	W ?48,"WRITE ACCESS: "_$P(DDSFORM(0),U,3)
   51: 	D W("DATE LAST USED: "_$$EXTERNAL^DILFD(.403,5,"",$P(DDSFORM(0),U,6)),7) Q:$D(DIRUT)
   52: 	W ?53,"CREATOR: "_$P(DDSFORM(0),U,4)
   53: 	D W() Q:$D(DIRUT)
   54: 	;
   55: 	I $P(DDSFORM(0),U,7)]"" D W("TITLE: "_$P(DDSFORM(0),U,7),16) Q:$D(DIRUT)
   56: 	I $P($G(^DIST(.403,+DDSFORM,21)),U)]"" D W("RECORD SELECTION PAGE: "_$P(^(21),U)) Q:$D(DIRUT)
   57: 	;
   58: 	I $X D W() Q:$D(DIRUT)
   59: 	S X=$G(^DIST(.403,+DDSFORM,11))
   60: 	I X]"" D W("PRE ACTION:",11) Q:$D(DIRUT)  D PCOL(X,23)
   61: 	S X=$G(^DIST(.403,+DDSFORM,12))
   62: 	I X]"" D W("POST ACTION:",10) Q:$D(DIRUT)  D PCOL(X,23)
   63: 	S X=$G(^DIST(.403,+DDSFORM,14))
   64: 	I X]"" D W("POST SAVE:",12) Q:$D(DIRUT)  D PCOL(X,23)
   65: 	S X=$G(^DIST(.403,+DDSFORM,20))
   66: 	I X]"" D W("DATA VALIDATION:",6) Q:$D(DIRUT)  D PCOL(X,23)
   67: 	K DDSFORM(0)
   68: 	;
   69: 	;Loop through all pages
   70: 	I $X D W() Q:$D(DIRUT)
   71: 	Q:'$O(^DIST(.403,+DDSFORM,40,0))
   72: 	;
   73: 	N DDSPG,DDSPGN
   74: 	S DDSPGN="",DDSPFRST=1
   75: 	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
   76: 	K DDSPFRST Q:$D(DIRUT)
   77: 	;
   78: 	D:$D(DDSHBK) HBLKS^DDSPRNT1
   79: 	Q
   80: 	;
   81: WR(DDSLAB,DDSVAL,DDSFLG)	;Write label and value
   82: 	I DDSVAL="",'$G(DDSFLG) Q
   83: 	;
   84: 	D W() Q:$D(DIRUT)
   85: 	W ?DDSCOL2,DDSLAB
   86: 	;
   87: 	I $X>DDSCOL3 N DDSCOL3 S DDSCOL3=$X+1
   88: 	D PCOL(DDSVAL,DDSCOL3)
   89: 	Q
   90: 	;
   91: PCOL(DDSVAL,DDSCOL)	;Print DDSVAL
   92: 	N DDSWIDTH,DDSIND
   93: 	S DDSWIDTH=IOM-DDSCOL-1
   94: 	F DDSIND=1:DDSWIDTH:$L(DDSVAL) D  Q:$D(DIRUT)
   95: 	. I DDSIND>1 D W() Q:$D(DIRUT)
   96: 	. W ?DDSCOL,$E(DDSVAL,DDSIND,DDSIND+DDSWIDTH-1)
   97: 	Q
   98: 	;
   99: WP(DDSWP,DIWL,DDSLF)	;Print text in array @DDSWP
  100: 	;DDSLF [ A : LF after (def)
  101: 	;        B : LF feed before
  102: 	;
  103: 	Q:'$P($G(@DDSWP@(0)),U,3)
  104: 	N DIW,DIWF,DIWI,DIWR,DIWT,DIWTC,DIWX,DN
  105: 	N DDSI,DDSCNT,I,X,Z
  106: 	;
  107: 	K ^UTILITY($J,"W")
  108: 	S:'$G(DIWL) DIWL=1
  109: 	S DIWR=IOM-1
  110: 	S:'$D(DDSLF) DDSLF="A"
  111: 	;
  112: 	S DDSCNT=$P($G(@DDSWP@(0)),U,3)
  113: 	I DDSCNT D
  114: 	. F DDSI=1:1:DDSCNT I $D(@DDSWP@(DDSI,0))#2 S X=^(0) D ^DIWP
  115: 	. ;
  116: 	. I DDSLF'["B" D
  117: 	.. W ?DIWL-1,$G(^UTILITY($J,"W",DIWL,1,0))
  118: 	.. S DDSCNT=1
  119: 	. E  S DDSCNT=0
  120: 	. F  S DDSCNT=$O(^UTILITY($J,"W",DIWL,DDSCNT)) Q:'DDSCNT!$D(DIRUT)  D
  121: 	.. D W($G(^UTILITY($J,"W",DIWL,DDSCNT,0)),DIWL-1)
  122: 	;
  123: 	K ^UTILITY($J,"W")
  124: 	D:DDSLF["A" W()
  125: 	Q
  126: 	;
  127: W(DDSSTR,DDSCOL)	;Write DDSSTR
  128: 	I $Y+3'<IOSL D HEADER Q:$D(DIRUT)
  129: 	W !?+$G(DDSCOL),$G(DDSSTR)
  130: 	Q
  131: 	;
  132: HEADER	;All headers except first
  133: 	I DDSCRT D  Q:$D(DIRUT)
  134: 	. N DIR,X,Y
  135: 	. S DIR(0)="E" W ! D ^DIR
  136: 	I DDSQUE,$$S^%ZTLOAD S (ZTSTOP,DIRUT)=1 Q
  137: 	;
  138: HDR1	;First header for CRTs
  139: 	W @IOF
  140: 	;
  141: HDR2	;First header for non-CRTs
  142: 	;
  143: 	S DDSPAGE=$G(DDSPAGE)+1
  144: 	W "FORM LISTING - "_$P(DDSFORM,U,2)_" (#"_+DDSFORM_")"
  145: 	W !,"FILE: "_DDSFILE
  146: 	W ?(IOM-$L(DDSHLIN)-$L(DDSPAGE)-1),DDSHLIN_DDSPAGE
  147: 	W !,$TR($J("",IOM-1)," ","-")
  148: 	Q
  149: 	;
  150: SELFORM(DDSFORM)	;Select form
  151: 	N %,%W,%Y,C,I,Q,DDH,DIC,X,Y
  152: 	S DIC="^DIST(.403,",DIC(0)="QEAMZ"
  153: 	D ^DIC K DIC
  154: 	S DDSFORM=Y,DDSFORM(0)=$G(Y(0))
  155: 	Q
  156: 	;
  157: PAGEBRK(DDSPBRK)	;Prompt
  158: 	N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  159: 	S DIR(0)="YO"
  160: 	S DIR("A")="Start each page of the form on a new page"
  161: 	S DIR("B")="Yes"
  162: 	W ! D ^DIR Q:$D(DIRUT)
  163: 	S DDSPBRK=Y
  164: 	Q
  165: 	;
  166: INIT	;Setup
  167: 	N %,%H,X,Y
  168: 	S %H=$H D YX^%DTC
  169: 	S DDSHLIN=$P(Y,"@")_"  "_$P($P(Y,"@",2),":",1,2)_"    PAGE "
  170: 	S DDSFILE=$P(DDSFORM(0),U,8)
  171: 	I DDSFILE,$D(^DIC(DDSFILE,0))#2 S DDSFILE=$P(^(0),U)_" (#"_DDSFILE_")"
  172: 	E  S DDSFILE=""
  173: 	S DDSCRT=$E(IOST,1,2)="C-"
  174: 	S DDSQUE=$D(ZTQUEUED)
  175: 	Q
  176: 	;
  177: END	;Finish up
  178: 	I $D(ZTQUEUED) S ZTREQ="@"
  179: 	E  X $G(^%ZIS("C"))
  180: 	K DIRUT,DUOUT,DTOUT
  181: 	Q