| [613] | 1 | DIP3 ;SFISC/GFT,TKW-PRINT HEADING, PAGE, COPIES ;06:51 PM 9 Dec 1999
|
|---|
| 2 | ;;22.0;VA FileMan;**23**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | I DJ,DE]"" S DJ=DJ+1,^UTILITY("DIP2",$J,DJ)=DE,DE=""
|
|---|
| 5 | H G G:((L?1"]".E)!($G(DDXP)=2)!($G(DDXP)=4)) I '$D(DIASKHD),'L G:$D(DALL)>9 G G PAGE
|
|---|
| 6 | D HD
|
|---|
| 7 | S DA=X D HQ^DIP31 G Q^DIP:$D(DTOUT)!($D(DUOUT)) K DIRUT,DIROUT
|
|---|
| 8 | S DHD=X G G:X=DA,G:$$DHD(.DHD,DK,L),H
|
|---|
| 9 | ;
|
|---|
| 10 | DHD(DHD,DK,L) ;VALIDATE HEADER 'DHD' FOR FILE 'DK'
|
|---|
| 11 | ; 'L'=0 MEANS SILENT
|
|---|
| 12 | ; CALLED BY SCREENMAN TEMPLATE EDIT
|
|---|
| 13 | N DC,X,Y,DIC,DD,%,DW
|
|---|
| 14 | I DHD?.P1"["1.E F DC=1,2 S X=$P($P(DHD,"[",DC+1),"]",1) D D^DIP21 S DIC(0)=$E("E",L)_"SF",DIC("S")="I '$D(^(""DCL"")) "_DIC("S") D IX^DIC K DIC G DHDBAD:Y<0&$L(X) I Y>0 S DHD=$P(DHD,"[",1,DC)_"["_$P(Y,U,2)_"]"_$P(DHD,"]",DC+1,9) W:L !
|
|---|
| 15 | I DHD'?1"W ".E Q DHD'[""""
|
|---|
| 16 | I DUZ(0)'="@" F %=1:2 Q:$P(DHD,"""",%,999)="" I $P($E(DHD,3,999),"""",%)[" " G DHDBAD
|
|---|
| 17 | Q 1
|
|---|
| 18 | DHDBAD Q 0
|
|---|
| 19 | ;
|
|---|
| 20 | G S DHD=$G(DHD) G PUT^DIP21:$S(L?1"]".E:1,$D(DALL)>9:1,$D(DALL):0,1:$L(DE)>13!DJ),PAGE
|
|---|
| 21 | X W $C(7),!,"TRY LATER" S X="^" G Q^DIP
|
|---|
| 22 | ;
|
|---|
| 23 | PAGE ;
|
|---|
| 24 | K DICOMPX,DA,IO("C") S DISUPNO=$G(DISUPNO),DIPCRIT=$G(DIPCRIT),DC=$S($G(DDXP)'=4:",",1:"") S:$D(DOUT)#2 DA=DOUT I 'L,$D(PG) S DC=C_(PG-1) K PG
|
|---|
| 25 | E I L,DHD'="@" F X=1:1:DPP I $D(DPP(X,"F")) R !,"START AT PAGE: 1// ",X:DTIME S:'$T X=U Q:X="" G DIP3^DIQQQ:X["?",X:X[U,DIP3:X\1'=X S DC=C_(X-1) Q
|
|---|
| 26 | I $G(DIFIXPT)=1 G F2
|
|---|
| 27 | I $D(%ZIS)[0,$D(^%ZTSK),$D(^%ZTSCH("RUN")),$D(^%ZOSF("UCI")),$D(^DD("OS",DISYS,8)) S %ZIS="QM",%ZIS("B")=""
|
|---|
| 28 | ZIS S:$D(IOP) DIOP=IOP D:$G(DDXP)=4 ZIS^DDXP4 D ^%ZIS S:$D(DIOP) IOP=DIOP K DIOP G X:POP
|
|---|
| 29 | I $G(DDXP)=4 S IOM=DDXPIOM,IOSL=$S(IOSL<DDXPIOSL:DDXPIOSL,1:IOSL),X=$S(IOM<255:IOM,1:0) X ^%ZOSF("RM")
|
|---|
| 30 | I $D(IOT),IOT="SDP",$D(^DD("OS",DISYS,"SDP")) G SDP
|
|---|
| 31 | G FREE
|
|---|
| 32 | ;
|
|---|
| 33 | SDP S O=IO,DIPION=ION
|
|---|
| 34 | I '$D(DCOPIES) R !,"NUMBER OF COPIES: ",F:DTIME G SDPCLO:F[U!'$T,SDP:F\1'=F S DCOPIES=F
|
|---|
| 35 | O K IOP,%ZIS S:$D(IO("Q")) %ZIS="NM",IOP="Q",%ZIS("B")="",DIOQ=1 W !,"OUTPUT COPIES TO"
|
|---|
| 36 | D ^%ZIS G SDPCLO:POP,O:IO=O
|
|---|
| 37 | S DOUT=$S($D(ION):ION_";"_IOM_";"_IOST,1:IO),DA=IO,IOP=DIPION_";"_IOM_";"_IOST S:$D(DIOQ) %ZIS="QN",IOP="Q;"_IOP K DIOQ D ^%ZIS
|
|---|
| 38 | FREE S %=2,F=IOST["K",W=IOST["SINGLE"
|
|---|
| 39 | I $D(DIPZ),'$D(IOP),IO(0)=$I,$D(^DIPT(DIPZ,"IOM")),^("IOM")>IOM W $C(7),?8,"MARGIN WIDTH IS NORMALLY AT LEAST "_^("IOM"),!?8,"ARE YOU SURE" D YN^DICN G X:%<0,ZIS:%-1
|
|---|
| 40 | I IO(0)'=IO,'$D(IO("Q")),'$D(IOP)!$D(IOFREE),'W!F,IO(0)=$I,$S($D(DA):DA'=$I,1:1),$S($D(%ZIS)[0:1,1:%ZIS'["F"),$P(^DD("OS",DISYS,0),U,5) S %=2 W !,"WANT TO FREE UP THIS TERMINAL" D YN^DICN G CLO:%<0,DIP3^DIQQ:'% I %=1
|
|---|
| 41 | I $T!$D(IO("C")) W !,"THIS TERMINAL IS NOW FREE",!!,"Exit",! S IO("C")=1,X=$I,DM="" X ^DD("FUNC",7,1) K IO(1,IO) S:$D(DIOEND)#2 DIOEND(9)=DIOEND,DM="X DIOEND(9) " S DIOEND=DM_$S($D(^%ZIS("C")):"G H^XUS",1:"H")
|
|---|
| 42 | F2 S X=$G(DHD) D HD:X="" S DHD=X,X=DC
|
|---|
| 43 | K DC,S,N,Q,H,DA,FR,TO,DM,J,T,V,CP,DIC,DIE,DRK,DINS,DALL S O=0,DK=DI,DC=X,C=","
|
|---|
| 44 | G ^DIP4:$D(IO("Q")) D CLEAN^DIEFU G ^DIP5
|
|---|
| 45 | ;
|
|---|
| 46 | SDPCLO S X=O G CLO1
|
|---|
| 47 | CLO S X=IO
|
|---|
| 48 | CLO1 X ^DD("FUNC",7,1) K:$D(IO)#2&(IO]"") IO(1,IO) G X
|
|---|
| 49 | ;
|
|---|
| 50 | HD S @("X=$P("_DI_"0),U)"),X=X_$S($D(DCL)>9:" STATISTICS",$D(DIAX):" EXTRACT SEARCH",$D(DIAR):" ARCHIVE SEARCH",$D(DIS)>9:" SEARCH",1:" LIST")
|
|---|
| 51 | I $D(DC(0)),$D(^DIPT(DC(0),"H")) S X=^("H")
|
|---|
| 52 | I $D(DIASKHD),$D(DHD)#2 S:DHD'["?" (DIASKHD,X)=DHD S:DIASKHD'="" (X,DHD)=DIASKHD
|
|---|
| 53 | Q
|
|---|
