ASURM16P ; IHS/ITSC/LMH - REPORT 16 STATION MONTHLY SUB-SUB-ACTIVITY ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;Y2K/OK AEF/2970311
;This routine produces report #16, Station Monthly Sub-Sub-Activity
;Report
;
EN ;EP -- MAIN ENTRY POINT (USER INTERACTIVE)
;
N ASUDT,ASUTYP
D ^XBKVAR,HOME^%ZIS
D SELXTRCT^ASUUTIL G QUIT:'$G(ASUDT)
W !,*7,"THIS REPORT REQUIRES 132 COLUMNS!"
S (ZTSAVE("ASUDT"),ZTSAVE("ASUTYP"))=""
D QUE^ASUUTIL("DQ^ASURM16P",.ZTSAVE,"SAMS RPT #16 - STATION MONTHLY SUB-SUB-ACTIVITY REPORT")
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 extract, M=monthly
;
N ASU,ASUD
D ^XBKVAR
D GET,PRT,QUIT
Q
;
GET ;EP -- GETS THE DATA
;
; Main loop through ASUTRN ISSUE, ASUTRN DIRECT ISSUE, and
; ASUTRN RECEIPTS files
;
; ASU("DT","BEG") = beginning date of fiscal year
; ASU("DT","END") = ending date of fiscal year
; ASU("DT","FY") = fiscal year
; ASU1 = extracted date in 'AX' crossreference
; ASU2 = internal file entry number
; ASUD("TRANS") = transaction type
; ASUD("STATUS") = transaction status
;
N ASU0,ASU1,ASU2
K ^XTMP("ASUR","R16")
D DT^ASUUTIL(.ASUDT,ASUTYP)
Q:'$D(ASUDT("DXTRACT"))
S (ASU("DT","BEG"),ASU("DT","END"))=$E(ASU("DT","FY"),1,3)
S ASU("DT","BEG")=ASU("DT","BEG")-1_"0999"
S ASU("DT","END")=ASU("DT","END")_"0999"
D TC16^ASUUTIL
S ASU1=ASU("DT","BEG")
F S ASU1=$O(^ASUH("AX",ASU1)) Q:'ASU1 Q:ASU1>ASU("DT","END") 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'=2&(ASU0'=3)&(ASU0'=7) Q
. . D DATA16^ASUUTIL(ASU2)
. . Q:'$D(ASU("TC",ASUD("TRANS")))
. . Q:ASUD("STATUS")=""
. . Q:"UX"'[ASUD("STATUS")
. . D SET
Q
SET ;----- SETS DATA INTO ^XTMP("ASUR","R16") GLOBAL
;
; Sorts and totals the transaction data and sets it into the
; ^XTMP("ASUR","R16") global
;
; ASU = array containing dates and transaction codes
; ASUD = array containing transaction date
; ASU0 = transaction type where:
; 2 = RECEIPTS
; 3 = ISSUES
; 7 = DIRECT ISSUES
; ASU1 = transaction date
; ASUPC = piece designation in ^TMP global where totals are
; stored, the piece corresponds to the column on the
; report
; ASUPCM = piece in ^TMP global to put monthly totals (1-7)
; ASUPCY = piece in ^TMP global to put yearly todays (8-14)
; ASUDT("DXTRACT") = array containing extract dates
; ASUD("VAL") = transaction amount
;
N ASUPC,ASUPCM,ASUPCY
S ASUPCY=ASU("TC",ASUD("TRANS"))+7
S ASUPCM=0 S:$D(ASUDT("DXTRACT",ASU1)) ASUPCM=ASU("TC",ASUD("TRANS"))
F ASUPC=ASUPCM,ASUPCY D
. S $P(^XTMP("ASUR","R16",2,ASUD("AREA"),ASUD("STA"),ASUD("ACC"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",2,ASUD("AREA"),ASUD("STA"),ASUD("ACC"),0)),U,ASUPC)+ASUD("VAL")
. S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),0)),U,ASUPC)+ASUD("VAL")
. S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),0)),U,ASUPC)+ASUD("VAL")
. S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),0)),U,ASUPC)+ASUD("VAL")
. S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),0)),U,ASUPC)+ASUD("VAL")
. S $P(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),ASUD("ACC"),0),U,ASUPC)=$P($G(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),ASUD("ACC"),0)),U,ASUPC)+ASUD("VAL")
Q
PRT ;----- PRINT THE DATA
;
; ASUL = loop counter array
; ASUPAGE = report page number
; ASUOUT = '^' to escape controller
; ASUDATA = temporary data storage
; ASUD("ACC") = general ledger account number
; ASUHDR = array containing report header segments
;
N ASUL,ASUPAGE,ASUOUT,ASUHDR
S ASUOUT=0
I '$D(^XTMP("ASUR","R16")) W !!,"NO DATA FOR REPORT 16" Q
;
S ASUHDR(1)="REPORT #16 STATION MONTHLY SUB-SUB-ACTIVITY REPORT"
S ASUHDR(2)="AREA "_ASUD("AREA")
S ASUHDR(3)="STAT "_ASUD("STA")
S ASUHDR(4)="SUB SUB A"
S ASUHDR(5)="STA SUB C"
S ASUHDR(6)="CDE ACT C"
;
D LOOPS
Q
LOOPS ;----- LOOPS THROUGH ^XTMP("ASUR","R16") GLOBAL AND PRINTS
; THE REPORT
;
1 ;----- LOOP THROUGH THE AREA SUBSCRIPT
;
S ASUL(1)="" F S ASUL(1)=$O(^XTMP("ASUR","R16",1,ASUL(1))) Q:ASUL(1)']"" D Q:ASUOUT
. Q:ASUL(1)=0
. I $G(ASUPAGE)>1 D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
. D 2 Q:ASUOUT
Q
2 ;----- LOOP THROUGH THE STATION SUBSCRIPT
;
N ASUDATA
S ASUL(2)="" F S ASUL(2)=$O(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2))) Q:ASUL(2)']"" D Q:ASUOUT
. Q:ASUL(2)=0
. I $G(ASUPAGE)>1 D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
. D 3 Q:ASUOUT
. D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
. S ASUD("ACC")="" F S ASUD("ACC")=$O(^XTMP("ASUR","R16",2,ASUL(1),ASUL(2),ASUD("ACC"))) Q:ASUD("ACC")']"" D Q:ASUOUT
. . I $Y>(IOSL-5) D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT) Q:ASUOUT
. . W !,"ALL ACCT ",$P(ASUD("ACC"),".",2)
. . S ASUDATA=^XTMP("ASUR","R16",2,ASUL(1),ASUL(2),ASUD("ACC"),0)
. . D WRITE16^ASUUTIL(ASUDATA)
. I $Y>(IOSL-5) D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT) Q:ASUOUT
. W !,"STA TOTAL"
. S ASUDATA=^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),0)
. D WRITE16^ASUUTIL(ASUDATA)
Q
3 ;----- LOOP THROUGH THE SUB-STATION SUBSCRIPT
;
S ASUL(3)="" F S ASUL(3)=$O(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3))) Q:ASUL(3)']"" D Q:ASUOUT
. Q:ASUL(3)=0
. D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
. D 4 Q:ASUOUT
Q
4 ;----- LOOP THROUGH THE SUB-SUB-ACTIVITY SUBSCRIPT
;
S ASUL(4)="" F S ASUL(4)=$O(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3),ASUL(4))) Q:ASUL(4)']"" D Q:ASUOUT
. Q:ASUL(4)=0
. D 5 Q:ASUOUT
Q
5 ;----- LOOP THROUGH THE GENERAL LEDGER ACCOUNT SUBSCRIPT
;
N ASUDATA
S ASUL(5)="" F S ASUL(5)=$O(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5))) Q:ASUL(5)']"" D Q:ASUOUT
. Q:ASUL(5)=0
. S ASUDATA=^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5),0)
. I $Y>(IOSL-5) D HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
. W !?1,$S(ASUL(3)="UNK":"",1:$P(ASUL(3)," ")),?6,$S(ASUL(4)="UNK":"",1:ASUL(4)),?10,$P(ASUL(5),".",2)
. D WRITE16^ASUUTIL(ASUDATA)
Q
QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
;
K ZTSAVE
K ^XTMP("ASUR","R16")
I $G(ASUK("PTRSEL"))]"" W @IOF Q
D ^%ZISC
Q
ASURM16P ; IHS/ITSC/LMH - REPORT 16 STATION MONTHLY SUB-SUB-ACTIVITY ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;Y2K/OK AEF/2970311
+3 ;This routine produces report #16, Station Monthly Sub-Sub-Activity
+4 ;Report
+5 ;
EN ;EP -- MAIN ENTRY POINT (USER INTERACTIVE)
+1 ;
+2 NEW ASUDT,ASUTYP
+3 DO ^XBKVAR
DO HOME^%ZIS
+4 DO SELXTRCT^ASUUTIL
IF '$GET(ASUDT)
GOTO QUIT
+5 WRITE !,*7,"THIS REPORT REQUIRES 132 COLUMNS!"
+6 SET (ZTSAVE("ASUDT"),ZTSAVE("ASUTYP"))=""
+7 DO QUE^ASUUTIL("DQ^ASURM16P",.ZTSAVE,"SAMS RPT #16 - STATION MONTHLY SUB-SUB-ACTIVITY REPORT")
+8 DO QUIT
+9 QUIT
EN1(ASUDT,ASUTYP) ;EP
+1 ;----- ENTRY POINT CALLED BY ^ASURMSTD (NON-USER INTERACTIVE)
+2 ;
+3 ;
DQ ;EP -- QUEUED JOB STARTS HERE
+1 ;
+2 ;
+3 ; ASUDT = report extract date or month
+4 ; ASUTYP = type of report, I=individual extract, M=monthly
+5 ;
+6 NEW ASU,ASUD
+7 DO ^XBKVAR
+8 DO GET
DO PRT
DO QUIT
+9 QUIT
+10 ;
GET ;EP -- GETS THE DATA
+1 ;
+2 ; Main loop through ASUTRN ISSUE, ASUTRN DIRECT ISSUE, and
+3 ; ASUTRN RECEIPTS files
+4 ;
+5 ; ASU("DT","BEG") = beginning date of fiscal year
+6 ; ASU("DT","END") = ending date of fiscal year
+7 ; ASU("DT","FY") = fiscal year
+8 ; ASU1 = extracted date in 'AX' crossreference
+9 ; ASU2 = internal file entry number
+10 ; ASUD("TRANS") = transaction type
+11 ; ASUD("STATUS") = transaction status
+12 ;
+13 NEW ASU0,ASU1,ASU2
+14 KILL ^XTMP("ASUR","R16")
+15 DO DT^ASUUTIL(.ASUDT,ASUTYP)
+16 IF '$DATA(ASUDT("DXTRACT"))
QUIT
+17 SET (ASU("DT","BEG"),ASU("DT","END"))=$EXTRACT(ASU("DT","FY"),1,3)
+18 SET ASU("DT","BEG")=ASU("DT","BEG")-1_"0999"
+19 SET ASU("DT","END")=ASU("DT","END")_"0999"
+20 DO TC16^ASUUTIL
+21 SET ASU1=ASU("DT","BEG")
+22 FOR
SET ASU1=$ORDER(^ASUH("AX",ASU1))
IF 'ASU1
QUIT
IF ASU1>ASU("DT","END")
QUIT
Begin DoDot:1
+23 SET ASU2=0
FOR
SET ASU2=$ORDER(^ASUH("AX",ASU1,ASU2))
IF 'ASU2
QUIT
Begin DoDot:2
+24 SET ASUD("TRANS")=$PIECE($GET(^ASUH(ASU2,1)),U)
SET ASU0=$EXTRACT(ASUD("TRANS"))
IF ASU0=0
SET ASU0=7
+25 IF ASU0'=2&(ASU0'=3)&(ASU0'=7)
QUIT
+26 DO DATA16^ASUUTIL(ASU2)
+27 IF '$DATA(ASU("TC",ASUD("TRANS")))
QUIT
+28 IF ASUD("STATUS")=""
QUIT
+29 IF "UX"'[ASUD("STATUS")
QUIT
+30 DO SET
End DoDot:2
End DoDot:1
+31 QUIT
SET ;----- SETS DATA INTO ^XTMP("ASUR","R16") GLOBAL
+1 ;
+2 ; Sorts and totals the transaction data and sets it into the
+3 ; ^XTMP("ASUR","R16") global
+4 ;
+5 ; ASU = array containing dates and transaction codes
+6 ; ASUD = array containing transaction date
+7 ; ASU0 = transaction type where:
+8 ; 2 = RECEIPTS
+9 ; 3 = ISSUES
+10 ; 7 = DIRECT ISSUES
+11 ; ASU1 = transaction date
+12 ; ASUPC = piece designation in ^TMP global where totals are
+13 ; stored, the piece corresponds to the column on the
+14 ; report
+15 ; ASUPCM = piece in ^TMP global to put monthly totals (1-7)
+16 ; ASUPCY = piece in ^TMP global to put yearly todays (8-14)
+17 ; ASUDT("DXTRACT") = array containing extract dates
+18 ; ASUD("VAL") = transaction amount
+19 ;
+20 NEW ASUPC,ASUPCM,ASUPCY
+21 SET ASUPCY=ASU("TC",ASUD("TRANS"))+7
+22 SET ASUPCM=0
IF $DATA(ASUDT("DXTRACT",ASU1))
SET ASUPCM=ASU("TC",ASUD("TRANS"))
+23 FOR ASUPC=ASUPCM,ASUPCY
Begin DoDot:1
+24 SET $PIECE(^XTMP("ASUR","R16",2,ASUD("AREA"),ASUD("STA"),ASUD("ACC"),0),U,ASUPC)=$PIECE($GET(^XTMP("ASUR","R16",2,ASUD("AREA"),ASUD("STA"),ASUD("ACC"),0)),U,ASUPC)+ASUD("VAL")
+25 SET $PIECE(^XTMP("ASUR","R16",1,ASUD("AREA"),0),U,ASUPC)=$PIECE($GET(^XTMP("ASUR","R16",1,ASUD("AREA"),0)),U,ASUPC)+ASUD("VAL")
+26 SET $PIECE(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),0),U,ASUPC)=$PIECE($GET(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),0)),U,ASUPC)+ASUD("VAL")
+27 SET $PIECE(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),0),U,ASUPC)=$PIECE($GET(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),0)),U,ASUPC)+ASUD("VAL")
+28 SET $PIECE(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),0),U,ASUPC)=$PIECE($GET(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),0)),U,ASUPC)+ASUD("VAL")
+29 SET $PIECE(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),ASUD("ACC"),0),U,ASUPC)=$PIECE($GET(^XTMP("ASUR","R16",1,ASUD("AREA"),ASUD("STA"),ASUD("SST"),ASUD("SSA"),ASUD("ACC"),0)),U,ASUPC)+ASUD("VAL")
End DoDot:1
+30 QUIT
PRT ;----- PRINT THE DATA
+1 ;
+2 ; ASUL = loop counter array
+3 ; ASUPAGE = report page number
+4 ; ASUOUT = '^' to escape controller
+5 ; ASUDATA = temporary data storage
+6 ; ASUD("ACC") = general ledger account number
+7 ; ASUHDR = array containing report header segments
+8 ;
+9 NEW ASUL,ASUPAGE,ASUOUT,ASUHDR
+10 SET ASUOUT=0
+11 IF '$DATA(^XTMP("ASUR","R16"))
WRITE !!,"NO DATA FOR REPORT 16"
QUIT
+12 ;
+13 SET ASUHDR(1)="REPORT #16 STATION MONTHLY SUB-SUB-ACTIVITY REPORT"
+14 SET ASUHDR(2)="AREA "_ASUD("AREA")
+15 SET ASUHDR(3)="STAT "_ASUD("STA")
+16 SET ASUHDR(4)="SUB SUB A"
+17 SET ASUHDR(5)="STA SUB C"
+18 SET ASUHDR(6)="CDE ACT C"
+19 ;
+20 DO LOOPS
+21 QUIT
LOOPS ;----- LOOPS THROUGH ^XTMP("ASUR","R16") 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","R16",1,ASUL(1)))
IF ASUL(1)']""
QUIT
Begin DoDot:1
+3 IF ASUL(1)=0
QUIT
+4 IF $GET(ASUPAGE)>1
DO HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
+5 DO 2
IF ASUOUT
QUIT
End DoDot:1
IF ASUOUT
QUIT
+6 QUIT
2 ;----- LOOP THROUGH THE STATION SUBSCRIPT
+1 ;
+2 NEW ASUDATA
+3 SET ASUL(2)=""
FOR
SET ASUL(2)=$ORDER(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2)))
IF ASUL(2)']""
QUIT
Begin DoDot:1
+4 IF ASUL(2)=0
QUIT
+5 IF $GET(ASUPAGE)>1
DO HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
+6 DO 3
IF ASUOUT
QUIT
+7 DO HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
+8 SET ASUD("ACC")=""
FOR
SET ASUD("ACC")=$ORDER(^XTMP("ASUR","R16",2,ASUL(1),ASUL(2),ASUD("ACC")))
IF ASUD("ACC")']""
QUIT
Begin DoDot:2
+9 IF $Y>(IOSL-5)
DO HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
IF ASUOUT
QUIT
+10 WRITE !,"ALL ACCT ",$PIECE(ASUD("ACC"),".",2)
+11 SET ASUDATA=^XTMP("ASUR","R16",2,ASUL(1),ASUL(2),ASUD("ACC"),0)
+12 DO WRITE16^ASUUTIL(ASUDATA)
End DoDot:2
IF ASUOUT
QUIT
+13 IF $Y>(IOSL-5)
DO HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
IF ASUOUT
QUIT
+14 WRITE !,"STA TOTAL"
+15 SET ASUDATA=^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),0)
+16 DO WRITE16^ASUUTIL(ASUDATA)
End DoDot:1
IF ASUOUT
QUIT
+17 QUIT
3 ;----- LOOP THROUGH THE SUB-STATION SUBSCRIPT
+1 ;
+2 SET ASUL(3)=""
FOR
SET ASUL(3)=$ORDER(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3)))
IF ASUL(3)']""
QUIT
Begin DoDot:1
+3 IF ASUL(3)=0
QUIT
+4 DO HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
+5 DO 4
IF ASUOUT
QUIT
End DoDot:1
IF ASUOUT
QUIT
+6 QUIT
4 ;----- LOOP THROUGH THE SUB-SUB-ACTIVITY SUBSCRIPT
+1 ;
+2 SET ASUL(4)=""
FOR
SET ASUL(4)=$ORDER(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3),ASUL(4)))
IF ASUL(4)']""
QUIT
Begin DoDot:1
+3 IF ASUL(4)=0
QUIT
+4 DO 5
IF ASUOUT
QUIT
End DoDot:1
IF ASUOUT
QUIT
+5 QUIT
5 ;----- LOOP THROUGH THE GENERAL LEDGER ACCOUNT SUBSCRIPT
+1 ;
+2 NEW ASUDATA
+3 SET ASUL(5)=""
FOR
SET ASUL(5)=$ORDER(^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5)))
IF ASUL(5)']""
QUIT
Begin DoDot:1
+4 IF ASUL(5)=0
QUIT
+5 SET ASUDATA=^XTMP("ASUR","R16",1,ASUL(1),ASUL(2),ASUL(3),ASUL(4),ASUL(5),0)
+6 IF $Y>(IOSL-5)
DO HDR16^ASUUTIL(ASUDT,ASUTYP,.ASUPAGE,.ASUHDR,.ASUOUT)
+7 WRITE !?1,$SELECT(ASUL(3)="UNK":"",1:$PIECE(ASUL(3)," ")),?6,$SELECT(ASUL(4)="UNK":"",1:ASUL(4)),?10,$PIECE(ASUL(5),".",2)
+8 DO WRITE16^ASUUTIL(ASUDATA)
End DoDot:1
IF ASUOUT
QUIT
+9 QUIT
QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICE, QUIT
+1 ;
+2 KILL ZTSAVE
+3 KILL ^XTMP("ASUR","R16")
+4 IF $GET(ASUK("PTRSEL"))]""
WRITE @IOF
QUIT
+5 DO ^%ZISC
+6 QUIT
