APCLLTZ ; IHS/CMI/LAB - DEVICE CALLS AND QUEUING ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;;ROUTINE USED AS CENTRAL POINT FOR ALL DEVICE HANDLING AND QUEUING
ZIS ;EP;TO CALL DEVICE
I $G(APCLBROW) D Q
.S DIR(0)="SO^P:PRINT Output;B:BROWSE Output on Screen"
.S DIR("A")="Do you want to "
.S DIR("B")="PRINT"
.W !
.D DIR^APCLLTD
.Q:$D(APCLLTQT)!$D(APCLLTOT)
.I $E($G(X))="P" D ZIS1 Q
.I $E($G(Y))="B" D BROWSE Q
ZIS1 ;EP;
K DN
S %ZIS="AEMNPQ"
S ZIBH=$TR($H,",","")_$R(1000)
W !
D ^%ZIS
I POP>0 D CLOSE Q
S:$G(IOPAR)]"" %ZIS("IOPAR")=IOPAR
S ZTSAVE("%ZIS*")=""
S ZTSAVE("ZIBH")=""
S ZTRTN="OPEN^APCLLTZ"
I $D(IO("Q")),IO=IO(0)!$D(IO("S")) D G ZIS
.W *7,*7
.W !!,"CANNOT QUEUE TO HOME OR SLAVE DEVICE."
I '$D(IO("Q")) D D CLOSE Q
.I $E(IOST,1,2)="P-" D
..W !!,"...One moment please, while I complete your print request..."
..W !
.D:$D(APCLRTN) @ZTRTN
E D ZTLOAD
Q
CLOSE ;EP;TO CLOSE DEVICE
D ^%ZISC
K IOP,IOPAR,%ZIS,ZTSK,ZTQUEUED,ZTREQ
Q
ZTLOAD ;EP;TO CALL %ZTLOAD
K APCLLTDR
S ZTIO=ION
S ZTSAVE("ACM*")=""
D ^%ZTLOAD
W !!,$S($G(ZTSK)]"":"Request queued!",1:"Request cancelled.")
D CLOSE
H 2
Q
OPEN ;EP;TO OPEN DEVICE AND PRINT SELECTED REPORT
I '$D(ZTQUEUED)!(ION["HOST") S IOP=ION D ^%ZIS I POP S APCLLTQT="" Q
U IO
D @APCLRTN
S:$D(ZTQUEUED) ZTREQ="@"
D:'$D(ZTQUEUED) CLOSE
Q
HOST ;EP;TO OPEN HOST FILE
;%FN - FILE NAME REQUIRED
;APCLLTOP - 'R' FOR READ, 'W' FOR WRITE REQUIRED, 'M' FOR READ/WRITE
Q:'$D(%FN)!'$D(APCLLTOP)
S POP=1
F APCLI=51:1:54 Q:'POP D
.S (IOP,ION)=APCLI
.S %ZIS("IOPAR")="("""_%FN_""":"""_APCLLTOP_""")"
.D ^%ZIS
I POP D G HOST:$G(APCLLTX)<2 S APCLLTQT="" Q
.W !!,"Waiting for HOST FILE SERVER."
.S APCLLTX=$G(APCLLTX)+1
K IOP,POP
Q
BROWSE ;EP;TO BROWSE
Q:$G(APCLRTN)=""
S APCLFLD("BROWSE")=1
D VIEWR^XBLM(APCLRTN)
I $D(APCLLTQT) D Q
.K APCLLTQT
.W !!,"BROWSE function temporarily unavailable."
.D ZIS1
D CLEAR^VALM1
Q
APCLLTZ ; IHS/CMI/LAB - DEVICE CALLS AND QUEUING ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;;ROUTINE USED AS CENTRAL POINT FOR ALL DEVICE HANDLING AND QUEUING
ZIS ;EP;TO CALL DEVICE
+1 IF $GET(APCLBROW)
Begin DoDot:1
+2 SET DIR(0)="SO^P:PRINT Output;B:BROWSE Output on Screen"
+3 SET DIR("A")="Do you want to "
+4 SET DIR("B")="PRINT"
+5 WRITE !
+6 DO DIR^APCLLTD
+7 IF $DATA(APCLLTQT)!$DATA(APCLLTOT)
QUIT
+8 IF $EXTRACT($GET(X))="P"
DO ZIS1
QUIT
+9 IF $EXTRACT($GET(Y))="B"
DO BROWSE
QUIT
End DoDot:1
QUIT
ZIS1 ;EP;
+1 KILL DN
+2 SET %ZIS="AEMNPQ"
+3 SET ZIBH=$TRANSLATE($HOROLOG,",","")_$RANDOM(1000)
+4 WRITE !
+5 DO ^%ZIS
+6 IF POP>0
DO CLOSE
QUIT
+7 IF $GET(IOPAR)]""
SET %ZIS("IOPAR")=IOPAR
+8 SET ZTSAVE("%ZIS*")=""
+9 SET ZTSAVE("ZIBH")=""
+10 SET ZTRTN="OPEN^APCLLTZ"
+11 IF $DATA(IO("Q"))
IF IO=IO(0)!$DATA(IO("S"))
Begin DoDot:1
+12 WRITE *7,*7
+13 WRITE !!,"CANNOT QUEUE TO HOME OR SLAVE DEVICE."
End DoDot:1
GOTO ZIS
+14 IF '$DATA(IO("Q"))
Begin DoDot:1
+15 IF $EXTRACT(IOST,1,2)="P-"
Begin DoDot:2
+16 WRITE !!,"...One moment please, while I complete your print request..."
+17 WRITE !
End DoDot:2
+18 IF $DATA(APCLRTN)
DO @ZTRTN
End DoDot:1
DO CLOSE
QUIT
+19 IF '$TEST
DO ZTLOAD
+20 QUIT
CLOSE ;EP;TO CLOSE DEVICE
+1 DO ^%ZISC
+2 KILL IOP,IOPAR,%ZIS,ZTSK,ZTQUEUED,ZTREQ
+3 QUIT
ZTLOAD ;EP;TO CALL %ZTLOAD
+1 KILL APCLLTDR
+2 SET ZTIO=ION
+3 SET ZTSAVE("ACM*")=""
+4 DO ^%ZTLOAD
+5 WRITE !!,$SELECT($GET(ZTSK)]"":"Request queued!",1:"Request cancelled.")
+6 DO CLOSE
+7 HANG 2
+8 QUIT
OPEN ;EP;TO OPEN DEVICE AND PRINT SELECTED REPORT
+1 IF '$DATA(ZTQUEUED)!(ION["HOST")
SET IOP=ION
DO ^%ZIS
IF POP
SET APCLLTQT=""
QUIT
+2 USE IO
+3 DO @APCLRTN
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 IF '$DATA(ZTQUEUED)
DO CLOSE
+6 QUIT
HOST ;EP;TO OPEN HOST FILE
+1 ;%FN - FILE NAME REQUIRED
+2 ;APCLLTOP - 'R' FOR READ, 'W' FOR WRITE REQUIRED, 'M' FOR READ/WRITE
+3 IF '$DATA(%FN)!'$DATA(APCLLTOP)
QUIT
+4 SET POP=1
+5 FOR APCLI=51:1:54
IF 'POP
QUIT
Begin DoDot:1
+6 SET (IOP,ION)=APCLI
+7 SET %ZIS("IOPAR")="("""_%FN_""":"""_APCLLTOP_""")"
+8 DO ^%ZIS
End DoDot:1
+9 IF POP
Begin DoDot:1
+10 WRITE !!,"Waiting for HOST FILE SERVER."
+11 SET APCLLTX=$GET(APCLLTX)+1
End DoDot:1
IF $GET(APCLLTX)<2
GOTO HOST
SET APCLLTQT=""
QUIT
+12 KILL IOP,POP
+13 QUIT
BROWSE ;EP;TO BROWSE
+1 IF $GET(APCLRTN)=""
QUIT
+2 SET APCLFLD("BROWSE")=1
+3 DO VIEWR^XBLM(APCLRTN)
+4 IF $DATA(APCLLTQT)
Begin DoDot:1
+5 KILL APCLLTQT
+6 WRITE !!,"BROWSE function temporarily unavailable."
+7 DO ZIS1
End DoDot:1
QUIT
+8 DO CLEAR^VALM1
+9 QUIT
