ASURM12P ; IHS/ITSC/LMH -RPT 12 LIST INACTIVE ITEMS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 12, List Inactive Items
;from sorted extracts.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 12
I '$D(IO) D HOME^%ZIS
I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
S ZTRTN="PSER^ASURD12P",ZTDESC="SAMS RPT 12" D O^ASUUZIS
I POP S IOP=$I D ^%ZIS Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
D:'$D(^XTMP("ASUR","R12")) SORT
Q:$O(^XTMP("ASUR","R12",0))="" ;WAR 10/1/99 no data for Dir Issue
D U^ASUUZIS
S (ASUC("PG"),ASUMS("E#","STA"))=0,ASUF("BK")=0
S ASUMS("E#","STA")=$O(^XTMP("ASUR","R12",0)) D ARE^ASULARST($E(ASUMS("E#","STA"),1,2)),STA^ASULARST(ASUMS("E#","STA"))
S ASURX("ACG")=$O(^XTMP("ASUR","R12",ASUMS("E#","STA"),0)) D ACGNM^ASULDIRF(ASURX("ACG"))
S ASUV("RPT")="R12",ASUQ("HDR")="HEADER^ASURM12P"
D ^ASUUDATA I ASUX("NDTA") G K
S (ASUC("PG"),ASUMS("E#","STA"))=0,ASUF("BK")=""
F S ASUMS("E#","STA")=$O(^XTMP("ASUR","R12",ASUMS("E#","STA"))) Q:ASUMS("E#","STA")']"" D Q:$D(DTOUT) Q:$D(DUOUT)
.D ARE^ASULARST($E(ASUMS("E#","STA"),1,2)),STA^ASULARST(ASUMS("E#","STA"))
.S ASURX("ACG")=0
.S:ASUF("BK")'="" ASUF("BK")=3
.F S ASURX("ACG")=$O(^XTMP("ASUR","R12",ASUMS("E#","STA"),ASURX("ACG"))) Q:ASURX("ACG")']"" D Q:$D(DTOUT) Q:$D(DUOUT)
..D ACGNM^ASULDIRF(ASURX("ACG")) S ASUV("ACGNM")=ASUL(9,"ACG","NM")
..S:ASUF("BK")=0 ASUF("BK")=2
..S ASUMS("E#","IDX")=0
..F S ASUMS("E#","IDX")=$O(^XTMP("ASUR","R12",ASUMS("E#","STA"),ASURX("ACG"),ASUMS("E#","IDX"))) Q:ASUMS("E#","IDX")']"" D Q:$D(DUOUT) Q:$D(DTOUT)
...S ASUV("LIMOS")=$FN(^XTMP("ASUR","R12",ASUMS("E#","STA"),ASURX("ACG"),ASUMS("E#","IDX"))/30,",",0)
...S ASUMX("E#","IDX")=ASUMS("E#","IDX")
...D READ^ASUMXDIO,^ASUMSTRD D:ASUF("BK") HEADER Q:$D(DUOUT) Q:$D(DTOUT)
...W !,ASUL(9,"ACG"),ASUMS("EOQ","TP"),ASUMS("SRC")
...W ?6,$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6),?15,ASUMX("DESC",1)
...D NSNFMT W ?50,ASUV("NSN"),?70,ASUMX("AR U/I"),?75,$E(ASUMS("LSTISS"),2,3),"-",$E(ASUMS("LSTISS"),4,5)
...W ?85,$J($FN(ASUMS("QTY","O/H"),","),5),?92,$J($FN(ASUMS("CST/U"),",",2),8)
...W ?103,$J($FN(ASUMS("VAL","O/H"),",",2),8),?113,$J($FN(ASUMS("D/I","QTY-TOT"),","),5),?119,$J(ASUV("LIMOS"),6),?126,$J(ASUMS("PMIQ"),6),!
...S ASUC("TOTLI")=$G(ASUC("TOTLI"))+1
...S ASUC("TOTVAL")=$G(ASUC("TOTVAL"))+ASUMS("VAL","O/H")
...W ?7,ASUMS("SLC"),?15,ASUMX("DESC",2),!
...S:ASUF("BK")="" ASUF("BK")=0
...S ASUC("LINE")=ASUC("LINE")+3 S:ASUC("LINE")>55 ASUF("BK")=1
D FOOTER
K ;
D PAZ^ASUURHDR I ASUK("PTRSEL")']"" D
.D C^ASUUZIS
K ASUMX,ASUMS,ASURX,ASUX,ASUC,ASUF("BK")
Q
NSNFMT ;
I ASUMS("ORD#")]"" D
.I $E(ASUMS("ORD#"))="M" S ASUV("NSN")=ASUMS("ORD#") Q
.I ASUMS("ORD#")]"" S ASUV("NSN")=ASUMS("ORD#")
.E S ASUV("NSN")=ASUMX("NSN")
.I $L(ASUV("NSN"))=4 Q
.S ASUV("NSN")=$E(ASUV("NSN"),1,4)_"-"_$E(ASUV("NSN"),5,$L(ASUV("NSN")))
.I $L(ASUV("NSN"))>7 S ASUV("NSN")=$E(ASUV("NSN"),1,7)_"-"_$E(ASUV("NSN"),8,$L(ASUV("NSN")))
.I $L(ASUV("NSN"))>11 S ASUV("NSN")=$E(ASUV("NSN"),1,11)_"-"_$E(ASUV("NSN"),12,$L(ASUV("NSN")))
E D
.S ASUV("NSN")=""
Q
I ASUF("BK")>1 D FOOTER
S ASUF("BK")=0
S ASUC("PG")=$G(ASUC("PG"))+1,ASUC("LINE")=5
I ASUC("PG")>1 D PAZ^ASUURHDR Q:$D(DUOUT) Q:$D(DTOUT)
W @(IOF),"REPORT #12 LISTING OF STOCK ITEMS WITH NO ISSUES IN THREE MONTHS",?90,ASUK("DT"),?110,"PAGE",?115,$J($FN(ASUC("PG"),","),7)
W !,"AREA",?6,ASUL(1,"AR","AP"),?9,ASUL(1,"AR","NM")
W !,"STAT",?6,ASUL(2,"STA","CD"),?9,ASUL(2,"STA","NM"),?50,"G L ACCOUNT 125.",ASUL(9,"ACG"),?68,ASUL(9,"ACG","NM"),!
W !,"A",?75,"LAST",?88,"QTY",?115,"QTY MONTHS"
W !,"CTS",?8,"INDEX",?74,"ISSUE",?89,"ON",?96,"UNIT",?105,"TOTAL",?115,"DUE",?123,"W/O"
W !,"CYC",?7,"NUMBER",?15,"DESCRIPTION",?50,"NSN/ORDER NUMBER",?70,"U/I",?75,"DATE",?87,"HAND",?96,"COST",?105,"VALUE",?116,"IN",?121,"ISSUE",?127,"PAMIQ",!
Q
W !?10,"TOTAL",?20,ASUV("ACGNM"),?40,"LINE ITEMS",?55,$J($FN($G(ASUC("TOTLI")),","),8),?92,"VALUE",?101,$J($FN($G(ASUC("TOTVAL")),",",2),10)
S (ASUC("TOTVAL"),ASUC("TOTLI"))=0
Q
SORT ;EP ;
K ^XTMP("ASUR","R12")
S ^XTMP("ASUR","R12",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
;S ASUMS("E#","STA")=0 ;WAR 5/20/99 replaced w/next line
S ASUMS("E#","STA")=ASUL(2,"STA","E#")-1 ;this station only
;F S ASUMS("E#","STA")=$O(^ASUMS(ASUMS("E#","STA"))) Q:ASUMS("E#","STA")'?1N.N D ;WAR 5/20/99 replaced w/next line
F S ASUMS("E#","STA")=$O(^ASUMS(ASUMS("E#","STA"))) Q:ASUMS("E#","STA")'=ASUL(2,"STA","E#") D ;this station only, NOT all stations
.F ASUMS("E#","IDX")=0:0 S ASUMS("E#","IDX")=$O(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"))) Q:ASUMS("E#","IDX")'?1N.N D
..S ASUMS("LSTISS")=$P(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0),U,13)
..S X1=ASUK("DT","FM"),X2=ASUMS("LSTISS") D ^%DTC
..Q:X<91
..S ASUV("LIDAYS")=X
..S ASUMX("ACC")=$P($G(^ASUMX(ASUMS("E#","IDX"),0)),U,6)
..Q:ASUMX("ACC")']""
..D ACC^ASULDIRF(ASUMX("ACC"))
..S ^XTMP("ASUR","R12",ASUMS("E#","STA"),ASUL(9,"ACG"),ASUMS("E#","IDX"))=ASUV("LIDAYS")
Q
ASURM12P ; IHS/ITSC/LMH -RPT 12 LIST INACTIVE ITEMS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 12, List Inactive Items
+3 ;from sorted extracts.
EN ;EP;PRIMARY ENTRY POINT FOR REPORT 12
+1 IF '$DATA(IO)
DO HOME^%ZIS
+2 IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
QUIT
+3 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+4 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
IF ASUK("PTRSEL")]""
GOTO PSER
+5 SET ZTRTN="PSER^ASURD12P"
SET ZTDESC="SAMS RPT 12"
DO O^ASUUZIS
+6 IF POP
SET IOP=$IO
DO ^%ZIS
QUIT
+7 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 IF '$DATA(^XTMP("ASUR","R12"))
DO SORT
+2 ;WAR 10/1/99 no data for Dir Issue
IF $ORDER(^XTMP("ASUR","R12",0))=""
QUIT
+3 DO U^ASUUZIS
+4 SET (ASUC("PG"),ASUMS("E#","STA"))=0
SET ASUF("BK")=0
+5 SET ASUMS("E#","STA")=$ORDER(^XTMP("ASUR","R12",0))
DO ARE^ASULARST($EXTRACT(ASUMS("E#","STA"),1,2))
DO STA^ASULARST(ASUMS("E#","STA"))
+6 SET ASURX("ACG")=$ORDER(^XTMP("ASUR","R12",ASUMS("E#","STA"),0))
DO ACGNM^ASULDIRF(ASURX("ACG"))
+7 SET ASUV("RPT")="R12"
SET ASUQ("HDR")="HEADER^ASURM12P"
+8 DO ^ASUUDATA
IF ASUX("NDTA")
GOTO K
+9 SET (ASUC("PG"),ASUMS("E#","STA"))=0
SET ASUF("BK")=""
+10 FOR
SET ASUMS("E#","STA")=$ORDER(^XTMP("ASUR","R12",ASUMS("E#","STA")))
IF ASUMS("E#","STA")']""
QUIT
Begin DoDot:1
+11 DO ARE^ASULARST($EXTRACT(ASUMS("E#","STA"),1,2))
DO STA^ASULARST(ASUMS("E#","STA"))
+12 SET ASURX("ACG")=0
+13 IF ASUF("BK")'=""
SET ASUF("BK")=3
+14 FOR
SET ASURX("ACG")=$ORDER(^XTMP("ASUR","R12",ASUMS("E#","STA"),ASURX("ACG")))
IF ASURX("ACG")']""
QUIT
Begin DoDot:2
+15 DO ACGNM^ASULDIRF(ASURX("ACG"))
SET ASUV("ACGNM")=ASUL(9,"ACG","NM")
+16 IF ASUF("BK")=0
SET ASUF("BK")=2
+17 SET ASUMS("E#","IDX")=0
+18 FOR
SET ASUMS("E#","IDX")=$ORDER(^XTMP("ASUR","R12",ASUMS("E#","STA"),ASURX("ACG"),ASUMS("E#","IDX")))
IF ASUMS("E#","IDX")']""
QUIT
Begin DoDot:3
+19 SET ASUV("LIMOS")=$FNUMBER(^XTMP("ASUR","R12",ASUMS("E#","STA"),ASURX("ACG"),ASUMS("E#","IDX"))/30,",",0)
+20 SET ASUMX("E#","IDX")=ASUMS("E#","IDX")
+21 DO READ^ASUMXDIO
DO ^ASUMSTRD
IF ASUF("BK")
DO HEADER
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+22 WRITE !,ASUL(9,"ACG"),ASUMS("EOQ","TP"),ASUMS("SRC")
+23 WRITE ?6,$EXTRACT(ASUMX("IDX"),1,5),".",$EXTRACT(ASUMX("IDX"),6),?15,ASUMX("DESC",1)
+24 DO NSNFMT
WRITE ?50,ASUV("NSN"),?70,ASUMX("AR U/I"),?75,$EXTRACT(ASUMS("LSTISS"),2,3),"-",$EXTRACT(ASUMS("LSTISS"),4,5)
+25 WRITE ?85,$JUSTIFY($FNUMBER(ASUMS("QTY","O/H"),","),5),?92,$JUSTIFY($FNUMBER(ASUMS("CST/U"),",",2),8)
+26 WRITE ?103,$JUSTIFY($FNUMBER(ASUMS("VAL","O/H"),",",2),8),?113,$JUSTIFY($FNUMBER(ASUMS("D/I","QTY-TOT"),","),5),?119,$JUSTIFY(ASUV("LIMOS"),6),?126,$JUSTIFY(ASUMS("PMIQ"),6),!
+27 SET ASUC("TOTLI")=$GET(ASUC("TOTLI"))+1
+28 SET ASUC("TOTVAL")=$GET(ASUC("TOTVAL"))+ASUMS("VAL","O/H")
+29 WRITE ?7,ASUMS("SLC"),?15,ASUMX("DESC",2),!
+30 IF ASUF("BK")=""
SET ASUF("BK")=0
+31 SET ASUC("LINE")=ASUC("LINE")+3
IF ASUC("LINE")>55
SET ASUF("BK")=1
End DoDot:3
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
End DoDot:2
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
End DoDot:1
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+32 DO FOOTER
K ;
+1 DO PAZ^ASUURHDR
IF ASUK("PTRSEL")']""
Begin DoDot:1
+2 DO C^ASUUZIS
End DoDot:1
+3 KILL ASUMX,ASUMS,ASURX,ASUX,ASUC,ASUF("BK")
+4 QUIT
NSNFMT ;
+1 IF ASUMS("ORD#")]""
Begin DoDot:1
+2 IF $EXTRACT(ASUMS("ORD#"))="M"
SET ASUV("NSN")=ASUMS("ORD#")
QUIT
+3 IF ASUMS("ORD#")]""
SET ASUV("NSN")=ASUMS("ORD#")
+4 IF '$TEST
SET ASUV("NSN")=ASUMX("NSN")
+5 IF $LENGTH(ASUV("NSN"))=4
QUIT
+6 SET ASUV("NSN")=$EXTRACT(ASUV("NSN"),1,4)_"-"_$EXTRACT(ASUV("NSN"),5,$LENGTH(ASUV("NSN")))
+7 IF $LENGTH(ASUV("NSN"))>7
SET ASUV("NSN")=$EXTRACT(ASUV("NSN"),1,7)_"-"_$EXTRACT(ASUV("NSN"),8,$LENGTH(ASUV("NSN")))
+8 IF $LENGTH(ASUV("NSN"))>11
SET ASUV("NSN")=$EXTRACT(ASUV("NSN"),1,11)_"-"_$EXTRACT(ASUV("NSN"),12,$LENGTH(ASUV("NSN")))
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET ASUV("NSN")=""
End DoDot:1
+11 QUIT
+1 IF ASUF("BK")>1
DO FOOTER
+2 SET ASUF("BK")=0
+3 SET ASUC("PG")=$GET(ASUC("PG"))+1
SET ASUC("LINE")=5
+4 IF ASUC("PG")>1
DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+5 WRITE @(IOF),"REPORT #12 LISTING OF STOCK ITEMS WITH NO ISSUES IN THREE MONTHS",?90,ASUK("DT"),?110,"PAGE",?115,$JUSTIFY($FNUMBER(ASUC("PG"),","),7)
+6 WRITE !,"AREA",?6,ASUL(1,"AR","AP"),?9,ASUL(1,"AR","NM")
+7 WRITE !,"STAT",?6,ASUL(2,"STA","CD"),?9,ASUL(2,"STA","NM"),?50,"G L ACCOUNT 125.",ASUL(9,"ACG"),?68,ASUL(9,"ACG","NM"),!
+8 WRITE !,"A",?75,"LAST",?88,"QTY",?115,"QTY MONTHS"
+9 WRITE !,"CTS",?8,"INDEX",?74,"ISSUE",?89,"ON",?96,"UNIT",?105,"TOTAL",?115,"DUE",?123,"W/O"
+10 WRITE !,"CYC",?7,"NUMBER",?15,"DESCRIPTION",?50,"NSN/ORDER NUMBER",?70,"U/I",?75,"DATE",?87,"HAND",?96,"COST",?105,"VALUE",?116,"IN",?121,"ISSUE",?127,"PAMIQ",!
+11 QUIT
+1 WRITE !?10,"TOTAL",?20,ASUV("ACGNM"),?40,"LINE ITEMS",?55,$JUSTIFY($FNUMBER($GET(ASUC("TOTLI")),","),8),?92,"VALUE",?101,$JUSTIFY($FNUMBER($GET(ASUC("TOTVAL")),",",2),10)
+2 SET (ASUC("TOTVAL"),ASUC("TOTLI"))=0
+3 QUIT
SORT ;EP ;
+1 KILL ^XTMP("ASUR","R12")
+2 SET ^XTMP("ASUR","R12",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+3 ;S ASUMS("E#","STA")=0 ;WAR 5/20/99 replaced w/next line
+4 ;this station only
SET ASUMS("E#","STA")=ASUL(2,"STA","E#")-1
+5 ;F S ASUMS("E#","STA")=$O(^ASUMS(ASUMS("E#","STA"))) Q:ASUMS("E#","STA")'?1N.N D ;WAR 5/20/99 replaced w/next line
+6 ;this station only, NOT all stations
FOR
SET ASUMS("E#","STA")=$ORDER(^ASUMS(ASUMS("E#","STA")))
IF ASUMS("E#","STA")'=ASUL(2,"STA","E#")
QUIT
Begin DoDot:1
+7 FOR ASUMS("E#","IDX")=0:0
SET ASUMS("E#","IDX")=$ORDER(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX")))
IF ASUMS("E#","IDX")'?1N.N
QUIT
Begin DoDot:2
+8 SET ASUMS("LSTISS")=$PIECE(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"),0),U,13)
+9 SET X1=ASUK("DT","FM")
SET X2=ASUMS("LSTISS")
DO ^%DTC
+10 IF X<91
QUIT
+11 SET ASUV("LIDAYS")=X
+12 SET ASUMX("ACC")=$PIECE($GET(^ASUMX(ASUMS("E#","IDX"),0)),U,6)
+13 IF ASUMX("ACC")']""
QUIT
+14 DO ACC^ASULDIRF(ASUMX("ACC"))
+15 SET ^XTMP("ASUR","R12",ASUMS("E#","STA"),ASUL(9,"ACG"),ASUMS("E#","IDX"))=ASUV("LIDAYS")
End DoDot:2
End DoDot:1
+16 QUIT
