- 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
