| 1 | DIO4 ;SFISC/GFT,XAK,TKW-FINISH OUTPUT, CLOSE DEVICE ;9:57 AM 30 Dec 2003
|
|---|
| 2 | ;;22.0;VA FileMan;**2,32,45,136**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | K DIXX,DIWT,DIW,DIP,DSC,DRK,DIO("SCR") D:'$D(DISYS) OS^DII
|
|---|
| 5 | G:$G(DIFIXPT)=1 K1
|
|---|
| 6 | I $G(DIBTPGM)]"" D
|
|---|
| 7 | .N % S %=+$P(DIBTPGM,"^DISZ",2) D:% ENRLS^DIOZ(%) K DIBTPGM Q
|
|---|
| 8 | I ($G(ZTSTOP)=1!($G(DIFMSTOP))!($G(DIERR)))&'$D(DIAR) K:$G(ZTQUEUED) DIERR,^TMP("DIERR",$J) D FF G STOP
|
|---|
| 9 | I $G(DISTP)'<1,$D(^UTILITY($J,"T")) S A=0 D ^DIO3
|
|---|
| 10 | I L!($D(DISTEMP)),DISEARCH,'DISUPNO D:'DJ&('DC)&($D(^UTILITY($J,2))) HDR W !!!?25,DJ," MATCH",$P("ES",U,DJ'=1)," FOUND." W:IOST?1"C".E $C(7)
|
|---|
| 11 | I DISEARCH,$G(DISV),$D(^DIBT(DISV)) D NOW^%DTC S ^DIBT(DISV,"QR")=%_U_+DJ
|
|---|
| 12 | I $G(DISTP)<1,'DIO,'DISUPNO,'DC D:$D(^UTILITY($J,2)) HDR W !!!!,?10,"*** NO RECORDS TO PRINT ***"
|
|---|
| 13 | I $D(DIAR) D UPDATE^DIARU
|
|---|
| 14 | I $D(CP) S X=-1,^DOSV(0,IO(0),"CP")=CP F S X=$O(CP(X)),Z=-1 Q:X="" F S Z=$O(CP(X,Z)) Q:Z="" S ^DOSV(0,IO(0),"CP",X,Z)=CP(X,Z) Q:X=Z
|
|---|
| 15 | I $D(DIOT),$D(Y),Y'=U S DY(1)="X DIOT S DN=0",DN=1 D ^DIO2
|
|---|
| 16 | D FF
|
|---|
| 17 | I $D(DCOPIES),$D(DOUT),$D(^DD("OS",DISYS,"SDPEND")) D SDP
|
|---|
| 18 | G:$G(DIOEND)="G M^DIAU" M^DIAU G:$G(DIOEND)="G L^DIDC" L^DIDC
|
|---|
| 19 | X:$D(DIOEND) DIOEND K DIOEND
|
|---|
| 20 | STOP I $G(ZTSTOP)=1,$G(DISTOP("C"))]"" X DISTOP("C")
|
|---|
| 21 | D CLOSE I DUZ(0)'="@" S X=0 X ^DD("FUNC",18,1)
|
|---|
| 22 | K ;S:$D(ZTSK) ZTREQ="@"
|
|---|
| 23 | I $D(ZTQUEUED) D
|
|---|
| 24 | . S ZTREQ="@"
|
|---|
| 25 | . I $G(DDXPTMDL),$D(DDXPXTNO) N DA,DIK S DIK="^DIPT(",DA=DDXPXTNO D ^DIK
|
|---|
| 26 | K1 K ^UTILITY($J),^(U,$J),^UTILITY("DIP2",$J),FLDS,DIOT,DQI,A,B,C,D,E,H,I,J,M,N,L,P,Q,S,V,W,X,Y,Z,DITTO,DIP,DIPA,BY
|
|---|
| 27 | K %,%H,%I,%A,%B,%DT,%Q,%X,%Y,%Z,FR,CP,DA,DD,DIO,DL,DM,DN,DI,DE,D9,D5,D4,D3,D2,D1,DCOPIES,DIFF,DIASKHD,DISTOP,DISTP,DILCT,DISV,DISX,DIAC,DIFILE
|
|---|
| 28 | K DIS,SF,DIPDT,DIPR,DICMX,DHT,DIWL,DIWR,DIPASS,DICSS
|
|---|
| 29 | K DIRUT,DIROUT,DUOUT,DTOUT,DIHELP,DIMSG,^TMP("DIHELP",$J),^TMP("DIMSG",$J)
|
|---|
| 30 | I '$G(DIQUIET) K ^TMP("DIERR",$J),DIERR
|
|---|
| 31 | K DIBT,DIBT1,DIBT2,DX,DY,DNP,DC,DXS,DINS,DIPT,IOP,DCC,DQ,DJ,DJK,DIOP,DIOSL,DLP,DILIOSL,DHIT,DIJ,DPR,DP,DISUPNO,DIPCRIT,DIBTOLD,DITYP,DISTXT,DISEARCH Q
|
|---|
| 32 | ;
|
|---|
| 33 | FF W:IOST?1"P".E&$Y&L @IOF
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | SDP Q:'DCOPIES W ! X ^DD("OS",DISYS,"SDPEND")
|
|---|
| 37 | S DIO=IO,DLP=IOPAR,IOP=DOUT,A=IO(0) D ^%ZIS S IO(0)=A Q:POP
|
|---|
| 38 | F A=1:1:DCOPIES W:IOST?1"P".E&$Y @IOF X ^DD("OS",DISYS,"SDP") U IO
|
|---|
| 39 | I IO'=IO(0) S X=IO X ^DD("FUNC",7,1) K IO(1,IO)
|
|---|
| 40 | S IO=DIO Q
|
|---|
| 41 | ;
|
|---|
| 42 | CLOSE ;
|
|---|
| 43 | S DIOP=IO
|
|---|
| 44 | ;VistA Close Logic 22*136
|
|---|
| 45 | I $G(^%ZIS("C"))="G ^%ZISC" X ^%ZIS("C") K DIOP Q
|
|---|
| 46 | ;Stand Alone Close Logic
|
|---|
| 47 | I $P(IO(0),DIOP)]"" S IOP="HOME" D ^%ZIS H:POP S X=DIOP X ^DD("FUNC",7,1) K IO(1,IO) U IO(0)
|
|---|
| 48 | K DIOP Q
|
|---|
| 49 | HDR N DN S DN=1 X ^UTILITY($J,1) Q
|
|---|
| 50 | N G N^DIO2
|
|---|
| 51 | T G T^DIO2
|
|---|
| 52 | CSTP G CSTP^DIO2
|
|---|
| 53 | DT G DT^DIO2 Q
|
|---|
| 54 | C G C^DIO2
|
|---|
| 55 | S G S^DIO2
|
|---|
| 56 | P G P^DIO2
|
|---|
| 57 | A G A^DIO2
|
|---|
| 58 | D G D^DIO2
|
|---|
| 59 | CP G CP^DIO2
|
|---|
| 60 | H G H^DIO2
|
|---|
| 61 | M G M^DIO2
|
|---|
