DIP3 ;SFISC/GFT,TKW-PRINT HEADING, PAGE, COPIES ;06:51 PM 9 Dec 1999 [ 04/02/2003 8:25 AM ]
;;22.0;VA FileMan;**1001**;APR 1, 2003
;;22.0;VA FileMan;**23**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
I DJ,DE]"" S DJ=DJ+1,^UTILITY("DIP2",$J,DJ)=DE,DE=""
H G G:((L?1"]".E)!($G(DDXP)=2)!($G(DDXP)=4)) I '$D(DIASKHD),'L G:$D(DALL)>9 G G PAGE
D HD
S DA=X D HQ^DIP31 G Q^DIP:$D(DTOUT)!($D(DUOUT)) K DIRUT,DIROUT
S DHD=X G G:X=DA,G:$$DHD(.DHD,DK,L),H
;
DHD(DHD,DK,L) ;VALIDATE HEADER 'DHD' FOR FILE 'DK'
; 'L'=0 MEANS SILENT
; CALLED BY SCREENMAN TEMPLATE EDIT
N DC,X,Y,DIC,DD,%,DW
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 !
I DHD'?1"W ".E Q DHD'[""""
I DUZ(0)'="@" F %=1:2 Q:$P(DHD,"""",%,999)="" I $P($E(DHD,3,999),"""",%)[" " G DHDBAD
Q 1
DHDBAD Q 0
;
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
X W $C(7),!,"TRY LATER" S X="^" G Q^DIP
;
PAGE ;
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
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
I $G(DIFIXPT)=1 G F2
I $D(%ZIS)[0,$D(^%ZTSK),$D(^%ZTSCH("RUN")),$D(^%ZOSF("UCI")),$D(^DD("OS",DISYS,8)) S %ZIS="QM",%ZIS("B")=""
ZIS S:$D(IOP) DIOP=IOP D:$G(DDXP)=4 ZIS^DDXP4 D ^%ZIS S:$D(DIOP) IOP=DIOP K DIOP G X:POP
I $G(DDXP)=4 S IOM=DDXPIOM,IOSL=$S(IOSL<DDXPIOSL:DDXPIOSL,1:IOSL),X=$S(IOM<255:IOM,1:0) X ^%ZOSF("RM")
I $D(IOT),IOT="SDP",$D(^DD("OS",DISYS,"SDP")) G SDP
G FREE
;
SDP S O=IO,DIPION=ION
I '$D(DCOPIES) R !,"NUMBER OF COPIES: ",F:DTIME G SDPCLO:F[U!'$T,SDP:F\1'=F S DCOPIES=F
O K IOP,%ZIS S:$D(IO("Q")) %ZIS="NM",IOP="Q",%ZIS("B")="",DIOQ=1 W !,"OUTPUT COPIES TO"
D ^%ZIS G SDPCLO:POP,O:IO=O
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
FREE S %=2,F=IOST["K",W=IOST["SINGLE"
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
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
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")
F2 S X=$G(DHD) D HD:X="" S DHD=X,X=DC
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=","
G ^DIP4:$D(IO("Q")) D CLEAN^DIEFU G ^DIP5
;
SDPCLO S X=O G CLO1
CLO S X=IO
CLO1 X ^DD("FUNC",7,1) K:$D(IO)#2&(IO]"") IO(1,IO) G X
;
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")
I $D(DC(0)),$D(^DIPT(DC(0),"H")) S X=^("H")
I $D(DIASKHD),$D(DHD)#2 S:DHD'["?" (DIASKHD,X)=DHD S:DIASKHD'="" (X,DHD)=DIASKHD
Q
DIP3 ;SFISC/GFT,TKW-PRINT HEADING, PAGE, COPIES ;06:51 PM 9 Dec 1999 [ 04/02/2003 8:25 AM ]
+1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
+2 ;;22.0;VA FileMan;**23**;Mar 30, 1999
+3 ;Per VHA Directive 10-93-142, this routine should not be modified.
+4 IF DJ
IF DE]""
SET DJ=DJ+1
SET ^UTILITY("DIP2",$JOB,DJ)=DE
SET DE=""
H IF ((L?1"]".E)!($GET(DDXP)=2)!($GET(DDXP)=4))
GOTO G
IF '$DATA(DIASKHD)
IF 'L
IF $DATA(DALL)>9
GOTO G
GOTO PAGE
+1 DO HD
+2 SET DA=X
DO HQ^DIP31
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q^DIP
KILL DIRUT,DIROUT
+3 SET DHD=X
IF X=DA
GOTO G
IF $$DHD(.DHD,DK,L)
GOTO G
GOTO H
+4 ;
DHD(DHD,DK,L) ;VALIDATE HEADER 'DHD' FOR FILE 'DK'
+1 ; 'L'=0 MEANS SILENT
+2 ; CALLED BY SCREENMAN TEMPLATE EDIT
+3 NEW DC,X,Y,DIC,DD,%,DW
+4 IF DHD?.P1"["1.E
FOR DC=1,2
SET X=$PIECE($PIECE(DHD,"[",DC+1),"]",1)
DO D^DIP21
SET DIC(0)=$EXTRACT("E",L)_"SF"
SET DIC("S")="I '$D(^(""DCL"")) "_DIC("S")
DO IX^DIC
KILL DIC
IF Y<0&$LENGTH(X)
GOTO DHDBAD
IF Y>0
SET DHD=$PIECE(DHD,"[",1,DC)_"["_$PIECE(Y,U,2)_"]"_$PIECE(DHD,"]",DC+1,9)
IF L
WRITE !
+5 IF DHD'?1"W ".E
QUIT DHD'[""""
+6 IF DUZ(0)'="@"
FOR %=1:2
IF $PIECE(DHD,"""",%,999)=""
QUIT
IF $PIECE($EXTRACT(DHD,3,999),"""",%)[" "
GOTO DHDBAD
+7 QUIT 1
DHDBAD QUIT 0
+1 ;
G SET DHD=$GET(DHD)
IF $SELECT(L?1"]".E:1,$DATA(DALL)>9:1,$DATA(DALL):0,1:$LENGTH(DE)>13!DJ)
GOTO PUT^DIP21
GOTO PAGE
X WRITE $CHAR(7),!,"TRY LATER"
SET X="^"
GOTO Q^DIP
+1 ;
PAGE ;
+1 KILL DICOMPX,DA,IO("C")
SET DISUPNO=$GET(DISUPNO)
SET DIPCRIT=$GET(DIPCRIT)
SET DC=$SELECT($GET(DDXP)'=4:",",1:"")
IF $DATA(DOUT)#2
SET DA=DOUT
IF 'L
IF $DATA(PG)
SET DC=C_(PG-1)
KILL PG
+2 IF '$TEST
IF L
IF DHD'="@"
FOR X=1:1:DPP
IF $DATA(DPP(X,"F"))
READ !,"START AT PAGE: 1// ",X:DTIME
IF '$TEST
SET X=U
IF X=""
QUIT
IF X["?"
GOTO DIP3^DIQQQ
IF X[U
GOTO X
IF X\1'=X
GOTO DIP3
SET DC=C_(X-1)
QUIT
+3 IF $GET(DIFIXPT)=1
GOTO F2
+4 IF $DATA(%ZIS)[0
IF $DATA(^%ZTSK)
IF $DATA(^%ZTSCH("RUN"))
IF $DATA(^%ZOSF("UCI"))
IF $DATA(^DD("OS",DISYS,8))
SET %ZIS="QM"
SET %ZIS("B")=""
ZIS IF $DATA(IOP)
SET DIOP=IOP
IF $GET(DDXP)=4
DO ZIS^DDXP4
DO ^%ZIS
IF $DATA(DIOP)
SET IOP=DIOP
KILL DIOP
IF POP
GOTO X
+1 IF $GET(DDXP)=4
SET IOM=DDXPIOM
SET IOSL=$SELECT(IOSL<DDXPIOSL:DDXPIOSL,1:IOSL)
SET X=$SELECT(IOM<255:IOM,1:0)
XECUTE ^%ZOSF("RM")
+2 IF $DATA(IOT)
IF IOT="SDP"
IF $DATA(^DD("OS",DISYS,"SDP"))
GOTO SDP
+3 GOTO FREE
+4 ;
SDP SET O=IO
SET DIPION=ION
+1 IF '$DATA(DCOPIES)
READ !,"NUMBER OF COPIES: ",F:DTIME
IF F[U!'$TEST
GOTO SDPCLO
IF F\1'=F
GOTO SDP
SET DCOPIES=F
O KILL IOP,%ZIS
IF $DATA(IO("Q"))
SET %ZIS="NM"
SET IOP="Q"
SET %ZIS("B")=""
SET DIOQ=1
WRITE !,"OUTPUT COPIES TO"
+1 DO ^%ZIS
IF POP
GOTO SDPCLO
IF IO=O
GOTO O
+2 SET DOUT=$SELECT($DATA(ION):ION_";"_IOM_";"_IOST,1:IO)
SET DA=IO
SET IOP=DIPION_";"_IOM_";"_IOST
IF $DATA(DIOQ)
SET %ZIS="QN"
SET IOP="Q;"_IOP
KILL DIOQ
DO ^%ZIS
FREE SET %=2
SET F=IOST["K"
SET W=IOST["SINGLE"
+1 IF $DATA(DIPZ)
IF '$DATA(IOP)
IF IO(0)=$IO
IF $DATA(^DIPT(DIPZ,"IOM"))
IF ^("IOM")>IOM
WRITE $CHAR(7),?8,"MARGIN WIDTH IS NORMALLY AT LEAST "_^("IOM"),!?8,"ARE YOU SURE"
DO YN^DICN
IF %<0
GOTO X
IF %-1
GOTO ZIS
+2 IF IO(0)'=IO
IF '$DATA(IO("Q"))
IF '$DATA(IOP)!$DATA(IOFREE)
IF 'W!F
IF IO(0)=$IO
IF $SELECT($DATA(DA):DA'=$IO,1:1)
IF $SELECT($DATA(%ZIS)[0:1,1:%ZIS'["F")
IF $PIECE(^DD("OS",DISYS,0),U,5)
SET %=2
WRITE !,"WANT TO FREE UP THIS TERMINAL"
DO YN^DICN
IF %<0
GOTO CLO
IF '%
GOTO DIP3^DIQQ
IF %=1
+3 IF $TEST!$DATA(IO("C"))
WRITE !,"THIS TERMINAL IS NOW FREE",!!,"Exit",!
SET IO("C")=1
SET X=$IO
SET DM=""
XECUTE ^DD("FUNC",7,1)
KILL IO(1,IO)
IF $DATA(DIOEND)#2
SET DIOEND(9)=DIOEND
SET DM="X DIOEND(9) "
SET DIOEND=DM_$SELECT($DATA(^%ZIS("C")):"G H^XUS",1:"H")
F2 SET X=$GET(DHD)
IF X=""
DO HD
SET DHD=X
SET X=DC
+1 KILL DC,S,N,Q,H,DA,FR,TO,DM,J,T,V,CP,DIC,DIE,DRK,DINS,DALL
SET O=0
SET DK=DI
SET DC=X
SET C=","
+2 IF $DATA(IO("Q"))
GOTO ^DIP4
DO CLEAN^DIEFU
GOTO ^DIP5
+3 ;
SDPCLO SET X=O
GOTO CLO1
CLO SET X=IO
CLO1 XECUTE ^DD("FUNC",7,1)
IF $DATA(IO)#2&(IO]"")
KILL IO(1,IO)
GOTO X
+1 ;
HD SET @("X=$P("_DI_"0),U)")
SET X=X_$SELECT($DATA(DCL)>9:" STATISTICS",$DATA(DIAX):" EXTRACT SEARCH",$DATA(DIAR):" ARCHIVE SEARCH",$DATA(DIS)>9:" SEARCH",1:" LIST")
+1 IF $DATA(DC(0))
IF $DATA(^DIPT(DC(0),"H"))
SET X=^("H")
+2 IF $DATA(DIASKHD)
IF $DATA(DHD)#2
IF DHD'["?"
SET (DIASKHD,X)=DHD
IF DIASKHD'=""
SET (X,DHD)=DIASKHD
+3 QUIT
