Annotation of freem_fileman/USER/DDSPRNT.m, revision 1.1
1.1 ! snw 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSPRNT.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman / USER