- 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
