ASURMDBH ; IHS/ITSC/LMH - MANAGEMENT SUPPLY DATABOOK REPORT H ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;Y2K/OK/AEF/2970429
;This routine produces the Management Supply Databook Report H
;Receiving Documents and Line Items Received
;
;
EN ;EP -- MAIN ENTRY POINT (USER INTERACTIVE)
;
N ASUDT,ASUTYP
D ^XBKVAR,HOME^%ZIS
D SELXTRCT^ASUUTIL G QUIT:'$D(ASUDT)
W !,*7,"THIS REPORT REQUIRES 132 COLUMNS!"
S ZTSAVE("ASUDT")="",ZTSAVE("ASUTYP")=""
D QUE^ASUUTIL("DQ^ASURMDBH",.ZTSAVE,"SAMS DATABOOK REPORT H")
D QUIT
Q
EN1(ASUDT,ASUTYP) ;EP
;----- ENTRY POINT CALLED BY ^ASURMSTD (NON-USER INTERACTIVE)
;
DQ ;EP -- QUEUED JOB STARTS HERE
;
; ASUDT = report extract date or month
; ASUTYP = type of report, I=individual, M=monthly
;
D ^XBKVAR
D:'$D(^XTMP("ASUR","RDBH")) GET
D PRT,QUIT
Q
GET ;EP ; GATHER DATA
;
; Builds ^XTMP("ASUR","RDBH") global to sort and total
; documents and line items
;
D SORT,COUNT
Q
SORT ;----- SORTS THE DATA
;
; Sets sorted data into ^XTMP("ASUR","RDBH","A") global
;
; ASU = array containing beginning, ending fiscal dates
; ASU0 = transaction type
; ASU1 = extracted date in 'AX' crossreference
; ASU2 = internal file entry number
; ASUD = array containing transaction data
; ASUPC = piece in ^TMP global to store the count in
;
N ASU,ASU0,ASU1,ASU2,ASUD,ASUPC
K ^XTMP("ASUR","RDBH")
D FPP^ASUUTIL1(ASUDT)
I ASUTYP="M" S ASUDT=$$LDOM^ASUUTIL1(ASUDT)
S ASU1=ASU("DT","BEG2")-1
F S ASU1=$O(^ASUH("AX",ASU1)) Q:'ASU1 Q:ASU1>ASUDT D
. S ASU2=0 F S ASU2=$O(^ASUH("AX",ASU1,ASU2)) Q:'ASU2 D
. . S ASUD("TRANS")=$P($G(^ASUH(ASU2,1)),U),ASU0=$E(ASUD("TRANS")) S:ASU0=0 ASU0=7
. . I ASU0'=3&(ASU0'=7) Q
. . D DATA16^ASUUTIL(ASU2)
. . S ASUPC=0
. . I ASU1'<ASU("DT","BEG")&(ASU1'>ASU("DT","END")) S ASUPC=2
. . I ASU1'<ASU("DT","BEG1")&(ASU1'>ASU("DT","END1")) S ASUPC=6
. . I ASU1'<ASU("DT","BEG2")&(ASU1'>ASU("DT","END2")) S ASUPC=10
. . I ASUPC,ASU0=7 S ASUPC=ASUPC+2
. . D SET1
Q
SET1 ;----- SORTS DATA IN ^TMP GLOBAL
;
S ^XTMP("ASUR","RDBH","A","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),ASUPC,ASU2,0)=""
S ^XTMP("ASUR","RDBH","A","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),ASUPC-1,ASUD("VOUCH"),0)=""
Q
COUNT ;----- COUNTS THE LINE ITEMS AND DOCUMENTS
;
; Sets counts into ^XTMP("ASUR","RDBH","B") global
;
N ASUL
S ASUL(1)="" F S ASUL(1)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1))) Q:ASUL(1)']"" D
. S ASUL(2)="" F S ASUL(2)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2))) Q:ASUL(2)']"" D
. . S ASUL(3)="" F S ASUL(3)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3))) Q:ASUL(3)']"" D
. . . S ASUL(4)="" F S ASUL(4)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3),ASUL(4))) Q:ASUL(4)']"" D
. . . . S ASUL(5)="" F S ASUL(5)=$O(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5))) Q:ASUL(5)']"" D
. . . . . D SET2
Q
SET2 ;----- SETS COUNTS IN ^TMP GLOBAL
;
S $P(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0),U,ASUL(4))=$P($G(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0)),U,ASUL(4))+1
S $P(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0),U,ASUL(4))=$P($G(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0)),U,ASUL(4))+1
Q
PRT ;----- PRINTS THE DATA
;
; ASUDATA = temporary data storage
; ASUL = array used for loop counters
; ASUOUT = '^' to escape controller
; ASUPAGE = report page number
;
N ASUL,ASUOUT,ASUPAGE
I '$D(^XTMP("ASUR","RDBH","B")) W !!,"NO DATA FOR DATABOOK REPORT H" Q
S ASUOUT=0
D LOOPS
Q
LOOPS ;----- LOOPS THROUGH THE ^XTMP("ASUR","RDBH","B") GLOBAL AND PRINTS
; THE REPORT
;
1 ;----- LOOP THROUGH THE AREA SUBSCRIPT
;
S ASUL(1)="" F S ASUL(1)=$O(^XTMP("ASUR","RDBH","B","IHS",ASUL(1))) Q:ASUL(1)']"" D 2 Q:ASUOUT
Q
2 ;----- LOOP THROUGH THE ACCOUNT SUBSCRIPT
;
N ASUDATA
S ASUL(2)="" F S ASUL(2)=$O(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2))) Q:ASUL(2)']"" D Q:ASUOUT
. D HDR(ASUL(1),ASUL(2)) Q:ASUOUT
. D 3 Q:ASUOUT
. I $Y>(IOSL-5) D HDR(ASUL(1),ASUL(2))
. Q:ASUOUT
. S ASUDATA=^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0)
. W !!,"TOTAL"
. D WRITE(ASUDATA)
Q
3 ;----- LOOP THROUGH THE STATION SUBSCRIPT
;
N ASUDATA
S ASUL(3)="" F S ASUL(3)=$O(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3))) Q:ASUL(3)']"" D Q:ASUOUT
. Q:ASUL(3)=0
. I $Y>(IOSL-5) D HDR(ASUL(1),ASUL(2))
. Q:ASUOUT
. S ASUDATA=^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0)
. W !!,ASUL(3)
. D WRITE(ASUDATA)
Q
WRITE(X) ;----- WRITES DATA
;
I $P(X,U)'="" W ?23,$J($P(X,U),5)
I $P(X,U,2)'="" W ?29,$J($P(X,U,2),5)
I +$P(X,U)'=0 W ?36,$J(($P(X,U,2)/$P(X,U)),4,1)
I $P(X,U,3)'="" W ?41,$J($P(X,U,3),5)
I $P(X,U,4)'="" W ?47,$J($P(X,U,4),5)
I +$P(X,U,3)'=0 W ?54,$J(($P(X,U,4)/$P(X,U,3)),4,1)
I $P(X,U,5)'="" W ?60,$J($P(X,U,5),5)
I $P(X,U,6)'="" W ?66,$J($P(X,U,6),5)
I +$P(X,U,5)'=0 W ?73,$J(($P(X,U,6)/$P(X,U,5)),4,1)
I $P(X,U,7)'="" W ?78,$J($P(X,U,7),5)
I $P(X,U,8)'="" W ?84,$J($P(X,U,8),5)
I +$P(X,U,7)'=0 W ?91,$J(($P(X,U,8)/$P(X,U,7)),4,1)
I $P(X,U,9)'="" W ?97,$J($P(X,U,9),5)
I $P(X,U,10)'="" W ?103,$J($P(X,U,10),5)
I +$P(X,U,9)'=0 W ?110,$J(($P(X,U,10)/$P(X,U,9)),4,1)
I $P(X,U,11)'="" W ?115,$J($P(X,U,11),5)
I $P(X,U,12)'="" W ?121,$J($P(X,U,12),5)
I +$P(X,U,11)'=0 W ?128,$J(($P(X,U,12)/$P(X,U,11)),4,1)
Q
HDR(X1,X2) ;
;----- WRITES HEADER
;
; X1 = area
; X2 = account
;
N %,DIR,X,Y
I $E(IOST)="C",$G(ASUPAGE) S DIR(0)="E" D ^DIR K DIR I 'Y S ASUOUT=1 Q
S ASUPAGE=$G(ASUPAGE)+1
W @IOF
W "MANAGEMENT SUPPLY DATA BOOK for "
S Y=ASUDT X ^DD("DD") W $P(Y," ")," ",$P(Y,",",2)
W ?116,"PAGE ",$J(ASUPAGE,6)
W !,"AREA ",X1
W !!,"H. RECEIVING DOCUMENTS and LINE ITEMS RECEIVED"
W !?3,"Category: ",X2
W !!,?31,"CURRENT FISCAL YEAR",?68,"PREVIOUS FISCAL YEAR",?104,"PREV-PREV FISCAL YEAR"
W !,?25,"Stores Stock",?43,"Direct Issue",?62,"Stores Stock",?80,"Direct Issue",?99,"Stores Stock",?117,"Direct Issue"
W !,"STATION",?23,"# DOC",?30,"# LI",?37,"AVG",?41,"# DOC",?48,"# LI",?55,"AVG",?60,"# DOC",?67,"# LI",?74,"AVG",?78,"# DOC",?85,"# LI",?92,"AVG",?97,"# DOC",?104,"# LI",?111,"AVG",?115,"# DOC",?122,"# LI",?129,"AVG"
Q
QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
;
K ZTSAVE
K ^XTMP("ASUR","RDBH")
I $G(ASUK("PTRSEL"))]"" W @IOF Q
D ^%ZISC
Q
ASURMDBH ; IHS/ITSC/LMH - MANAGEMENT SUPPLY DATABOOK REPORT H ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;Y2K/OK/AEF/2970429
+3 ;This routine produces the Management Supply Databook Report H
+4 ;Receiving Documents and Line Items Received
+5 ;
+6 ;
EN ;EP -- MAIN ENTRY POINT (USER INTERACTIVE)
+1 ;
+2 NEW ASUDT,ASUTYP
+3 DO ^XBKVAR
DO HOME^%ZIS
+4 DO SELXTRCT^ASUUTIL
IF '$DATA(ASUDT)
GOTO QUIT
+5 WRITE !,*7,"THIS REPORT REQUIRES 132 COLUMNS!"
+6 SET ZTSAVE("ASUDT")=""
SET ZTSAVE("ASUTYP")=""
+7 DO QUE^ASUUTIL("DQ^ASURMDBH",.ZTSAVE,"SAMS DATABOOK REPORT H")
+8 DO QUIT
+9 QUIT
EN1(ASUDT,ASUTYP) ;EP
+1 ;----- ENTRY POINT CALLED BY ^ASURMSTD (NON-USER INTERACTIVE)
+2 ;
DQ ;EP -- QUEUED JOB STARTS HERE
+1 ;
+2 ; ASUDT = report extract date or month
+3 ; ASUTYP = type of report, I=individual, M=monthly
+4 ;
+5 DO ^XBKVAR
+6 IF '$DATA(^XTMP("ASUR","RDBH"))
DO GET
+7 DO PRT
DO QUIT
+8 QUIT
GET ;EP ; GATHER DATA
+1 ;
+2 ; Builds ^XTMP("ASUR","RDBH") global to sort and total
+3 ; documents and line items
+4 ;
+5 DO SORT
DO COUNT
+6 QUIT
SORT ;----- SORTS THE DATA
+1 ;
+2 ; Sets sorted data into ^XTMP("ASUR","RDBH","A") global
+3 ;
+4 ; ASU = array containing beginning, ending fiscal dates
+5 ; ASU0 = transaction type
+6 ; ASU1 = extracted date in 'AX' crossreference
+7 ; ASU2 = internal file entry number
+8 ; ASUD = array containing transaction data
+9 ; ASUPC = piece in ^TMP global to store the count in
+10 ;
+11 NEW ASU,ASU0,ASU1,ASU2,ASUD,ASUPC
+12 KILL ^XTMP("ASUR","RDBH")
+13 DO FPP^ASUUTIL1(ASUDT)
+14 IF ASUTYP="M"
SET ASUDT=$$LDOM^ASUUTIL1(ASUDT)
+15 SET ASU1=ASU("DT","BEG2")-1
+16 FOR
SET ASU1=$ORDER(^ASUH("AX",ASU1))
IF 'ASU1
QUIT
IF ASU1>ASUDT
QUIT
Begin DoDot:1
+17 SET ASU2=0
FOR
SET ASU2=$ORDER(^ASUH("AX",ASU1,ASU2))
IF 'ASU2
QUIT
Begin DoDot:2
+18 SET ASUD("TRANS")=$PIECE($GET(^ASUH(ASU2,1)),U)
SET ASU0=$EXTRACT(ASUD("TRANS"))
IF ASU0=0
SET ASU0=7
+19 IF ASU0'=3&(ASU0'=7)
QUIT
+20 DO DATA16^ASUUTIL(ASU2)
+21 SET ASUPC=0
+22 IF ASU1'<ASU("DT","BEG")&(ASU1'>ASU("DT","END"))
SET ASUPC=2
+23 IF ASU1'<ASU("DT","BEG1")&(ASU1'>ASU("DT","END1"))
SET ASUPC=6
+24 IF ASU1'<ASU("DT","BEG2")&(ASU1'>ASU("DT","END2"))
SET ASUPC=10
+25 IF ASUPC
IF ASU0=7
SET ASUPC=ASUPC+2
+26 DO SET1
End DoDot:2
End DoDot:1
+27 QUIT
SET1 ;----- SORTS DATA IN ^TMP GLOBAL
+1 ;
+2 SET ^XTMP("ASUR","RDBH","A","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),ASUPC,ASU2,0)=""
+3 SET ^XTMP("ASUR","RDBH","A","IHS",ASUD("AREA"),ASUD("ACCNAM"),ASUD("STA"),ASUPC-1,ASUD("VOUCH"),0)=""
+4 QUIT
COUNT ;----- COUNTS THE LINE ITEMS AND DOCUMENTS
+1 ;
+2 ; Sets counts into ^XTMP("ASUR","RDBH","B") global
+3 ;
+4 NEW ASUL
+5 SET ASUL(1)=""
FOR
SET ASUL(1)=$ORDER(^XTMP("ASUR","RDBH","A","IHS",ASUL(1)))
IF ASUL(1)']""
QUIT
Begin DoDot:1
+6 SET ASUL(2)=""
FOR
SET ASUL(2)=$ORDER(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2)))
IF ASUL(2)']""
QUIT
Begin DoDot:2
+7 SET ASUL(3)=""
FOR
SET ASUL(3)=$ORDER(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3)))
IF ASUL(3)']""
QUIT
Begin DoDot:3
+8 SET ASUL(4)=""
FOR
SET ASUL(4)=$ORDER(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3),ASUL(4)))
IF ASUL(4)']""
QUIT
Begin DoDot:4
+9 SET ASUL(5)=""
FOR
SET ASUL(5)=$ORDER(^XTMP("ASUR","RDBH","A","IHS",ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5)))
IF ASUL(5)']""
QUIT
Begin DoDot:5
+10 DO SET2
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
SET2 ;----- SETS COUNTS IN ^TMP GLOBAL
+1 ;
+2 SET $PIECE(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0),U,ASUL(4))=$PIECE($GET(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0)),U,ASUL(4))+1
+3 SET $PIECE(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0),U,ASUL(4))=$PIECE($GET(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0)),U,ASUL(4))+1
+4 QUIT
PRT ;----- PRINTS THE DATA
+1 ;
+2 ; ASUDATA = temporary data storage
+3 ; ASUL = array used for loop counters
+4 ; ASUOUT = '^' to escape controller
+5 ; ASUPAGE = report page number
+6 ;
+7 NEW ASUL,ASUOUT,ASUPAGE
+8 IF '$DATA(^XTMP("ASUR","RDBH","B"))
WRITE !!,"NO DATA FOR DATABOOK REPORT H"
QUIT
+9 SET ASUOUT=0
+10 DO LOOPS
+11 QUIT
LOOPS ;----- LOOPS THROUGH THE ^XTMP("ASUR","RDBH","B") GLOBAL AND PRINTS
+1 ; THE REPORT
+2 ;
1 ;----- LOOP THROUGH THE AREA SUBSCRIPT
+1 ;
+2 SET ASUL(1)=""
FOR
SET ASUL(1)=$ORDER(^XTMP("ASUR","RDBH","B","IHS",ASUL(1)))
IF ASUL(1)']""
QUIT
DO 2
IF ASUOUT
QUIT
+3 QUIT
2 ;----- LOOP THROUGH THE ACCOUNT SUBSCRIPT
+1 ;
+2 NEW ASUDATA
+3 SET ASUL(2)=""
FOR
SET ASUL(2)=$ORDER(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2)))
IF ASUL(2)']""
QUIT
Begin DoDot:1
+4 DO HDR(ASUL(1),ASUL(2))
IF ASUOUT
QUIT
+5 DO 3
IF ASUOUT
QUIT
+6 IF $Y>(IOSL-5)
DO HDR(ASUL(1),ASUL(2))
+7 IF ASUOUT
QUIT
+8 SET ASUDATA=^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),0)
+9 WRITE !!,"TOTAL"
+10 DO WRITE(ASUDATA)
End DoDot:1
IF ASUOUT
QUIT
+11 QUIT
3 ;----- LOOP THROUGH THE STATION SUBSCRIPT
+1 ;
+2 NEW ASUDATA
+3 SET ASUL(3)=""
FOR
SET ASUL(3)=$ORDER(^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3)))
IF ASUL(3)']""
QUIT
Begin DoDot:1
+4 IF ASUL(3)=0
QUIT
+5 IF $Y>(IOSL-5)
DO HDR(ASUL(1),ASUL(2))
+6 IF ASUOUT
QUIT
+7 SET ASUDATA=^XTMP("ASUR","RDBH","B","IHS",ASUL(1),ASUL(2),ASUL(3),0)
+8 WRITE !!,ASUL(3)
+9 DO WRITE(ASUDATA)
End DoDot:1
IF ASUOUT
QUIT
+10 QUIT
WRITE(X) ;----- WRITES DATA
+1 ;
+2 IF $PIECE(X,U)'=""
WRITE ?23,$JUSTIFY($PIECE(X,U),5)
+3 IF $PIECE(X,U,2)'=""
WRITE ?29,$JUSTIFY($PIECE(X,U,2),5)
+4 IF +$PIECE(X,U)'=0
WRITE ?36,$JUSTIFY(($PIECE(X,U,2)/$PIECE(X,U)),4,1)
+5 IF $PIECE(X,U,3)'=""
WRITE ?41,$JUSTIFY($PIECE(X,U,3),5)
+6 IF $PIECE(X,U,4)'=""
WRITE ?47,$JUSTIFY($PIECE(X,U,4),5)
+7 IF +$PIECE(X,U,3)'=0
WRITE ?54,$JUSTIFY(($PIECE(X,U,4)/$PIECE(X,U,3)),4,1)
+8 IF $PIECE(X,U,5)'=""
WRITE ?60,$JUSTIFY($PIECE(X,U,5),5)
+9 IF $PIECE(X,U,6)'=""
WRITE ?66,$JUSTIFY($PIECE(X,U,6),5)
+10 IF +$PIECE(X,U,5)'=0
WRITE ?73,$JUSTIFY(($PIECE(X,U,6)/$PIECE(X,U,5)),4,1)
+11 IF $PIECE(X,U,7)'=""
WRITE ?78,$JUSTIFY($PIECE(X,U,7),5)
+12 IF $PIECE(X,U,8)'=""
WRITE ?84,$JUSTIFY($PIECE(X,U,8),5)
+13 IF +$PIECE(X,U,7)'=0
WRITE ?91,$JUSTIFY(($PIECE(X,U,8)/$PIECE(X,U,7)),4,1)
+14 IF $PIECE(X,U,9)'=""
WRITE ?97,$JUSTIFY($PIECE(X,U,9),5)
+15 IF $PIECE(X,U,10)'=""
WRITE ?103,$JUSTIFY($PIECE(X,U,10),5)
+16 IF +$PIECE(X,U,9)'=0
WRITE ?110,$JUSTIFY(($PIECE(X,U,10)/$PIECE(X,U,9)),4,1)
+17 IF $PIECE(X,U,11)'=""
WRITE ?115,$JUSTIFY($PIECE(X,U,11),5)
+18 IF $PIECE(X,U,12)'=""
WRITE ?121,$JUSTIFY($PIECE(X,U,12),5)
+19 IF +$PIECE(X,U,11)'=0
WRITE ?128,$JUSTIFY(($PIECE(X,U,12)/$PIECE(X,U,11)),4,1)
+20 QUIT
HDR(X1,X2) ;
+1 ;----- WRITES HEADER
+2 ;
+3 ; X1 = area
+4 ; X2 = account
+5 ;
+6 NEW %,DIR,X,Y
+7 IF $EXTRACT(IOST)="C"
IF $GET(ASUPAGE)
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET ASUOUT=1
QUIT
+8 SET ASUPAGE=$GET(ASUPAGE)+1
+9 WRITE @IOF
+10 WRITE "MANAGEMENT SUPPLY DATA BOOK for "
+11 SET Y=ASUDT
XECUTE ^DD("DD")
WRITE $PIECE(Y," ")," ",$PIECE(Y,",",2)
+12 WRITE ?116,"PAGE ",$JUSTIFY(ASUPAGE,6)
+13 WRITE !,"AREA ",X1
+14 WRITE !!,"H. RECEIVING DOCUMENTS and LINE ITEMS RECEIVED"
+15 WRITE !?3,"Category: ",X2
+16 WRITE !!,?31,"CURRENT FISCAL YEAR",?68,"PREVIOUS FISCAL YEAR",?104,"PREV-PREV FISCAL YEAR"
+17 WRITE !,?25,"Stores Stock",?43,"Direct Issue",?62,"Stores Stock",?80,"Direct Issue",?99,"Stores Stock",?117,"Direct Issue"
+18 WRITE !,"STATION",?23,"# DOC",?30,"# LI",?37,"AVG",?41,"# DOC",?48,"# LI",?55,"AVG",?60,"# DOC",?67,"# LI",?74,"AVG",?78,"# DOC",?85,"# LI",?92,"AVG",?97,"# DOC",?104,"# LI",?111,"AVG",?115,"# DOC",?122,"# LI",?129,"AVG"
+19 QUIT
QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
+1 ;
+2 KILL ZTSAVE
+3 KILL ^XTMP("ASUR","RDBH")
+4 IF $GET(ASUK("PTRSEL"))]""
WRITE @IOF
QUIT
+5 DO ^%ZISC
+6 QUIT
