ACRFZIS.m

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