ACRFZIS ;IHS/OIRM/DSD/THL,AEF - DEVICE CALLS AND QUEUING; [ 04/27/2007 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**13,21,22**;NOV 05, 2001
;;ROUTINE USED AS CENTRAL POINT FOR ALL DEVICE HANDLING
;;AND QUEUING FROM THE PRINT OPTION
;;SEE QUE^ACRFUTL FOR QUEUING FROM WITHIN ROUTINES
ZIS ;EP;TO CALL DEVICE
I '$D(ACRORIGF),$P(^ACRSYS(1,"DT"),U,29) D Q
.S DIR(0)="SO^P:PRINT Output;B:BROWSE Output on Screen"
.I $D(ACR("HFS")) S DIR(0)=DIR(0)_";H:HFS Output to file" ;ACR*2.1*21.04 IM22466
.S DIR("A")="Do you want to "
.S DIR("B")="PRINT"
.W !
.D DIR^ACRFDIC
.Q:$D(ACRQUIT)!$D(ACROUT)
.I $E($G(X))="P" D ZIS1 Q
.I $E($G(Y))="B" D BROWSE Q
.I $E($G(Y))="H" D PROCHFS Q ;ACR*2.1*21.04 IM22466
ZIS1 ;EP;
K DN
I $D(ACRORIGF) D P2
Q:$D(ACRQUIT)
I $D(ACRORIGF) D PRE Q:$D(ACROUT)
D FS
I $D(ACRCOND) D CONDENSE
S %ZIS=$S('$D(ACRORIGF):"NPQ",1:"NP")
S ZIBH=$TR($H,",","")_$R(1000)
W !
S:$D(ACRREV) IOP="HOME"
D ^%ZIS
I POP>0 D CLOSE Q
I $D(ACRORIGF),$D(IO("Q")) D K ACRQUIT G ZIS
.W !!,"You cannot QUEUE a request to print on a pre-printed form"
.D PAUSE^ACRFWARN
S:$G(IOPAR)]"" %ZIS("IOPAR")=IOPAR
S ZTSAVE("%ZIS*")=""
S ZTSAVE("ZIBH")=""
S ZTRTN="OPEN^ACRFZIS"
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(ACRORIGF),$E(IOST,1,2)="P-",'$D(ACRREV) D I $D(ACRQUIT)!$D(ACROUT) D CLOSE Q
.S DIR(0)="NO^1:99"
.S DIR("A")="Number of Copies"
.S DIR("B")=1
.D DIR^ACRFDIC
.I $D(ACRQUIT)!$D(ACROUT)!'+Y S ACRQUIT="" Q
.S ACRCOPY=+Y
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(ACRRTN) @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 ACRDR
S ZTIO=ION
S ZTSAVE("ACR*")=""
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 ACRQUIT="" Q
U IO
D @ACRRTN
S:$D(ZTQUEUED) ZTREQ="@"
D:'$D(ZTQUEUED) CLOSE
Q
HOST ;EP;TO OPEN HOST FILE
;%FN - FILE NAME REQUIRED
;ACROP - 'R' FOR READ, 'W' FOR WRITE REQUIRED, 'M' FOR READ/WRITE ;ACR*2.1*13.01 IM13574
;ACROP - 'R' FOR READ, 'W' FOR WRITE REQUIRED ;ACR*2.1*13.01 IM13574
Q:'$D(%FN)!'$D(ACROP)
S POP=1
F ACRI=1:1:4 Q:'POP D
.S (IOP,ION)="HOST FILE SERVER #"_ACRI
.S %ZIS("IOPAR")="("""_%FN_""":"""_ACROP_""")"
.D ^%ZIS
I POP D G HOST:$G(ACRX)<2 S ACRQUIT="" Q
.W !!,"Waiting for HOST FILE SERVER."
.S ACRX=$G(ACRX)+1
K IOP,POP
Q
FS ;EP;TO CHECK IF WIDE CARRIAGE/CONDENSED PRINTER NEEDED
I $G(ACRDOCDA),$D(^ACRDOC(ACRDOCDA,3)) N X S X=^(3) D
.I $P(X,U,13),'$P(X,U,17) D
..I $P($G(^ACRPO(+$P($G(^ACRDOC(ACRDOCDA,0)),U,8),"DT")),U,10) D I 1
...S X=$P(^ACRPO(+$P($G(^ACRDOC(ACRDOCDA,0)),U,8),"DT"),U,10)
...S (ION,%ZIS("B"))=$P(^%ZIS(1,X,0),U)
..E S ACRCOND=""
.S:$P(X,U,17)=1 ACR3542=""
Q
CONDENSE ;CONDENSE PRINTER REQUIRED
I $G(ACRPODA),$P($G(^ACRPO(ACRPODA,"DT")),U,10) D
.S X=$P(^ACRPO(ACRPODA,"DT"),U,10)
.I X,$D(^%ZIS(1,X,0)) S (ION,%ZIS("B"))=$P(^%ZIS(1,X,0),U) Q
W *7,*7
W !!,"The report you are about to print requires either a wide carriage printer or"
W !,"a printer set for condensed mode with a width of 132 characters."
W !,"Check with your system manager if you are uncertain which device to select."
K ACRCOND
Q
PRE ;PRE-PRINTED FORM REQUIRED
W !!,"Please insert Standard Form ",@ACRON,+$G(ACRPSC),@ACROF
I $D(ACRZIS(2))#2 W !,"and applicable CONTINUATION SHEETS"
W "into the printer now."
Q
P2 ;EP;TO SELECT SECOND PRINTER FOR SINGLE PRINT JOB
K ACRZIS
W !!,"NOTE: You may select a printer to use for any CONTINUATION SHEETS"
W !,"required to print this order.",!
N IO,IOP,IOST,IOP,ION
S %ZIS="NP"
S %ZIS("A")="Printer for CONTINUATION SHEETS: "
S %ZIS("B")=""
D ^%ZIS
I POP>0 D CLOSE S ACRQUIT="" Q
S:$E($G(IOST),1,2)="P-" ACRZIS(2)=ION
W !,"Now select the main printer to print the FIRST PAGE of this form."
Q
BROWSE ;EP;TO BROWSE
Q:$G(ACRRTN)=""
S ACRFLD("BROWSE")=1
D VIEWR^ACRFLM(ACRRTN)
I $D(ACRQUIT) D Q
.K ACRQUIT
.W !!,"BROWSE function temporarily unavailable."
.D ZIS1
D CLEAR^VALM1
KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF,VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW,VALMCOFF,ACRFLD,VALMHDR
Q
PROCHFS ;EP - PROCESS HFS FILE REQUEST
;ACR*2.1*21.04 IM22466
W !!,"This option will allow you to create a file in your home directory."
N OUT,X,Y
S OUT=0
D ^XBKVAR
D ASKDIR
Q:OUT
D FILE
Q:OUT
S:ZISH2'["." ZISH2=ZISH2_".csv" ;ACR*2.1*22.11d UFMS
S ZISH3="W"
D HFS^ACRFZISH(ZISH1,ZISH2,ZISH3,.%FILE)
Q:POP
S ACRHFS=""
Q
ASKDIR ;EP ASK FOR PATH
;ACR*2.1*21.04 IM22466
;S ZISH1=$$PWD^ACRFZISH("") ;ACR*2.1*22.11d UFMS
S ZISH1=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*22.11d UFMS
;W !!,"The file will go into your home directory"_" "_ZISH1 ;ACR*2.1*22.11d UFMS
W !!,"The file will go into the ARMS home directory"_" "_ZISH1 ;ACR*2.1*22.11d UFMS
W !,"If you need to send the file to a different directory,"
W !,"replace the default with the full path at the ""Replace"" prompt.",!
D SELDIR^ACRFZISH(.ZISH1,.OUT)
Q
FILE ;EP - SELECT FILENAME FOR UNIX FILE
;ACR*2.1*21.04 IM22466
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="FA"
S DIR("A")="Select UNIX file name: "
D ^DIR
I $D(DIRUT)!($D(DTOUT))!($D(DUOUT)) S OUT=1
I Y']"" S OUT=1
S ZISH2=Y
Q
ACRFZIS ;IHS/OIRM/DSD/THL,AEF - DEVICE CALLS AND QUEUING; [ 04/27/2007 4:18 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13,21,22**;NOV 05, 2001
+2 ;;ROUTINE USED AS CENTRAL POINT FOR ALL DEVICE HANDLING
+3 ;;AND QUEUING FROM THE PRINT OPTION
+4 ;;SEE QUE^ACRFUTL FOR QUEUING FROM WITHIN ROUTINES
ZIS ;EP;TO CALL DEVICE
+1 IF '$DATA(ACRORIGF)
IF $PIECE(^ACRSYS(1,"DT"),U,29)
Begin DoDot:1
+2 SET DIR(0)="SO^P:PRINT Output;B:BROWSE Output on Screen"
+3 ;ACR*2.1*21.04 IM22466
IF $DATA(ACR("HFS"))
SET DIR(0)=DIR(0)_";H:HFS Output to file"
+4 SET DIR("A")="Do you want to "
+5 SET DIR("B")="PRINT"
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+9 IF $EXTRACT($GET(X))="P"
DO ZIS1
QUIT
+10 IF $EXTRACT($GET(Y))="B"
DO BROWSE
QUIT
+11 ;ACR*2.1*21.04 IM22466
IF $EXTRACT($GET(Y))="H"
DO PROCHFS
QUIT
End DoDot:1
QUIT
ZIS1 ;EP;
+1 KILL DN
+2 IF $DATA(ACRORIGF)
DO P2
+3 IF $DATA(ACRQUIT)
QUIT
+4 IF $DATA(ACRORIGF)
DO PRE
IF $DATA(ACROUT)
QUIT
+5 DO FS
+6 IF $DATA(ACRCOND)
DO CONDENSE
+7 SET %ZIS=$SELECT('$DATA(ACRORIGF):"NPQ",1:"NP")
+8 SET ZIBH=$TRANSLATE($HOROLOG,",","")_$RANDOM(1000)
+9 WRITE !
+10 IF $DATA(ACRREV)
SET IOP="HOME"
+11 DO ^%ZIS
+12 IF POP>0
DO CLOSE
QUIT
+13 IF $DATA(ACRORIGF)
IF $DATA(IO("Q"))
Begin DoDot:1
+14 WRITE !!,"You cannot QUEUE a request to print on a pre-printed form"
+15 DO PAUSE^ACRFWARN
End DoDot:1
KILL ACRQUIT
GOTO ZIS
+16 IF $GET(IOPAR)]""
SET %ZIS("IOPAR")=IOPAR
+17 SET ZTSAVE("%ZIS*")=""
+18 SET ZTSAVE("ZIBH")=""
+19 SET ZTRTN="OPEN^ACRFZIS"
+20 IF $DATA(IO("Q"))
IF IO=IO(0)!$DATA(IO("S"))
Begin DoDot:1
+21 WRITE *7,*7
+22 WRITE !!,"CANNOT QUEUE TO HOME OR SLAVE DEVICE."
End DoDot:1
GOTO ZIS
+23 IF '$DATA(ACRORIGF)
IF $EXTRACT(IOST,1,2)="P-"
IF '$DATA(ACRREV)
Begin DoDot:1
+24 SET DIR(0)="NO^1:99"
+25 SET DIR("A")="Number of Copies"
+26 SET DIR("B")=1
+27 DO DIR^ACRFDIC
+28 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'+Y
SET ACRQUIT=""
QUIT
+29 SET ACRCOPY=+Y
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
DO CLOSE
QUIT
+30 IF '$DATA(IO("Q"))
Begin DoDot:1
+31 IF $EXTRACT(IOST,1,2)="P-"
Begin DoDot:2
+32 WRITE !!,"...One moment please, while I complete your print request..."
+33 WRITE !
End DoDot:2
+34 IF $DATA(ACRRTN)
DO @ZTRTN
End DoDot:1
DO CLOSE
QUIT
+35 IF '$TEST
DO ZTLOAD
+36 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 ACRDR
+2 SET ZTIO=ION
+3 SET ZTSAVE("ACR*")=""
+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 ACRQUIT=""
QUIT
+2 USE IO
+3 DO @ACRRTN
+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 ;ACROP - 'R' FOR READ, 'W' FOR WRITE REQUIRED, 'M' FOR READ/WRITE ;ACR*2.1*13.01 IM13574
+3 ;ACROP - 'R' FOR READ, 'W' FOR WRITE REQUIRED ;ACR*2.1*13.01 IM13574
+4 IF '$DATA(%FN)!'$DATA(ACROP)
QUIT
+5 SET POP=1
+6 FOR ACRI=1:1:4
IF 'POP
QUIT
Begin DoDot:1
+7 SET (IOP,ION)="HOST FILE SERVER #"_ACRI
+8 SET %ZIS("IOPAR")="("""_%FN_""":"""_ACROP_""")"
+9 DO ^%ZIS
End DoDot:1
+10 IF POP
Begin DoDot:1
+11 WRITE !!,"Waiting for HOST FILE SERVER."
+12 SET ACRX=$GET(ACRX)+1
End DoDot:1
IF $GET(ACRX)<2
GOTO HOST
SET ACRQUIT=""
QUIT
+13 KILL IOP,POP
+14 QUIT
FS ;EP;TO CHECK IF WIDE CARRIAGE/CONDENSED PRINTER NEEDED
+1 IF $GET(ACRDOCDA)
IF $DATA(^ACRDOC(ACRDOCDA,3))
NEW X
SET X=^(3)
Begin DoDot:1
+2 IF $PIECE(X,U,13)
IF '$PIECE(X,U,17)
Begin DoDot:2
+3 IF $PIECE($GET(^ACRPO(+$PIECE($GET(^ACRDOC(ACRDOCDA,0)),U,8),"DT")),U,10)
Begin DoDot:3
+4 SET X=$PIECE(^ACRPO(+$PIECE($GET(^ACRDOC(ACRDOCDA,0)),U,8),"DT"),U,10)
+5 SET (ION,%ZIS("B"))=$PIECE(^%ZIS(1,X,0),U)
End DoDot:3
IF 1
+6 IF '$TEST
SET ACRCOND=""
End DoDot:2
+7 IF $PIECE(X,U,17)=1
SET ACR3542=""
End DoDot:1
+8 QUIT
CONDENSE ;CONDENSE PRINTER REQUIRED
+1 IF $GET(ACRPODA)
IF $PIECE($GET(^ACRPO(ACRPODA,"DT")),U,10)
Begin DoDot:1
+2 SET X=$PIECE(^ACRPO(ACRPODA,"DT"),U,10)
+3 IF X
IF $DATA(^%ZIS(1,X,0))
SET (ION,%ZIS("B"))=$PIECE(^%ZIS(1,X,0),U)
QUIT
End DoDot:1
+4 WRITE *7,*7
+5 WRITE !!,"The report you are about to print requires either a wide carriage printer or"
+6 WRITE !,"a printer set for condensed mode with a width of 132 characters."
+7 WRITE !,"Check with your system manager if you are uncertain which device to select."
+8 KILL ACRCOND
+9 QUIT
PRE ;PRE-PRINTED FORM REQUIRED
+1 WRITE !!,"Please insert Standard Form ",@ACRON,+$GET(ACRPSC),@ACROF
+2 IF $DATA(ACRZIS(2))#2
WRITE !,"and applicable CONTINUATION SHEETS"
+3 WRITE "into the printer now."
+4 QUIT
P2 ;EP;TO SELECT SECOND PRINTER FOR SINGLE PRINT JOB
+1 KILL ACRZIS
+2 WRITE !!,"NOTE: You may select a printer to use for any CONTINUATION SHEETS"
+3 WRITE !,"required to print this order.",!
+4 NEW IO,IOP,IOST,IOP,ION
+5 SET %ZIS="NP"
+6 SET %ZIS("A")="Printer for CONTINUATION SHEETS: "
+7 SET %ZIS("B")=""
+8 DO ^%ZIS
+9 IF POP>0
DO CLOSE
SET ACRQUIT=""
QUIT
+10 IF $EXTRACT($GET(IOST),1,2)="P-"
SET ACRZIS(2)=ION
+11 WRITE !,"Now select the main printer to print the FIRST PAGE of this form."
+12 QUIT
BROWSE ;EP;TO BROWSE
+1 IF $GET(ACRRTN)=""
QUIT
+2 SET ACRFLD("BROWSE")=1
+3 DO VIEWR^ACRFLM(ACRRTN)
+4 IF $DATA(ACRQUIT)
Begin DoDot:1
+5 KILL ACRQUIT
+6 WRITE !!,"BROWSE function temporarily unavailable."
+7 DO ZIS1
End DoDot:1
QUIT
+8 DO CLEAR^VALM1
+9 KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF,VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW,VALMCOFF,ACRFLD,VALMHDR
+10 QUIT
PROCHFS ;EP - PROCESS HFS FILE REQUEST
+1 ;ACR*2.1*21.04 IM22466
+2 WRITE !!,"This option will allow you to create a file in your home directory."
+3 NEW OUT,X,Y
+4 SET OUT=0
+5 DO ^XBKVAR
+6 DO ASKDIR
+7 IF OUT
QUIT
+8 DO FILE
+9 IF OUT
QUIT
+10 ;ACR*2.1*22.11d UFMS
IF ZISH2'["."
SET ZISH2=ZISH2_".csv"
+11 SET ZISH3="W"
+12 DO HFS^ACRFZISH(ZISH1,ZISH2,ZISH3,.%FILE)
+13 IF POP
QUIT
+14 SET ACRHFS=""
+15 QUIT
ASKDIR ;EP ASK FOR PATH
+1 ;ACR*2.1*21.04 IM22466
+2 ;S ZISH1=$$PWD^ACRFZISH("") ;ACR*2.1*22.11d UFMS
+3 ;ACR*2.1*22.11d UFMS
SET ZISH1=$$ARMSDIR^ACRFSYS(1)
+4 ;W !!,"The file will go into your home directory"_" "_ZISH1 ;ACR*2.1*22.11d UFMS
+5 ;ACR*2.1*22.11d UFMS
WRITE !!,"The file will go into the ARMS home directory"_" "_ZISH1
+6 WRITE !,"If you need to send the file to a different directory,"
+7 WRITE !,"replace the default with the full path at the ""Replace"" prompt.",!
+8 DO SELDIR^ACRFZISH(.ZISH1,.OUT)
+9 QUIT
FILE ;EP - SELECT FILENAME FOR UNIX FILE
+1 ;ACR*2.1*21.04 IM22466
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="FA"
+4 SET DIR("A")="Select UNIX file name: "
+5 DO ^DIR
+6 IF $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))
SET OUT=1
+7 IF Y']""
SET OUT=1
+8 SET ZISH2=Y
+9 QUIT
