Annotation of freem_fileman/DDSPRNT1.m, revision 1.1
1.1 ! snw 1: DDSPRNT1 ;SFISC/MKO-PRINT A FORM ;11:49 AM 17 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: PAGE ;Print page properties
! 6: I $Y+7'<IOSL!(DDSPBRK&'$D(DDSPFRST)) D HEADER^DDSPRNT Q:$D(DIRUT)
! 7: I DDSPBRK!$D(DDSPFRST) D
! 8: . W !,"Page Page"
! 9: . W !,"Number Properties"
! 10: . W !,"------ ----------"
! 11: K DDSPFRST
! 12: ;
! 13: S DDSCOL1=0,DDSCOL2=8,DDSCOL3=32
! 14: F X=0,1 S DDSPG(X)=$G(^DIST(.403,+DDSFORM,40,DDSPG,X))
! 15: Q:DDSPG(0)=""
! 16: ;
! 17: D W() Q:$D(DIRUT)
! 18: W ?DDSCOL1,$P(DDSPG(0),U),?DDSCOL2,$P(DDSPG(1),U)
! 19: ;
! 20: D W() Q:$D(DIRUT)
! 21: D WP^DDSPRNT($NA(^DIST(.403,+DDSFORM,40,DDSPG,15)),DDSCOL2+1)
! 22: Q:$D(DIRUT)
! 23: ;
! 24: S X=$P(DDSPG(0),U,2)
! 25: I X]"" D Q:$D(DIRUT)
! 26: . D WR("HEADER BLOCK:",$P($G(^DIST(.404,X,0)),U)_" (#"_X_")")
! 27: . S DDSHBK(X)=""
! 28: ;
! 29: D WR("PAGE COORDINATE:",$P(DDSPG(0),U,3)) Q:$D(DIRUT)
! 30: I $P(DDSPG(0),U,6) D WR("IS THIS A POP UP PAGE?:","YES") Q:$D(DIRUT)
! 31: D WR("LOWER RIGHT COORDINATE:",$P(DDSPG(0),U,7)) Q:$D(DIRUT)
! 32: ;
! 33: D WR("NEXT PAGE:",$P(DDSPG(0),U,4)) Q:$D(DIRUT)
! 34: D WR("PREVIOUS PAGE:",$P(DDSPG(0),U,5)) Q:$D(DIRUT)
! 35: D WR("PARENT FIELD:",$P(DDSPG(1),U,2)) Q:$D(DIRUT)
! 36: ;
! 37: D WR("PRE ACTION:",$G(^DIST(.403,+DDSFORM,40,DDSPG,11))) Q:$D(DIRUT)
! 38: D WR("POST ACTION:",$G(^DIST(.403,+DDSFORM,40,DDSPG,12))) Q:$D(DIRUT)
! 39: K DDSPG(0),DDSPG(1)
! 40: ;
! 41: ;Loop through all blocks
! 42: I $X D W() Q:$D(DIRUT)
! 43: Q:'$O(^DIST(.403,+DDSFORM,40,DDSPG,40,0))
! 44: ;
! 45: I $Y+7'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
! 46: W !?DDSCOL2,"Block Block"
! 47: W !?DDSCOL2,"Order Properties (Form File)"
! 48: W !?DDSCOL2,"----- ----------------------"
! 49: ;
! 50: N DDSBKO
! 51: S DDSBKO=""
! 52: F S DDSBKO=$O(^DIST(.403,+DDSFORM,40,DDSPG,40,"AC",DDSBKO)) Q:DDSBKO=""!$D(DIRUT) S DDSBK=0 F S DDSBK=$O(^DIST(.403,+DDSFORM,40,DDSPG,40,"AC",DDSBKO,DDSBK)) Q:'DDSBK!$D(DIRUT) D BLOCK
! 53: Q
! 54: ;
! 55: BLOCK ;Print Block properties
! 56: S DDSCOL1=8,DDSCOL2=15,DDSCOL3=39
! 57: F X=0,1,2 S DDSBK(X)=$G(^DIST(.403,+DDSFORM,40,DDSPG,40,DDSBK,X))
! 58: Q:DDSBK(0)=""
! 59: ;
! 60: D W($P(DDSBK(0),U,2),DDSCOL1) Q:$D(DIRUT)
! 61: W ?DDSCOL2,$P($G(^DIST(.404,DDSBK,0)),U)_" (#"_DDSBK_")"
! 62: D W() Q:$D(DIRUT)
! 63: ;
! 64: D WR("TYPE OF BLOCK:",$$EXTERNAL^DILFD(.4032,3,"",$P(DDSBK(0),U,4))) Q:$D(DIRUT)
! 65: D WR("BLOCK COORDINATE:",$P(DDSBK(0),U,3)) Q:$D(DIRUT)
! 66: D WR("POINTER LINK:",$P(DDSBK(1),U)) Q:$D(DIRUT)
! 67: D WR("REPLICATION:",$P(DDSBK(2),U)) Q:$D(DIRUT)
! 68: D WR("INDEX:",$P(DDSBK(2),U,2)) Q:$D(DIRUT)
! 69: D WR("INITIAL POSITION:",$P(DDSBK(2),U,3)) Q:$D(DIRUT)
! 70: D WR("DISALLOW LAYGO",$P(DDSBK(2),U,4)) Q:$D(DIRUT)
! 71: D WR("FIELD FOR SELECTION:",$P(DDSBK(2),U,5)) Q:$D(DIRUT)
! 72: ;
! 73: D WR("PRE ACTION:",$G(^DIST(.403,+DDSFORM,40,DDSPG,40,DDSBK,11))) Q:$D(DIRUT)
! 74: D WR("POST ACTION:",$G(^DIST(.403,+DDSFORM,40,DDSPG,40,DDSBK,12))) Q:$D(DIRUT)
! 75: ;
! 76: K DDSBK(1),DDSBK(2)
! 77: S DDSBK(0)=$G(^DIST(.404,DDSBK,0)) Q:DDSBK(0)=""
! 78: ;
! 79: I $Y+6'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
! 80: W !!?DDSCOL2,"Block Properties (Block File)"
! 81: W !,?DDSCOL2,"-----------------------------"
! 82: D BLOCK^DDSPRNT2
! 83: Q
! 84: ;
! 85: HBLKS ;Header blocks
! 86: Q:'$D(DDSHBK)
! 87: I $Y+7'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
! 88: W !!,"Header Block Properties"
! 89: W !,"------------------------"
! 90: S DDSCOL1=8,DDSCOL2=15,DDSCOL3=39
! 91: S DDSBK="" F S DDSBK=$O(DDSHBK(DDSBK)) Q:'DDSBK!$D(DIRUT) D
! 92: . S DDSBK(0)=$G(^DIST(.404,DDSBK,0)) Q:DDSBK(0)=""
! 93: . D W("NAME: "_$P(DDSBK(0),U)_" (#"_DDSBK_")") Q:$D(DIRUT)
! 94: . D W() Q:$D(DIRUT)
! 95: . D BLOCK^DDSPRNT2
! 96: . D W() Q:$D(DIRUT)
! 97: Q
! 98: ;
! 99: WR(DDSLAB,DDSVAL,DDSFLG) ;Write label and value
! 100: I DDSVAL="",'$G(DDSFLG) Q
! 101: ;
! 102: D W() Q:$D(DIRUT)
! 103: W ?DDSCOL2,DDSLAB
! 104: ;
! 105: I $X>DDSCOL3 N DDSCOL3 S DDSCOL3=$X+1
! 106: D PCOL(DDSVAL,DDSCOL3)
! 107: Q
! 108: ;
! 109: PCOL(DDSVAL,DDSCOL) ;Print DDSVAL starting in column DDSCOL
! 110: N DDSWIDTH,DDSIND
! 111: S DDSWIDTH=IOM-DDSCOL-1
! 112: F DDSIND=1:DDSWIDTH:$L(DDSVAL) D Q:$D(DIRUT)
! 113: . I DDSIND>1 D W() Q:$D(DIRUT)
! 114: . W ?DDSCOL,$E(DDSVAL,DDSIND,DDSIND+DDSWIDTH-1)
! 115: Q
! 116: ;
! 117: W(DDSSTR,DDSCOL) ;Write DDSSTR preceded by !?DDSCOL
! 118: I $Y+3'<IOSL D HEADER^DDSPRNT Q:$D(DIRUT)
! 119: W !?+$G(DDSCOL),$G(DDSSTR)
! 120: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSPRNT1.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman