BDMLLTZ ; IHS/CMI/LAB - DEVICE CALLS AND QUEUING ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**3**;JUN 14, 2007
;;ROUTINE USED AS CENTRAL POINT FOR ALL DEVICE HANDLING AND QUEUING
ZIS ;call to XBDBQUE
W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) D XIT Q
S BDMOPT=Y
I Y="B" D BROWSE,XIT Q
S XBRP="CPRINT^BDMLLT",XBRC="",XBRX="EXIT^BDMLLT",XBNS="BDM"
D ^XBDBQUE
D XIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""CPRINT^BDMLLT"")"
S XBRC="",XBRX="EXIT^BDMLLT",XBIOP=0 D ^XBDBQUE
Q
ZISX ;EP;TO CALL DEVICE
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^BDMLLTD
.Q:$D(BDMLLTQT)!$D(BDMLLTOT)
.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^BDMLLTZ"
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(BDMLRTN) @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 BDMLLTDR
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 BDMLLTQT="" Q
U IO
D @BDMLRTN
S:$D(ZTQUEUED) ZTREQ="@"
D:'$D(ZTQUEUED) CLOSE
Q
HOST ;EP;TO OPEN HOST FILE
;%FN - FILE NAME REQUIRED
;BDMLLTOP - 'R' FOR READ, 'W' FOR WRITE REQUIRED, 'M' FOR READ/WRITE
Q:'$D(%FN)!'$D(BDMLLTOP)
S POP=1
F BDMLI=51:1:54 Q:'POP D
.S (IOP,ION)=BDMLI
.S %ZIS("IOPAR")="("""_%FN_""":"""_BDMLLTOP_""")"
.D ^%ZIS
I POP D G HOST:$G(BDMLLTX)<2 S BDMLLTQT="" Q
.W !!,"Waiting for HOST FILE SERVER."
.S BDMLLTX=$G(BDMLLTX)+1
K IOP,POP
Q
BROWSE1 ;EP;TO BROWSE
Q:$G(BDMLRTN)=""
S BDMLFLD("BROWSE")=1
D VIEWR^XBLM(BDMLRTN)
I $D(BDMLLTQT) D Q
.K BDMLLTQT
.W !!,"BROWSE function temporarily unavailable."
.D ZIS1
D CLEAR^VALM1
Q
XIT ;
D EN^XBVK("BDML")
Q
BDMLLTZ ; IHS/CMI/LAB - DEVICE CALLS AND QUEUING ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3**;JUN 14, 2007
+2 ;;ROUTINE USED AS CENTRAL POINT FOR ALL DEVICE HANDLING AND QUEUING
ZIS ;call to XBDBQUE
+1 WRITE !
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO XIT
QUIT
+3 SET BDMOPT=Y
+4 IF Y="B"
DO BROWSE
DO XIT
QUIT
+5 SET XBRP="CPRINT^BDMLLT"
SET XBRC=""
SET XBRX="EXIT^BDMLLT"
SET XBNS="BDM"
+6 DO ^XBDBQUE
+7 DO XIT
+8 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""CPRINT^BDMLLT"")"
+2 SET XBRC=""
SET XBRX="EXIT^BDMLLT"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
ZISX ;EP;TO CALL DEVICE
+1 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^BDMLLTD
+7 IF $DATA(BDMLLTQT)!$DATA(BDMLLTOT)
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^BDMLLTZ"
+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(BDMLRTN)
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 BDMLLTDR
+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 BDMLLTQT=""
QUIT
+2 USE IO
+3 DO @BDMLRTN
+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 ;BDMLLTOP - 'R' FOR READ, 'W' FOR WRITE REQUIRED, 'M' FOR READ/WRITE
+3 IF '$DATA(%FN)!'$DATA(BDMLLTOP)
QUIT
+4 SET POP=1
+5 FOR BDMLI=51:1:54
IF 'POP
QUIT
Begin DoDot:1
+6 SET (IOP,ION)=BDMLI
+7 SET %ZIS("IOPAR")="("""_%FN_""":"""_BDMLLTOP_""")"
+8 DO ^%ZIS
End DoDot:1
+9 IF POP
Begin DoDot:1
+10 WRITE !!,"Waiting for HOST FILE SERVER."
+11 SET BDMLLTX=$GET(BDMLLTX)+1
End DoDot:1
IF $GET(BDMLLTX)<2
GOTO HOST
SET BDMLLTQT=""
QUIT
+12 KILL IOP,POP
+13 QUIT
BROWSE1 ;EP;TO BROWSE
+1 IF $GET(BDMLRTN)=""
QUIT
+2 SET BDMLFLD("BROWSE")=1
+3 DO VIEWR^XBLM(BDMLRTN)
+4 IF $DATA(BDMLLTQT)
Begin DoDot:1
+5 KILL BDMLLTQT
+6 WRITE !!,"BROWSE function temporarily unavailable."
+7 DO ZIS1
End DoDot:1
QUIT
+8 DO CLEAR^VALM1
+9 QUIT
XIT ;
+1 DO EN^XBVK("BDML")
+2 QUIT
