- 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
