- BYIMXIS ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;
- ;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8**;JUL 11, 2017;Build 310
- ;;ROUTINE USED AS CENTRAL POINT FOR DEVICE HANDLING AND QUEUING
- ;-----
- ZIS ;EP;TO CALL DEVICE
- I $G(BYIMBRWS) D Q
- .N DIR
- .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
- .Q:$D(BYIMQUIT)!$D(BYIMOUT)
- .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 ZTSAVE("NM*")=""
- S ZTRTN="OPEN^BYIMXIS"
- 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(BYIMRTN) @ZTRTN
- .D CLOSE
- 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 BYIMDR
- S ZTIO=ION
- S ZTSAVE("BYIM*")=""
- 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 BYIMQUIT="" Q
- U IO
- D @BYIMRTN
- S:$D(ZTQUEUED) ZTREQ="@"
- D:'$D(ZTQUEUED) CLOSE
- Q
- ;-----
- HOST ;EP;TO OPEN HOST FILE
- ;%FN - FILE NAME REQUIRED
- ;BYIMOP - 'R' FOR READ, 'W' FOR WRITE REQUIRED, 'M' FOR READ/WRITE
- Q:'$D(%FN)!'$D(BYIMOP)
- S POP=1
- F BYIMI=51:1:54 Q:'POP D
- .S (IOP,ION)=BYIMI
- .S %ZIS("IOPAR")="("""_%FN_""":"""_BYIMOP_""")"
- .D ^%ZIS
- I POP D G HOST:$G(BYIMX)<2 S BYIMQUIT="" Q
- .W !!,"Waiting for HOST FILE SERVER."
- .S BYIMX=$G(BYIMX)+1
- K IOP,POP
- Q
- ;-----
- BROWSE ;EP;TO BROWSE
- Q:$G(BYIMRTN)=""
- S BYIMFLD("BROWSE")=1
- D VIEWR^XBLM(BYIMRTN)
- I $D(BYIMQUIT) D Q
- .K BYIMQUIT
- .W !!,"BROWSE function temporarily unavailable."
- .D ZIS1
- D CLEAR^VALM1
- Q
- ;-----
- BYIMXIS ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;
- +1 ;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8**;JUL 11, 2017;Build 310
- +2 ;;ROUTINE USED AS CENTRAL POINT FOR DEVICE HANDLING AND QUEUING
- +3 ;-----
- ZIS ;EP;TO CALL DEVICE
- +1 IF $GET(BYIMBRWS)
- Begin DoDot:1
- +2 NEW DIR
- +3 SET DIR(0)="SO^P:PRINT Output;B:BROWSE Output on Screen"
- +4 SET DIR("A")="Do you want to "
- +5 SET DIR("B")="PRINT"
- +6 WRITE !
- +7 DO ^DIR
- +8 IF $DATA(BYIMQUIT)!$DATA(BYIMOUT)
- QUIT
- +9 IF $EXTRACT($GET(X))="P"
- DO ZIS1
- QUIT
- +10 IF $EXTRACT($GET(Y))="B"
- DO BROWSE
- QUIT
- End DoDot:1
- QUIT
- +11 ;-----
- 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 ZTSAVE("NM*")=""
- +11 SET ZTRTN="OPEN^BYIMXIS"
- +12 IF $DATA(IO("Q"))
- IF IO=IO(0)!$DATA(IO("S"))
- Begin DoDot:1
- +13 WRITE *7,*7
- +14 WRITE !!,"CANNOT QUEUE TO HOME OR SLAVE DEVICE."
- End DoDot:1
- GOTO ZIS
- +15 IF '$DATA(IO("Q"))
- Begin DoDot:1
- +16 IF $EXTRACT(IOST,1,2)="P-"
- Begin DoDot:2
- +17 WRITE !!,"...One moment please, while I complete your print request..."
- +18 WRITE !
- End DoDot:2
- +19 IF $DATA(BYIMRTN)
- DO @ZTRTN
- +20 DO CLOSE
- End DoDot:1
- DO CLOSE
- QUIT
- +21 IF '$TEST
- DO ZTLOAD
- +22 QUIT
- +23 ;-----
- CLOSE ;EP;TO CLOSE DEVICE
- +1 DO ^%ZISC
- +2 KILL IOP,IOPAR,%ZIS,ZTSK,ZTQUEUED,ZTREQ
- +3 QUIT
- +4 ;-----
- ZTLOAD ;EP;TO CALL %ZTLOAD
- +1 KILL BYIMDR
- +2 SET ZTIO=ION
- +3 SET ZTSAVE("BYIM*")=""
- +4 DO ^%ZTLOAD
- +5 WRITE !!,$SELECT($GET(ZTSK)]"":"Request queued!",1:"Request cancelled.")
- +6 DO CLOSE
- +7 HANG 2
- +8 QUIT
- +9 ;-----
- OPEN ;EP;TO OPEN DEVICE AND PRINT SELECTED REPORT
- +1 IF '$DATA(ZTQUEUED)!(ION["HOST")
- SET IOP=ION
- DO ^%ZIS
- IF POP
- SET BYIMQUIT=""
- QUIT
- +2 USE IO
- +3 DO @BYIMRTN
- +4 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +5 IF '$DATA(ZTQUEUED)
- DO CLOSE
- +6 QUIT
- +7 ;-----
- HOST ;EP;TO OPEN HOST FILE
- +1 ;%FN - FILE NAME REQUIRED
- +2 ;BYIMOP - 'R' FOR READ, 'W' FOR WRITE REQUIRED, 'M' FOR READ/WRITE
- +3 IF '$DATA(%FN)!'$DATA(BYIMOP)
- QUIT
- +4 SET POP=1
- +5 FOR BYIMI=51:1:54
- IF 'POP
- QUIT
- Begin DoDot:1
- +6 SET (IOP,ION)=BYIMI
- +7 SET %ZIS("IOPAR")="("""_%FN_""":"""_BYIMOP_""")"
- +8 DO ^%ZIS
- End DoDot:1
- +9 IF POP
- Begin DoDot:1
- +10 WRITE !!,"Waiting for HOST FILE SERVER."
- +11 SET BYIMX=$GET(BYIMX)+1
- End DoDot:1
- IF $GET(BYIMX)<2
- GOTO HOST
- SET BYIMQUIT=""
- QUIT
- +12 KILL IOP,POP
- +13 QUIT
- +14 ;-----
- BROWSE ;EP;TO BROWSE
- +1 IF $GET(BYIMRTN)=""
- QUIT
- +2 SET BYIMFLD("BROWSE")=1
- +3 DO VIEWR^XBLM(BYIMRTN)
- +4 IF $DATA(BYIMQUIT)
- Begin DoDot:1
- +5 KILL BYIMQUIT
- +6 WRITE !!,"BROWSE function temporarily unavailable."
- +7 DO ZIS1
- End DoDot:1
- QUIT
- +8 DO CLEAR^VALM1
- +9 QUIT
- +10 ;-----
