ASUUZIS ; IHS/ITSC/LMH -INTERFACE WITH %ZIS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This is a utility routine which provides a front end to ^%ZIS.
;It uses a local variable array to save information about the
;files opened by involking ^%ZIS. Entry points are provided for
;Opening (O), Closing (C), Selecting (S) and Using (U) devices as well
;as for Killing the array (K) and Double Queueing (Q).
D S0 Q:$G(POP)
S ASUK("PTRSEL")=""
Q
S ;EP; SELECT AND CHECK FOR BOTH QUEUED
D S0 Q:$G(POP)
I ASUK("PTR")="IRPT",ASUK("SRPT","Q")=1,'$D(IO("Q")) W !,"Standard Reports are Queued, Invoice reports must also be Queued" G S
S ASUK("PTRSEL")=1
Q
S0 ;
S:'$D(ASUK("PTR")) ASUK("PTR")="PRINTER"
I $D(%ZIS("A")) S %ZIS("B")=$S(%ZIS("A")["Stand":$G(ASUP("STD")),%ZIS("A")["Invo":$G(ASUP("IVD")),1:"") S ASUK(ASUK("PTR"),"IOP")=%ZIS("B")
S %ZIS=$G(%ZIS) ;S:%ZIS'["Q" %ZIS=%ZIS_"Q"
S ASUK(ASUK("PTR"),"ZIS")=%ZIS
I $G(ASUK(ASUK("PTR"),"IOP"))="HFS" D
.I $G(ASUG("MEDIUM"))']"" D
..N DIR
..W !!,"HFS file "_$S($G(ASUK(ASUK("PTR"),"IOPAR"))']"":"NOT DEFINED",1:$P($P(ASUK(ASUK("PTR"),"IOPAR"),"(",2),":"))_" is the default for the prompt",!,$G(%ZIS("A"))
..S DIR(0)="Y",DIR("B")="Y"
..S DIR("A")="Is that OK" D ^DIR
.E S Y=1
.I Y D ASUUZIS1
.E K %ZIS("B") D ^%ZIS
E D
.D ^%ZIS
I $G(POP) S ASURX="W !,""Unable to Select Device""" D ^ASUUPLOG Q
D V
I ASUK(ASUK("PTR"),"ZIS")'["O" D ^%ZISC
K ASUK(ASUK("PTR"),"ZIS")
Q
U ;EP; USE PRINTER DEVICE
I $D(ASUK("PTR")) D
.S IO(0)=$G(ASUK(ASUK("PTR"),0))
.S IO("S")=$G(ASUK(ASUK("PTR"),"S"))
.S IO=$G(ASUK(ASUK("PTR"),"IO"))
.S IOM=$G(ASUK(ASUK("PTR"),"IOM"))
.S IOF=$G(ASUK(ASUK("PTR"),"IOF"))
.S ION=$G(ASUK(ASUK("PTR"),"ION"))
.S IOST=$G(ASUK(ASUK("PTR"),"IOST"))
.S IOSL=$G(ASUK(ASUK("PTR"),"IOSL"))
.S IOPAR=$G(ASUK(ASUK("PTR"),"IOPAR"))
I IO']"" D HOME^%ZIS
U IO
Q
O ;EP; OPEN DEVICE ENTRY POINT.
U IO(0) S %ZIS("A")="Select Printer : ",%ZIS="OQM" ; JDH added M to ask for right margin
S:'$D(ASUK("PTR")) ASUK("PTR")="PRINTER"
I $D(ASUK(ASUK("PTR"),"IOP")) D
.S IOP=ASUK(ASUK("PTR"),"IOP")
.S:IOP["HFS" IOP=ASUK(ASUK("PTR"),"IO")
I $D(ASUK(ASUK("PTR"),"IOPAR")) D
.S %ZIS("IOPAR")=ASUK(ASUK("PTR"),"IOPAR")
.S IOPAR=%ZIS("IOPAR")
D ^%ZIS
I $G(POP) S ASURX="W !,""Unable to Select and Open Printer"",!" D ^ASUUPLOG Q
D V
S ASUK(ASUK("PTR"),"O")=1
I ASUK(ASUK("PTR"),"Q") D T Q
Q
C ;EP; CLOSE DEVICE ENTRY POINT.
I ASUK(ASUK("PTR"),0)=ASUK(ASUK("PTR"),"IO"),ASUK(ASUK("PTR"),"S")']"" W @IOF D K U IO(0) Q
I $D(ASUK("PTR-Q")),ASUK("PTR-Q") S IO=ASUK(ASUK("PTR"),"IO") D ^%ZISC D K U IO(0) Q
D U W @(ASUK(ASUK("PTR"),"IOF")) D ^%ZISC U IO(0) D K
Q
K ;
K ASUK("PTR-Q")
K2 ;
K ASUK(ASUK("PTR")),ASUK("PTRSEL")
K ASUK("PTR")
Q
Q ;EP; DOUBLE QUEUE
S XBFQ=1,XBION=ASUK(ASUK("PTR"),"ION"),IOP=ASUK(ASUK("PTR"),"IOP")
S XBNS="ASU" D ^XBDBQUE
Q
V ;
S:'$D(ASUK("PTR")) ASUK("PTR")="PRINTER"
S ASUK(ASUK("PTR"),0)=IO(0)
S ASUK(ASUK("PTR"),"S")=$G(IO("S"))
S ASUK(ASUK("PTR"),"IO")=IO
S ASUK(ASUK("PTR"),"IOM")=IOM
S ASUK(ASUK("PTR"),"IOF")=IOF
S ASUK(ASUK("PTR"),"ION")=ION
S ASUK(ASUK("PTR"),"IOST")=IOST
S ASUK(ASUK("PTR"),"IOSL")=IOSL
S ASUK(ASUK("PTR"),"IOPAR")=IOPAR
S ASUK(ASUK("PTR"),"IOP")=ION_";"_IOST_";"_$S($D(IOM):IOM,ASUK("PTR")="IRPT":80,1:132)_";"_$S($D(IOSL):IOSL,1:66)
S ASUK(ASUK("PTR"),"Q")=$S($D(IO("Q")):1,1:0)
S ASUK("PTR-Q")=$S($D(IO("Q")):1,1:0)
Q
T ;
S ZTSAVE("ZTDESC")=$G(ZTSAVE("ZTDESC"))
S ZTIO=ASUK(ASUK("PTR"),"IOP")
S ZTSAVE("ASU*")=""
D ^%ZTLOAD
K ASURZX
W !!,$S($D(ZTQUEUED):"Request Queued!",1:"Request Cancelled!")
D ^%ZISC
S DIR(0)="E" D ^DIR K DIR
Q
ASUUZIS1 ;HOST FILE SERVER OPEN
F X=0:0 S X=$O(^%ZIS(1,X)) Q:'X I ^%ZIS(1,X,"TYPE")="HFS" D Q:'$G(POP)
.S (ASUK(ASUK("PTR"),"IOP"),IOP)=$P(^%ZIS(1,X,0),U)
.S ASUK(ASUK("PTR"),"IO")=$P(^%ZIS(1,X,0),U,2)
.S:$G(ASUK(ASUK("PTR"),"IOPAR"))]"" %ZIS("IOPAR")=ASUK(ASUK("PTR"),"IOPAR")
.D ^%ZIS
Q
ASUUZIS ; IHS/ITSC/LMH -INTERFACE WITH %ZIS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This is a utility routine which provides a front end to ^%ZIS.
+3 ;It uses a local variable array to save information about the
+4 ;files opened by involking ^%ZIS. Entry points are provided for
+5 ;Opening (O), Closing (C), Selecting (S) and Using (U) devices as well
+6 ;as for Killing the array (K) and Double Queueing (Q).
+7 DO S0
IF $GET(POP)
QUIT
+8 SET ASUK("PTRSEL")=""
+9 QUIT
S ;EP; SELECT AND CHECK FOR BOTH QUEUED
+1 DO S0
IF $GET(POP)
QUIT
+2 IF ASUK("PTR")="IRPT"
IF ASUK("SRPT","Q")=1
IF '$DATA(IO("Q"))
WRITE !,"Standard Reports are Queued, Invoice reports must also be Queued"
GOTO S
+3 SET ASUK("PTRSEL")=1
+4 QUIT
S0 ;
+1 IF '$DATA(ASUK("PTR"))
SET ASUK("PTR")="PRINTER"
+2 IF $DATA(%ZIS("A"))
SET %ZIS("B")=$SELECT(%ZIS("A")["Stand":$GET(ASUP("STD")),%ZIS("A")["Invo":$GET(ASUP("IVD")),1:"")
SET ASUK(ASUK("PTR"),"IOP")=%ZIS("B")
+3 ;S:%ZIS'["Q" %ZIS=%ZIS_"Q"
SET %ZIS=$GET(%ZIS)
+4 SET ASUK(ASUK("PTR"),"ZIS")=%ZIS
+5 IF $GET(ASUK(ASUK("PTR"),"IOP"))="HFS"
Begin DoDot:1
+6 IF $GET(ASUG("MEDIUM"))']""
Begin DoDot:2
+7 NEW DIR
+8 WRITE !!,"HFS file "_$SELECT($GET(ASUK(ASUK("PTR"),"IOPAR"))']"":"NOT DEFINED",1:$PIECE($PIECE(ASUK(ASUK("PTR"),"IOPAR"),"(",2),":"))_" is the default for the prompt",!,$GET(%ZIS("A"))
+9 SET DIR(0)="Y"
SET DIR("B")="Y"
+10 SET DIR("A")="Is that OK"
DO ^DIR
End DoDot:2
+11 IF '$TEST
SET Y=1
+12 IF Y
DO ASUUZIS1
+13 IF '$TEST
KILL %ZIS("B")
DO ^%ZIS
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 DO ^%ZIS
End DoDot:1
+16 IF $GET(POP)
SET ASURX="W !,""Unable to Select Device"""
DO ^ASUUPLOG
QUIT
+17 DO V
+18 IF ASUK(ASUK("PTR"),"ZIS")'["O"
DO ^%ZISC
+19 KILL ASUK(ASUK("PTR"),"ZIS")
+20 QUIT
U ;EP; USE PRINTER DEVICE
+1 IF $DATA(ASUK("PTR"))
Begin DoDot:1
+2 SET IO(0)=$GET(ASUK(ASUK("PTR"),0))
+3 SET IO("S")=$GET(ASUK(ASUK("PTR"),"S"))
+4 SET IO=$GET(ASUK(ASUK("PTR"),"IO"))
+5 SET IOM=$GET(ASUK(ASUK("PTR"),"IOM"))
+6 SET IOF=$GET(ASUK(ASUK("PTR"),"IOF"))
+7 SET ION=$GET(ASUK(ASUK("PTR"),"ION"))
+8 SET IOST=$GET(ASUK(ASUK("PTR"),"IOST"))
+9 SET IOSL=$GET(ASUK(ASUK("PTR"),"IOSL"))
+10 SET IOPAR=$GET(ASUK(ASUK("PTR"),"IOPAR"))
End DoDot:1
+11 IF IO']""
DO HOME^%ZIS
+12 USE IO
+13 QUIT
O ;EP; OPEN DEVICE ENTRY POINT.
+1 ; JDH added M to ask for right margin
USE IO(0)
SET %ZIS("A")="Select Printer : "
SET %ZIS="OQM"
+2 IF '$DATA(ASUK("PTR"))
SET ASUK("PTR")="PRINTER"
+3 IF $DATA(ASUK(ASUK("PTR"),"IOP"))
Begin DoDot:1
+4 SET IOP=ASUK(ASUK("PTR"),"IOP")
+5 IF IOP["HFS"
SET IOP=ASUK(ASUK("PTR"),"IO")
End DoDot:1
+6 IF $DATA(ASUK(ASUK("PTR"),"IOPAR"))
Begin DoDot:1
+7 SET %ZIS("IOPAR")=ASUK(ASUK("PTR"),"IOPAR")
+8 SET IOPAR=%ZIS("IOPAR")
End DoDot:1
+9 DO ^%ZIS
+10 IF $GET(POP)
SET ASURX="W !,""Unable to Select and Open Printer"",!"
DO ^ASUUPLOG
QUIT
+11 DO V
+12 SET ASUK(ASUK("PTR"),"O")=1
+13 IF ASUK(ASUK("PTR"),"Q")
DO T
QUIT
+14 QUIT
C ;EP; CLOSE DEVICE ENTRY POINT.
+1 IF ASUK(ASUK("PTR"),0)=ASUK(ASUK("PTR"),"IO")
IF ASUK(ASUK("PTR"),"S")']""
WRITE @IOF
DO K
USE IO(0)
QUIT
+2 IF $DATA(ASUK("PTR-Q"))
IF ASUK("PTR-Q")
SET IO=ASUK(ASUK("PTR"),"IO")
DO ^%ZISC
DO K
USE IO(0)
QUIT
+3 DO U
WRITE @(ASUK(ASUK("PTR"),"IOF"))
DO ^%ZISC
USE IO(0)
DO K
+4 QUIT
K ;
+1 KILL ASUK("PTR-Q")
K2 ;
+1 KILL ASUK(ASUK("PTR")),ASUK("PTRSEL")
+2 KILL ASUK("PTR")
+3 QUIT
Q ;EP; DOUBLE QUEUE
+1 SET XBFQ=1
SET XBION=ASUK(ASUK("PTR"),"ION")
SET IOP=ASUK(ASUK("PTR"),"IOP")
+2 SET XBNS="ASU"
DO ^XBDBQUE
+3 QUIT
V ;
+1 IF '$DATA(ASUK("PTR"))
SET ASUK("PTR")="PRINTER"
+2 SET ASUK(ASUK("PTR"),0)=IO(0)
+3 SET ASUK(ASUK("PTR"),"S")=$GET(IO("S"))
+4 SET ASUK(ASUK("PTR"),"IO")=IO
+5 SET ASUK(ASUK("PTR"),"IOM")=IOM
+6 SET ASUK(ASUK("PTR"),"IOF")=IOF
+7 SET ASUK(ASUK("PTR"),"ION")=ION
+8 SET ASUK(ASUK("PTR"),"IOST")=IOST
+9 SET ASUK(ASUK("PTR"),"IOSL")=IOSL
+10 SET ASUK(ASUK("PTR"),"IOPAR")=IOPAR
+11 SET ASUK(ASUK("PTR"),"IOP")=ION_";"_IOST_";"_$SELECT($DATA(IOM):IOM,ASUK("PTR")="IRPT":80,1:132)_";"_$SELECT($DATA(IOSL):IOSL,1:66)
+12 SET ASUK(ASUK("PTR"),"Q")=$SELECT($DATA(IO("Q")):1,1:0)
+13 SET ASUK("PTR-Q")=$SELECT($DATA(IO("Q")):1,1:0)
+14 QUIT
T ;
+1 SET ZTSAVE("ZTDESC")=$GET(ZTSAVE("ZTDESC"))
+2 SET ZTIO=ASUK(ASUK("PTR"),"IOP")
+3 SET ZTSAVE("ASU*")=""
+4 DO ^%ZTLOAD
+5 KILL ASURZX
+6 WRITE !!,$SELECT($DATA(ZTQUEUED):"Request Queued!",1:"Request Cancelled!")
+7 DO ^%ZISC
+8 SET DIR(0)="E"
DO ^DIR
KILL DIR
+9 QUIT
ASUUZIS1 ;HOST FILE SERVER OPEN
+1 FOR X=0:0
SET X=$ORDER(^%ZIS(1,X))
IF 'X
QUIT
IF ^%ZIS(1,X,"TYPE")="HFS"
Begin DoDot:1
+2 SET (ASUK(ASUK("PTR"),"IOP"),IOP)=$PIECE(^%ZIS(1,X,0),U)
+3 SET ASUK(ASUK("PTR"),"IO")=$PIECE(^%ZIS(1,X,0),U,2)
+4 IF $GET(ASUK(ASUK("PTR"),"IOPAR"))]""
SET %ZIS("IOPAR")=ASUK(ASUK("PTR"),"IOPAR")
+5 DO ^%ZIS
End DoDot:1
IF '$GET(POP)
QUIT
+6 QUIT
