- 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
