- 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
