- ASURD130 ; IHS/ITSC/LMH -RPT 13 REQM-ANAL ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine sorts extracts into proper sequence so that the
- ;report can be formatted and printed.
- S ASUMS("E#","STA")=0 F S ASUMS("E#","STA")=$O(^ASUMS(ASUMS("E#","STA"))) Q:ASUMS("E#","STA")'?1N.N D
- .S ASUMX("E#","IDX")=0 F ASUU(11)=1:1 S ASUMX("E#","IDX")=$O(^ASUMX(ASUMX("E#","IDX"))) Q:ASUMX("E#","IDX")'?1N.N D
- ..N X S X=(^ASUMX(ASUMX("E#","IDX"),0)) Q:$P(X,U)[999999 Q:'$D(^ASUMS(ASUMS("E#","STA"),1,ASUMX("E#","IDX"),0))
- ..S ASUMS("E#","IDX")=ASUMX("E#","IDX")
- ..D ^ASUMSTRD,READ^ASUMXDIO
- ..I ASUD("R13","SEL")="A"!(ASUD("R13","SEL")="S")!(ASUD("R13","SEL")="Y") D SS Q
- ..I ASUD("R13","SEL")="0"&(ASUMS("SRC")'="1")&(ASUMS("SRC")'="3")&(ASUMS("SRC")'="4")&(ASUMS("SRC")'="5")&(ASUMS("SRC")'="6") D SS Q
- ..I ASUD("R13","SEL")="6"&(ASUMS("SRC")="6") D SS Q
- ..I ASUD("R13","SEL")="5"&(ASUMS("SRC")="5") D SS Q
- ..I ASUD("R13","SEL")="4"&(ASUMS("SRC")="4") D SS Q
- ..I ASUD("R13","SEL")="3"&(ASUMS("SRC")="3") D SS Q
- ..I ASUD("R13","SEL")="1"&(ASUMS("SRC")="1") D SS Q
- Q
- SS ;SORT
- Q:$P(ASUMS(0),U)=99999999
- S ASUV("SLC")=ASUMS("SLC") S:ASUV("SLC")']"" ASUV("SLC")="*"
- S ASUV("VEN NM")=ASUMS("VENAM") S:ASUV("VEN NM")']"" ASUV("VEN NM")="*"
- I ASUMS("EOQ","TP")="R" G NOR13
- I ASUMS("EOQ","TP")="S" I ASUD("R13","SEL")'="S" G NOR13
- I ASUD("R13","SEL")="S" I ASUMS("EOQ","TP")'="S" G NOR13
- I ASUD("R13","SEL")="Y",ASUMS("EOQ","TP")'="Y" G NOR13
- I ASUMS("EOQ","TP")="Y"!(ASUMS("EOQ","TP")="D")!(ASUMS("EOQ","TP")="Q") D ;Q:ASUF("FOUND")=2
- .S ASUV("M")=ASUD("R13","MOAC")
- .S ASUF("FOUND")=0
- .F D Q:ASUF("FOUND")
- ..I ASUV("M")<4&(ASUV("M")=$E(ASUMS("EOQ","AM"))) D SETQAM Q
- ..I ASUV("M")<7&(ASUV("M")=$E(ASUMS("EOQ","AM"),2,2)) D SETQAM Q
- ..I ASUV("M")<10&(ASUV("M")=$E(ASUMS("EOQ","AM"),3,3)) D SETQAM Q
- ..I ASUV("M")=$E(ASUMS("EOQ","AM"),4,5) D SETQAM Q
- ..I (ASUV("M")-ASUD("R13","MOAC"))'=(ASUD("R13","RNG")-1) S ASUV("M")=ASUV("M")+1 Q
- ..I ASUMS("EOQ","TP")="Y",ASUD("R13","SEL")'="Y",ASUF("FOUND")=1 Q
- ..S ASUF("FOUND")=2
- S ASUV("STKST")=ASUMS("QTY","O/H")+ASUMS("D/I","QTY-TOT")-ASUMS("D/O","QTY")
- I ASUD("R13","RNG")>1 S ASUV("STKST")=ASUV("STKST")-ASUMS("PMIQ")
- I ASUD("R13","RNG")=3 S ASUV("STKST")=ASUV("STKST")-ASUMS("PMIQ")
- I ASUMS("EOQ","TP")'="S",(ASUMS("EOQ","TP")'="Y"),ASUV("STKST")>ASUMS("RPQ") G NOR13
- I ASUMX("ACC")'=1&(ASUMX("ACC")'=3) S ASUMX("ACC")=4
- D
- .I ASUMX("ACC")=1&(ASUMX("CAT")'="N"!(ASUMX("CAT")'="R")) S ASUMS("SLC")="E" Q
- .I ASUMX("ACC")=1&(ASUMS("SLC")'="H") S ASUMS("SLC")="Z" Q
- .I ASUMX("ACC")'=1&(ASUMS("SLC")'="H") S ASUMS("SLC")="Z"
- I ASUV("VEN NM")=" " D
- .S ASUV("VEN NM")=$S(ASUMS("SRC")=1:"PERRY POINT",ASUMS("SRC")=3:"GSA",ASUMS("SRC")=4:"VA SUPPLY DEPOT",1:" ")
- S ASUX(0)=ASUMS("E#","STA")_U_ASUMX("E#","IDX")_U_ASUV("STKST")
- S ASUMX("IDX0")="0"_ASUMX("IDX")
- S ^XTMP("ASUR","R13",ASUMS("AR"),ASUMS("STA"),ASUMX("ACC"),ASUV("SLC"),ASUV("VEN NM"),ASUMX("IDX0"),ASUU(11))=ASUX(0)
- S ASUMS("R13","TIMES")=$G(ASUMS("R13","TIMES"))+1
- UPSMSTR ;
- D ^ASUMSTWR
- Q
- NOR13 ;
- S ASUMS("R13","TIMES")=0 G UPSMSTR
- SETQAM ;
- S ASUF("FOUND")=1,ASUV("ACTMO",1)=$E(ASUMS("EOQ","AM")),ASUV("ACTMO",2)=$E(ASUMS("EOQ","AM"),2,2),ASUV("ACTMO",3)=$E(ASUMS("EOQ","AM"),3,3),ASUV("ACTMO",4)=$E(ASUMS("EOQ","AM"),4,5) Q
- ASURD130 ; IHS/ITSC/LMH -RPT 13 REQM-ANAL ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine sorts extracts into proper sequence so that the
- +3 ;report can be formatted and printed.
- +4 SET ASUMS("E#","STA")=0
- FOR
- SET ASUMS("E#","STA")=$ORDER(^ASUMS(ASUMS("E#","STA")))
- IF ASUMS("E#","STA")'?1N.N
- QUIT
- Begin DoDot:1
- +5 SET ASUMX("E#","IDX")=0
- FOR ASUU(11)=1:1
- SET ASUMX("E#","IDX")=$ORDER(^ASUMX(ASUMX("E#","IDX")))
- IF ASUMX("E#","IDX")'?1N.N
- QUIT
- Begin DoDot:2
- +6 NEW X
- SET X=(^ASUMX(ASUMX("E#","IDX"),0))
- IF $PIECE(X,U)[999999
- QUIT
- IF '$DATA(^ASUMS(ASUMS("E#","STA"),1,ASUMX("E#","IDX"),0))
- QUIT
- +7 SET ASUMS("E#","IDX")=ASUMX("E#","IDX")
- +8 DO ^ASUMSTRD
- DO READ^ASUMXDIO
- +9 IF ASUD("R13","SEL")="A"!(ASUD("R13","SEL")="S")!(ASUD("R13","SEL")="Y")
- DO SS
- QUIT
- +10 IF ASUD("R13","SEL")="0"&(ASUMS("SRC")'="1")&(ASUMS("SRC")'="3")&(ASUMS("SRC")'="4")&(ASUMS("SRC")'="5")&(ASUMS("SRC")'="6")
- DO SS
- QUIT
- +11 IF ASUD("R13","SEL")="6"&(ASUMS("SRC")="6")
- DO SS
- QUIT
- +12 IF ASUD("R13","SEL")="5"&(ASUMS("SRC")="5")
- DO SS
- QUIT
- +13 IF ASUD("R13","SEL")="4"&(ASUMS("SRC")="4")
- DO SS
- QUIT
- +14 IF ASUD("R13","SEL")="3"&(ASUMS("SRC")="3")
- DO SS
- QUIT
- +15 IF ASUD("R13","SEL")="1"&(ASUMS("SRC")="1")
- DO SS
- QUIT
- End DoDot:2
- End DoDot:1
- +16 QUIT
- SS ;SORT
- +1 IF $PIECE(ASUMS(0),U)=99999999
- QUIT
- +2 SET ASUV("SLC")=ASUMS("SLC")
- IF ASUV("SLC")']""
- SET ASUV("SLC")="*"
- +3 SET ASUV("VEN NM")=ASUMS("VENAM")
- IF ASUV("VEN NM")']""
- SET ASUV("VEN NM")="*"
- +4 IF ASUMS("EOQ","TP")="R"
- GOTO NOR13
- +5 IF ASUMS("EOQ","TP")="S"
- IF ASUD("R13","SEL")'="S"
- GOTO NOR13
- +6 IF ASUD("R13","SEL")="S"
- IF ASUMS("EOQ","TP")'="S"
- GOTO NOR13
- +7 IF ASUD("R13","SEL")="Y"
- IF ASUMS("EOQ","TP")'="Y"
- GOTO NOR13
- +8 ;Q:ASUF("FOUND")=2
- IF ASUMS("EOQ","TP")="Y"!(ASUMS("EOQ","TP")="D")!(ASUMS("EOQ","TP")="Q")
- Begin DoDot:1
- +9 SET ASUV("M")=ASUD("R13","MOAC")
- +10 SET ASUF("FOUND")=0
- +11 FOR
- Begin DoDot:2
- +12 IF ASUV("M")<4&(ASUV("M")=$EXTRACT(ASUMS("EOQ","AM")))
- DO SETQAM
- QUIT
- +13 IF ASUV("M")<7&(ASUV("M")=$EXTRACT(ASUMS("EOQ","AM"),2,2))
- DO SETQAM
- QUIT
- +14 IF ASUV("M")<10&(ASUV("M")=$EXTRACT(ASUMS("EOQ","AM"),3,3))
- DO SETQAM
- QUIT
- +15 IF ASUV("M")=$EXTRACT(ASUMS("EOQ","AM"),4,5)
- DO SETQAM
- QUIT
- +16 IF (ASUV("M")-ASUD("R13","MOAC"))'=(ASUD("R13","RNG")-1)
- SET ASUV("M")=ASUV("M")+1
- QUIT
- +17 IF ASUMS("EOQ","TP")="Y"
- IF ASUD("R13","SEL")'="Y"
- IF ASUF("FOUND")=1
- QUIT
- +18 SET ASUF("FOUND")=2
- End DoDot:2
- IF ASUF("FOUND")
- QUIT
- End DoDot:1
- +19 SET ASUV("STKST")=ASUMS("QTY","O/H")+ASUMS("D/I","QTY-TOT")-ASUMS("D/O","QTY")
- +20 IF ASUD("R13","RNG")>1
- SET ASUV("STKST")=ASUV("STKST")-ASUMS("PMIQ")
- +21 IF ASUD("R13","RNG")=3
- SET ASUV("STKST")=ASUV("STKST")-ASUMS("PMIQ")
- +22 IF ASUMS("EOQ","TP")'="S"
- IF (ASUMS("EOQ","TP")'="Y")
- IF ASUV("STKST")>ASUMS("RPQ")
- GOTO NOR13
- +23 IF ASUMX("ACC")'=1&(ASUMX("ACC")'=3)
- SET ASUMX("ACC")=4
- +24 Begin DoDot:1
- +25 IF ASUMX("ACC")=1&(ASUMX("CAT")'="N"!(ASUMX("CAT")'="R"))
- SET ASUMS("SLC")="E"
- QUIT
- +26 IF ASUMX("ACC")=1&(ASUMS("SLC")'="H")
- SET ASUMS("SLC")="Z"
- QUIT
- +27 IF ASUMX("ACC")'=1&(ASUMS("SLC")'="H")
- SET ASUMS("SLC")="Z"
- End DoDot:1
- +28 IF ASUV("VEN NM")=" "
- Begin DoDot:1
- +29 SET ASUV("VEN NM")=$SELECT(ASUMS("SRC")=1:"PERRY POINT",ASUMS("SRC")=3:"GSA",ASUMS("SRC")=4:"VA SUPPLY DEPOT",1:" ")
- End DoDot:1
- +30 SET ASUX(0)=ASUMS("E#","STA")_U_ASUMX("E#","IDX")_U_ASUV("STKST")
- +31 SET ASUMX("IDX0")="0"_ASUMX("IDX")
- +32 SET ^XTMP("ASUR","R13",ASUMS("AR"),ASUMS("STA"),ASUMX("ACC"),ASUV("SLC"),ASUV("VEN NM"),ASUMX("IDX0"),ASUU(11))=ASUX(0)
- +33 SET ASUMS("R13","TIMES")=$GET(ASUMS("R13","TIMES"))+1
- UPSMSTR ;
- +1 DO ^ASUMSTWR
- +2 QUIT
- NOR13 ;
- +1 SET ASUMS("R13","TIMES")=0
- GOTO UPSMSTR
- SETQAM ;
- +1 SET ASUF("FOUND")=1
- SET ASUV("ACTMO",1)=$EXTRACT(ASUMS("EOQ","AM"))
- SET ASUV("ACTMO",2)=$EXTRACT(ASUMS("EOQ","AM"),2,2)
- SET ASUV("ACTMO",3)=$EXTRACT(ASUMS("EOQ","AM"),3,3)
- SET ASUV("ACTMO",4)=$EXTRACT(ASUMS("EOQ","AM"),4,5)
- QUIT
