ASURD13P ; IHS/ITSC/LMH -RPT 13 REQM-ANAL ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 13, Requirements Analysis
;Report.
D:'$D(IO) HOME^%ZIS I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
D:'$D(ASUL(1,"AR","AP")) SETAREA^ASULARST
S ASUD("R13","SEL")=$G(ASUD("R13","SEL")) D P0 I ASUD("R13","SEL")="" D MENU Q:$D(DUOUT)
S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
S ZTRTN="PSER^ASURD13P",ZTDESC="SAMS RPT 13" D O^ASUUZIS I POP S IOP=$I D ^%ZIS Q
I ASUK(ASUK("PTR"),"Q") Q
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
K ^XTMP("ASUR","R13") S ^XTMP("ASUR","R13",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
I ($D(ASUK("DT"))#10)'=1 D DATE^ASUUDATE
S (ASUC("VENITM"),ASUC("VENITM",2),ASUC("VENITM",1),ASUC("VENS"),ASUC("EOQVAL"),ASUL("EOQVAL"),ASUC("EOQVAL",4),ASUC("EOQVAL",5),ASUC("EOQVAL","TOT"))=0
I $E(ASUD("R13","MOAC"))=0 S ASUD("R13","MOAC")=$E(ASUD("R13","MOAC"),2,2)
S ASUV("HEADER")=" ("_ASUV("PRV MO")
I $G(ASUD("R13","RNG"))>1 S ASUV("M")=ASUD("R13","MOAC")+ASUD("R13","RNG")-1 S:ASUV("M")>12 ASUV("M")=ASUV("M")-12 S ASUV("HEADER")=ASUV("HEADER")_"-"_ASUD("R13","MO",ASUV("M"))
S ASUV("HEADER")=ASUV("HEADER")_" REQUSITION FOR SUPPLIES)"
S X=0,X=$O(^ASUMX(X)) Q:X="" D CMPT,U^ASUUZIS
S (ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"))="",(ASUC("LN"),ASUC("PG"),ASUC("TOT"))=0,ASUV("ACC")="BEGIN"
S ASUT("AR")=$O(^XTMP("ASUR","R13",0))
I ASUT("AR")="" D CLS^ASUUHDG W !!,"NO REPORT 13 DATA FOR SELECTED PARAMETERS" G END
F S ASUT("STA")=$O(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"))) Q:ASUT("STA")="" D
.S ASUMS("E#","STA")=$O(^ASUMS("B",ASUT("STA"),""))
.S X=ASUT("AR") D AREA^ASULARST S X1=ASUT("STA") D STAT^ASULARST
.F S ASUT("ACC")=$O(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"))) Q:ASUT("ACC")="" D
..S ASUV("ACC")=ASUT("ACC"),(ASUV("SLC"),ASUV("VEN NM"),ASUF("PR"))=""
..F S ASUT("SLC")=$O(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"))) Q:ASUT("SLC")="" D Q:$D(DUOUT)
...D:ASUV("SLC")'=ASUT("SLC")
....I ASUV("SLC")="" S ASUV("SLC")=ASUT("SLC") Q
....I ASUF("PR")="Y" S ASUF("PR")="" Q
....D PACT Q:$D(DUOUT) S ASUF("PR")="Y"
...F S ASUT("VNDR")=$O(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"))) Q:ASUT("VNDR")="" D Q:$D(DUOUT)
....S ASUT("IDX")="" F S ASUT("IDX")=$O(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"),ASUT("IDX"))) Q:ASUT("IDX")="" D Q:$D(DUOUT)
.....S ASUT("SEQ")="" F S ASUT("SEQ")=$O(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"),ASUT("IDX"),ASUT("SEQ"))) Q:ASUT("SEQ")="" Q:$D(DUOUT) D Q:$D(DUOUT)
......S ASUX(0)=^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"),ASUT("IDX"),ASUT("SEQ"))
......S ASUMS("E#","IDX")=$P(ASUX(0),U,2),ASUMS("E#","STA")=$P(ASUX(0),U)
......D M^ASUMSTRD
......S ASUV("EOQTB")=ASUL(2,"STA","EOQTB") S:ASUV("EOQTB")=""!(ASUV("EOQTB")=$C(32)) ASUV("EOQTB")=ASUMS("EOQ","TB")
......D NEWVNDR:ASUV("VEN NM")'=ASUMS("VENAM")
......D:ASUC("LN")>45 HEADER Q:$D(DUOUT) D P5
..D PACT Q:$D(DUOUT)
..W !!?16,"CATEGORY TOTAL NO ITEMS",?40,ASUC("VENITM",2),?46,"EOQ VAL",?50,$J($FN(ASUC("EOQVAL","TOT"),",",2),12)
..S (ASUC("VENITM",2),ASUC("EOQVAL","TOT"))=0,ASUC("LN")=ASUC("LN")+2
..K ASUMS("DMD","CALL"),ASUMS("DMD","QTY")
W !!?14,"STATION TOTAL NO ITEMS",?38,ASUC("VENITM",1),?44,"EOV",?48,$J($FN(ASUC("EOQVAL",4),",",2),12)
S ASUC("EOQVAL",5)=0
END ;
K %DT,ASUU,ASUD,ASUMS,ASUC,ASUV,ASUS,ASUMX,ASUF,ASUT,X,X1,X2,X3,X4,Y,ZTRTN,ZTDESC
F X=3:1:22 K ASUL(X) ;Clear Table Lookup fields
D PAZ^ASUURHDR I ASUK("PTRSEL")]"" W @IOF Q
D C^ASUUZIS Q
CMPT ;EP ;CREATE EXTRACTS
D ^ASURD130 Q
P0 ;EP ;SELECTION
I '$D(ASUD("R13","MO")) D
.S ASUD("R13","ASOF")=$S($D(ASUK("DT","YRMO")):ASUK("DT","YRMO"),1:$E(DT,2,7))
.S (ASUD("R13","MOAC"),ASUD("R13","MOBG"))=$E(ASUD("R13","ASOF"),3,4)
.S ASUD("R13","MO")=0
.F ASUD("R13","MONM")="JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC" D
..S ASUD("R13","MO")=ASUD("R13","MO")+1,ASUD("R13","MO",ASUD("R13","MO"))=ASUD("R13","MONM")
S ASUV("PRV MO")=ASUD("R13","MO",+ASUD("R13","MOAC"))
Q
I IO'=IO(0) U IO(0) S ASUF("IO")=1
D:$G(ASUD("R13","SEL"))']"" Q:$D(DUOUT)
.D CLS^ASUUHDG W !?18,"REQUIREMENTS ANALYSIS REPORT",!?26,"ITEM SELECTION",!!
.S DIR("A")="ENTER YOUR SELECTION"
.S DIR(0)="SR^1:PERRY POINT ITEMS;3:GSA ITEMS;4:VA ITEMS;5:MILITARY (DOD/DPSC/DSLA) ITEMS;6:OTHER GOVERNMENT SOURCE ITEMS;0:ALL OTHER SOURCE ITEMS;A:ALL ITEMS;S:DROP SHIP ITEMS;Y:YEARLY QTY MOD ITEMS"
.D ^DIR
.Q:$D(DTOUT) Q:$D(DUOUT)
.S ASUD("R13","SEL")=Y
D:$G(ASUD("R13","RNG"))']"" Q:$D(DUOUT)
.D CLS^ASUUHDG W ?26,"PERIOD SELECTION"
.S DIR(0)="SR^1:CURRENT MONTH ONLY;2:CURRENT AND NEXT MONTHS;3:CURRENT AND NEXT 2 MONTHS",DIR("B")=1 D ^DIR
.Q:$D(DTOUT) Q:$D(DUOUT)
.S ASUD("R13","RNG")=Y K DIR D CLS^ASUUHDG
I $G(ASUF("IO"))=1 U IO K ASUF("IO")
Q
S ASUU(1)=$O(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),"")),ASUU(2)=$O(^(ASUU(1),"")),ASUC("PG")=$G(ASUC("PG"))+1,ASUC("LN")=0
D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
W !?1,"REPORT #13 REQUIREMENTS ANALYSIS",ASUV("HEADER")
D P0
W ?80,$E(ASUK("DT","FM"),4,5),"/",$E(ASUK("DT","FM"),6,7),"/",$E(ASUK("DT","FM"),2,3),?120,"PAGE: ",ASUC("PG")
W !?3,"AREA: ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")
W !?3,"STAT: ",ASUL(2,"STA","CD"),?15,ASUL(2,"STA","NM"),?41,"ACCOUNT: ",$S(ASUT("ACC")=1:"PHARMACY",ASUT("ACC")=3:"SUBSISTENCE",1:"GENERAL SUPPLIES")
W ?74,"VENDOR: ",$S(ASUV("VEN NM")=" ":ASUT("VNDR"),1:ASUV("VEN NM")),?100,"EOQ TABLE: ",ASUV("EOQTB")
W !!?3,"INDEX SLC",?32,"USAGE BY MONTH -CURRENT TO OLDEST",!?2,"NUMBER",?16,"ORDER",?35,"ISSUED NO. ISSUED NO.",?65,"ISSUED NO."
W !?1,"DESCRIPTION",?16,"NUMBER",?34,"MO",?37,"QUANT",?44,"REQ",?48,"MO",?51,"QUANT",?58,"REQ",?62,"MO",?65,"QUANT",?72,"REQ"
W !,"------------------------------------------------------------------------------------------------------------------------------------",!!
S ASUC("LN")=ASUC("LN")+8
Q
P5 ;VEND & ACCT
S ASUMX(0)=^ASUMX(ASUMS("E#","IDX"),0)
S ASUC("VENS")=ASUC("VENS")+1,ASUMX("IDX")=$P(ASUMX(0),U)
W !!?3,$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6,6),?12,$P(ASUMS(2),U)
S ASUC("LN")=ASUC("LN")+2
I ASUMS("ORD#")'=$C(32),ASUMS("ORD#")]"" D
.S ASUV("ORD#")=ASUMS("ORD#")
.I $E(ASUV("ORD#"))="M" D
..W ?16,ASUV("ORD#")
.E D
..W ?16,$E(ASUV("ORD#"),1,4)_"-"_$E(ASUV("ORD#"),5,6)_"-"_$E(ASUV("ORD#"),7,9)_"-"_$E(ASUV("ORD#"),10,14)
E D
.S ASUV("ORD#")=ASUMX("NSN")
.I $E(ASUV("ORD#"))="M" D
..W ?16,ASUV("ORD#")
.E D
..W ?16,$E(ASUV("ORD#"),1,4)_"-"_$E(ASUV("ORD#"),5,6)_"-"_$E(ASUV("ORD#"),7,9)_"-"_$E(ASUV("ORD#"),10,14)
K ASUV("ORD#") D ADDMNT D ^ASURD132
S ASUC("VENITM")=ASUC("VENITM")+1
Q
PACT ;EP; -PRINT ACCOUNT TOTALS
D:ASUC("LN")>45 HEADER Q:$D(DUOUT)
W !!?16,"VENDOR TOTAL NO ITEMS",?38,ASUC("VENITM"),?44,"EOV",?48,$J($FN(ASUC("EOQVAL",5),",",2),12)
W !!?16,"REQUISITIONED BY:",!?35,"SIGNATURE/TITLE",?58,"DATE:"
W !!?21,"APPROVED BY:",!?35,"SIGNATURE/TITLE",?58,"DATE"
W !!?16,"FUNDS AVAILABLE :",!?35,"SIGNATURE/TITLE",?58,"DATE",!
S ASUC("LN")=ASUC("LN")+8,ASUC("VENITM",1)=ASUC("VENITM",1)+ASUC("VENITM"),ASUC("VENITM",2)=ASUC("VENITM",2)+ASUC("VENITM")
S ASUC("EOQVAL")=ASUC("EOQVAL")+ASUL("EOQVAL"),ASUC("EOQVAL","TOT")=ASUC("EOQVAL","TOT")+ASUC("EOQVAL",5),ASUC("EOQVAL",4)=ASUC("EOQVAL",4)+ASUC("EOQVAL",5)
S (ASUC("VENITM"),ASUC("EOQVAL",5))=0
Q
PRTVNDOR ;PRINT VENDOR TOTALS AND HEADERS
I ASUV("ACC")="BEGIN" D HEADER Q
Q:ASUT("ACC")="" D HEADER Q:$D(DUOUT) S ASUC("VENS")=0
Q
ADDMNT ;ADD MONTHS FROM ASUMS FOR INDEX. CHECK EACH USER
D MICK^ASUMSTRD,MIC^ASUMSTRD Q
NEWVNDR ;EP; -SET VENDOR NAME
I ASUV("VEN NM")="" S ASUV("VEN NM")=ASUMS("VENAM") D HEADER Q
I ASUF("PR")'="Y" D PACT Q:$D(DUOUT)
S ASUF("PR")="",ASUV("VEN NM")=ASUMS("VENAM") D HEADER Q
ASURD13P ; IHS/ITSC/LMH -RPT 13 REQM-ANAL ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 13, Requirements Analysis
+3 ;Report.
+4 IF '$DATA(IO)
DO HOME^%ZIS
IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
QUIT
+5 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+6 SET ASUD("R13","SEL")=$GET(ASUD("R13","SEL"))
DO P0
IF ASUD("R13","SEL")=""
DO MENU
IF $DATA(DUOUT)
QUIT
+7 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
IF ASUK("PTRSEL")]""
GOTO PSER
+8 SET ZTRTN="PSER^ASURD13P"
SET ZTDESC="SAMS RPT 13"
DO O^ASUUZIS
IF POP
SET IOP=$IO
DO ^%ZIS
QUIT
+9 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 KILL ^XTMP("ASUR","R13")
SET ^XTMP("ASUR","R13",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
+2 IF ($DATA(ASUK("DT"))#10)'=1
DO DATE^ASUUDATE
+3 SET (ASUC("VENITM"),ASUC("VENITM",2),ASUC("VENITM",1),ASUC("VENS"),ASUC("EOQVAL"),ASUL("EOQVAL"),ASUC("EOQVAL",4),ASUC("EOQVAL",5),ASUC("EOQVAL","TOT"))=0
+4 IF $EXTRACT(ASUD("R13","MOAC"))=0
SET ASUD("R13","MOAC")=$EXTRACT(ASUD("R13","MOAC"),2,2)
+5 SET ASUV("HEADER")=" ("_ASUV("PRV MO")
+6 IF $GET(ASUD("R13","RNG"))>1
SET ASUV("M")=ASUD("R13","MOAC")+ASUD("R13","RNG")-1
IF ASUV("M")>12
SET ASUV("M")=ASUV("M")-12
SET ASUV("HEADER")=ASUV("HEADER")_"-"_ASUD("R13","MO",ASUV("M"))
+7 SET ASUV("HEADER")=ASUV("HEADER")_" REQUSITION FOR SUPPLIES)"
+8 SET X=0
SET X=$ORDER(^ASUMX(X))
IF X=""
QUIT
DO CMPT
DO U^ASUUZIS
+9 SET (ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"))=""
SET (ASUC("LN"),ASUC("PG"),ASUC("TOT"))=0
SET ASUV("ACC")="BEGIN"
+10 SET ASUT("AR")=$ORDER(^XTMP("ASUR","R13",0))
+11 IF ASUT("AR")=""
DO CLS^ASUUHDG
WRITE !!,"NO REPORT 13 DATA FOR SELECTED PARAMETERS"
GOTO END
+12 FOR
SET ASUT("STA")=$ORDER(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA")))
IF ASUT("STA")=""
QUIT
Begin DoDot:1
+13 SET ASUMS("E#","STA")=$ORDER(^ASUMS("B",ASUT("STA"),""))
+14 SET X=ASUT("AR")
DO AREA^ASULARST
SET X1=ASUT("STA")
DO STAT^ASULARST
+15 FOR
SET ASUT("ACC")=$ORDER(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC")))
IF ASUT("ACC")=""
QUIT
Begin DoDot:2
+16 SET ASUV("ACC")=ASUT("ACC")
SET (ASUV("SLC"),ASUV("VEN NM"),ASUF("PR"))=""
+17 FOR
SET ASUT("SLC")=$ORDER(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC")))
IF ASUT("SLC")=""
QUIT
Begin DoDot:3
+18 IF ASUV("SLC")'=ASUT("SLC")
Begin DoDot:4
+19 IF ASUV("SLC")=""
SET ASUV("SLC")=ASUT("SLC")
QUIT
+20 IF ASUF("PR")="Y"
SET ASUF("PR")=""
QUIT
+21 DO PACT
IF $DATA(DUOUT)
QUIT
SET ASUF("PR")="Y"
End DoDot:4
+22 FOR
SET ASUT("VNDR")=$ORDER(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR")))
IF ASUT("VNDR")=""
QUIT
Begin DoDot:4
+23 SET ASUT("IDX")=""
FOR
SET ASUT("IDX")=$ORDER(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"),ASUT("IDX")))
IF ASUT("IDX")=""
QUIT
Begin DoDot:5
+24 SET ASUT("SEQ")=""
FOR
SET ASUT("SEQ")=$ORDER(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"),ASUT("IDX"),ASUT("SEQ")))
IF ASUT("SEQ")=""
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:6
+25 SET ASUX(0)=^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),ASUT("SLC"),ASUT("VNDR"),ASUT("IDX"),ASUT("SEQ"))
+26 SET ASUMS("E#","IDX")=$PIECE(ASUX(0),U,2)
SET ASUMS("E#","STA")=$PIECE(ASUX(0),U)
+27 DO M^ASUMSTRD
+28 SET ASUV("EOQTB")=ASUL(2,"STA","EOQTB")
IF ASUV("EOQTB")=""!(ASUV("EOQTB")=$CHAR(32))
SET ASUV("EOQTB")=ASUMS("EOQ","TB")
+29 IF ASUV("VEN NM")'=ASUMS("VENAM")
DO NEWVNDR
+30 IF ASUC("LN")>45
DO HEADER
IF $DATA(DUOUT)
QUIT
DO P5
End DoDot:6
IF $DATA(DUOUT)
QUIT
End DoDot:5
IF $DATA(DUOUT)
QUIT
End DoDot:4
IF $DATA(DUOUT)
QUIT
End DoDot:3
IF $DATA(DUOUT)
QUIT
+31 DO PACT
IF $DATA(DUOUT)
QUIT
+32 WRITE !!?16,"CATEGORY TOTAL NO ITEMS",?40,ASUC("VENITM",2),?46,"EOQ VAL",?50,$JUSTIFY($FNUMBER(ASUC("EOQVAL","TOT"),",",2),12)
+33 SET (ASUC("VENITM",2),ASUC("EOQVAL","TOT"))=0
SET ASUC("LN")=ASUC("LN")+2
+34 KILL ASUMS("DMD","CALL"),ASUMS("DMD","QTY")
End DoDot:2
End DoDot:1
+35 WRITE !!?14,"STATION TOTAL NO ITEMS",?38,ASUC("VENITM",1),?44,"EOV",?48,$JUSTIFY($FNUMBER(ASUC("EOQVAL",4),",",2),12)
+36 SET ASUC("EOQVAL",5)=0
END ;
+1 KILL %DT,ASUU,ASUD,ASUMS,ASUC,ASUV,ASUS,ASUMX,ASUF,ASUT,X,X1,X2,X3,X4,Y,ZTRTN,ZTDESC
+2 ;Clear Table Lookup fields
FOR X=3:1:22
KILL ASUL(X)
+3 DO PAZ^ASUURHDR
IF ASUK("PTRSEL")]""
WRITE @IOF
QUIT
+4 DO C^ASUUZIS
QUIT
CMPT ;EP ;CREATE EXTRACTS
+1 DO ^ASURD130
QUIT
P0 ;EP ;SELECTION
+1 IF '$DATA(ASUD("R13","MO"))
Begin DoDot:1
+2 SET ASUD("R13","ASOF")=$SELECT($DATA(ASUK("DT","YRMO")):ASUK("DT","YRMO"),1:$EXTRACT(DT,2,7))
+3 SET (ASUD("R13","MOAC"),ASUD("R13","MOBG"))=$EXTRACT(ASUD("R13","ASOF"),3,4)
+4 SET ASUD("R13","MO")=0
+5 FOR ASUD("R13","MONM")="JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
Begin DoDot:2
+6 SET ASUD("R13","MO")=ASUD("R13","MO")+1
SET ASUD("R13","MO",ASUD("R13","MO"))=ASUD("R13","MONM")
End DoDot:2
End DoDot:1
+7 SET ASUV("PRV MO")=ASUD("R13","MO",+ASUD("R13","MOAC"))
+8 QUIT
+1 IF IO'=IO(0)
USE IO(0)
SET ASUF("IO")=1
+2 IF $GET(ASUD("R13","SEL"))']""
Begin DoDot:1
+3 DO CLS^ASUUHDG
WRITE !?18,"REQUIREMENTS ANALYSIS REPORT",!?26,"ITEM SELECTION",!!
+4 SET DIR("A")="ENTER YOUR SELECTION"
+5 SET DIR(0)="SR^1:PERRY POINT ITEMS;3:GSA ITEMS;4:VA ITEMS;5:MILITARY (DOD/DPSC/DSLA) ITEMS;6:OTHER GOVERNMENT SOURCE ITEMS;0:ALL OTHER SOURCE ITEMS;A:ALL ITEMS;S:DROP SHIP ITEMS;Y:YEARLY QTY MOD ITEMS"
+6 DO ^DIR
+7 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+8 SET ASUD("R13","SEL")=Y
End DoDot:1
IF $DATA(DUOUT)
QUIT
+9 IF $GET(ASUD("R13","RNG"))']""
Begin DoDot:1
+10 DO CLS^ASUUHDG
WRITE ?26,"PERIOD SELECTION"
+11 SET DIR(0)="SR^1:CURRENT MONTH ONLY;2:CURRENT AND NEXT MONTHS;3:CURRENT AND NEXT 2 MONTHS"
SET DIR("B")=1
DO ^DIR
+12 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+13 SET ASUD("R13","RNG")=Y
KILL DIR
DO CLS^ASUUHDG
End DoDot:1
IF $DATA(DUOUT)
QUIT
+14 IF $GET(ASUF("IO"))=1
USE IO
KILL ASUF("IO")
+15 QUIT
+1 SET ASUU(1)=$ORDER(^XTMP("ASUR","R13",ASUT("AR"),ASUT("STA"),ASUT("ACC"),""))
SET ASUU(2)=$ORDER(^(ASUU(1),""))
SET ASUC("PG")=$GET(ASUC("PG"))+1
SET ASUC("LN")=0
+2 IF ASUC("PG")>1
DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
WRITE @IOF
+3 WRITE !?1,"REPORT #13 REQUIREMENTS ANALYSIS",ASUV("HEADER")
+4 DO P0
+5 WRITE ?80,$EXTRACT(ASUK("DT","FM"),4,5),"/",$EXTRACT(ASUK("DT","FM"),6,7),"/",$EXTRACT(ASUK("DT","FM"),2,3),?120,"PAGE: ",ASUC("PG")
+6 WRITE !?3,"AREA: ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")
+7 WRITE !?3,"STAT: ",ASUL(2,"STA","CD"),?15,ASUL(2,"STA","NM"),?41,"ACCOUNT: ",$SELECT(ASUT("ACC")=1:"PHARMACY",ASUT("ACC")=3:"SUBSISTENCE",1:"GENERAL SUPPLIES")
+8 WRITE ?74,"VENDOR: ",$SELECT(ASUV("VEN NM")=" ":ASUT("VNDR"),1:ASUV("VEN NM")),?100,"EOQ TABLE: ",ASUV("EOQTB")
+9 WRITE !!?3,"INDEX SLC",?32,"USAGE BY MONTH -CURRENT TO OLDEST",!?2,"NUMBER",?16,"ORDER",?35,"ISSUED NO. ISSUED NO.",?65,"ISSUED NO."
+10 WRITE !?1,"DESCRIPTION",?16,"NUMBER",?34,"MO",?37,"QUANT",?44,"REQ",?48,"MO",?51,"QUANT",?58,"REQ",?62,"MO",?65,"QUANT",?72,"REQ"
+11 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------",!!
+12 SET ASUC("LN")=ASUC("LN")+8
+13 QUIT
P5 ;VEND & ACCT
+1 SET ASUMX(0)=^ASUMX(ASUMS("E#","IDX"),0)
+2 SET ASUC("VENS")=ASUC("VENS")+1
SET ASUMX("IDX")=$PIECE(ASUMX(0),U)
+3 WRITE !!?3,$EXTRACT(ASUMX("IDX"),1,5),".",$EXTRACT(ASUMX("IDX"),6,6),?12,$PIECE(ASUMS(2),U)
+4 SET ASUC("LN")=ASUC("LN")+2
+5 IF ASUMS("ORD#")'=$CHAR(32)
IF ASUMS("ORD#")]""
Begin DoDot:1
+6 SET ASUV("ORD#")=ASUMS("ORD#")
+7 IF $EXTRACT(ASUV("ORD#"))="M"
Begin DoDot:2
+8 WRITE ?16,ASUV("ORD#")
End DoDot:2
+9 IF '$TEST
Begin DoDot:2
+10 WRITE ?16,$EXTRACT(ASUV("ORD#"),1,4)_"-"_$EXTRACT(ASUV("ORD#"),5,6)_"-"_$EXTRACT(ASUV("ORD#"),7,9)_"-"_$EXTRACT(ASUV("ORD#"),10,14)
End DoDot:2
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET ASUV("ORD#")=ASUMX("NSN")
+13 IF $EXTRACT(ASUV("ORD#"))="M"
Begin DoDot:2
+14 WRITE ?16,ASUV("ORD#")
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 WRITE ?16,$EXTRACT(ASUV("ORD#"),1,4)_"-"_$EXTRACT(ASUV("ORD#"),5,6)_"-"_$EXTRACT(ASUV("ORD#"),7,9)_"-"_$EXTRACT(ASUV("ORD#"),10,14)
End DoDot:2
End DoDot:1
+17 KILL ASUV("ORD#")
DO ADDMNT
DO ^ASURD132
+18 SET ASUC("VENITM")=ASUC("VENITM")+1
+19 QUIT
PACT ;EP; -PRINT ACCOUNT TOTALS
+1 IF ASUC("LN")>45
DO HEADER
IF $DATA(DUOUT)
QUIT
+2 WRITE !!?16,"VENDOR TOTAL NO ITEMS",?38,ASUC("VENITM"),?44,"EOV",?48,$JUSTIFY($FNUMBER(ASUC("EOQVAL",5),",",2),12)
+3 WRITE !!?16,"REQUISITIONED BY:",!?35,"SIGNATURE/TITLE",?58,"DATE:"
+4 WRITE !!?21,"APPROVED BY:",!?35,"SIGNATURE/TITLE",?58,"DATE"
+5 WRITE !!?16,"FUNDS AVAILABLE :",!?35,"SIGNATURE/TITLE",?58,"DATE",!
+6 SET ASUC("LN")=ASUC("LN")+8
SET ASUC("VENITM",1)=ASUC("VENITM",1)+ASUC("VENITM")
SET ASUC("VENITM",2)=ASUC("VENITM",2)+ASUC("VENITM")
+7 SET ASUC("EOQVAL")=ASUC("EOQVAL")+ASUL("EOQVAL")
SET ASUC("EOQVAL","TOT")=ASUC("EOQVAL","TOT")+ASUC("EOQVAL",5)
SET ASUC("EOQVAL",4)=ASUC("EOQVAL",4)+ASUC("EOQVAL",5)
+8 SET (ASUC("VENITM"),ASUC("EOQVAL",5))=0
+9 QUIT
PRTVNDOR ;PRINT VENDOR TOTALS AND HEADERS
+1 IF ASUV("ACC")="BEGIN"
DO HEADER
QUIT
+2 IF ASUT("ACC")=""
QUIT
DO HEADER
IF $DATA(DUOUT)
QUIT
SET ASUC("VENS")=0
+3 QUIT
ADDMNT ;ADD MONTHS FROM ASUMS FOR INDEX. CHECK EACH USER
+1 DO MICK^ASUMSTRD
DO MIC^ASUMSTRD
QUIT
NEWVNDR ;EP; -SET VENDOR NAME
+1 IF ASUV("VEN NM")=""
SET ASUV("VEN NM")=ASUMS("VENAM")
DO HEADER
QUIT
+2 IF ASUF("PR")'="Y"
DO PACT
IF $DATA(DUOUT)
QUIT
+3 SET ASUF("PR")=""
SET ASUV("VEN NM")=ASUMS("VENAM")
DO HEADER
QUIT
