- ASURD11P ; IHS/ITSC/LMH -RPT 11 DAILY TRANS REGISTER ; [ 07/17/2000 9:13 AM ]
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine formats and prints Daily Transaction Register
- EN ;EP;PRIMARY
- 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 ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
- S ZTRTN="PSER^ASURD11P",ZTDESC="SAMS RPT 11" D O^ASUUZIS I POP S IOP=$I D ^%ZIS Q
- I ASUK(ASUK("PTR"),"Q") Q
- PSER ;EP;FOR TM Q
- D:'$D(^XTMP("ASUR","R11")) CMPT D U^ASUUZIS S ASUV("RPT")="R11",ASUQ("HDR")="HEADER^ASURD11P" D ^ASUUDATA I ASUX("NDTA") G K
- S ASUC("LN")=9
- S (ASUC("LI-TOT"),ASUC("VLR"),ASUC("VLI"),ASUC("VLJ"),ASUA("LIA"),ASUC("DEL"),ASUC("TOT"),ASUC("VALTOT"))=0
- S ASUX("AS")=0 F S ASUX("AS")=$O(^XTMP("ASUR","R11",ASUX("AS"))) Q:ASUX("AS")="" D Q:$D(DUOUT)
- .I ASUV("ARST")'=ASUX("AS") D
- ..K ASUL(2) D STA^ASULARST($E(ASUX("AS"),3,4)) S ASUV("ARST")=ASUX("AS")
- .S ASUX("AG")="" F S ASUX("AG")=$O(^XTMP("ASUR","R11",ASUX("AS"),$G(ASUX("AG")))) Q:ASUX("AG")="" D Q:$D(DUOUT)
- ..I ASUC("LN")<(IOSL-2) W ! S ASUC("LN")=ASUC("LN")+1
- ..D:ASUC("LN")>(IOSL-3) HEADER^ASURD11P
- ..K ASUA D CALCT
- ..S ASUA("VL")=0
- ..S ASUX("IX")="" F S ASUX("IX")=$O(^XTMP("ASUR","R11",ASUX("AS"),ASUX("AG"),$G(ASUX("IX")))) Q:ASUX("IX")="" D Q:$D(DUOUT)
- ...S ASUA(0)=$G(^XTMP("ASUMA",ASUX("AS"),ASUX("AG"),ASUX("IX")))
- ...S (ASUCX("QTT"),ASUA("QTY"))=$P(ASUA(0),U,3),(ASUCX("VLT"),ASUA("VAL"))=$P(ASUA(0),U,2),(ASUCX("QTDIT"),ASUA("QTDI"))=$P(ASUA(0),U,4)
- ...S (ASUMS("E#","IDX"),ASUMX("E#","IDX"))=ASUX("IX") D READ^ASUMXDIO,^ASUMSTRD
- ...S ASUC("LN")=ASUC("LN")+1 W !?3,ASUMX("ACC"),?5,ASUMS("EOQ","TP"),?7,ASUMS("SRC"),?9,$E(ASUX("IX"),3,7),".",$E(ASUX("IX"),8),?17,ASUMS("SLC")
- ...S X=$S(ASUMX("DESC")]"":ASUMX("DESC"),1:ASUMX("DELDS")) W ?19,$E(X,1,30),?51,ASUMX("AR U/I"),?55,$E(ASUMS("ESTB"),2,3),"-",$E(ASUMS("ESTB"),4,5)
- ...W:$G(ASUT("TYPE"))'=1 ?68,$J($FN(ASUA("QTY"),"T"),5)
- ...W ?75,$J($FN(ASUMS("CST/U"),"T",2),8),?89,$J($FN(ASUA("VAL"),"T",2),12)
- ...W ?101,$J($FN(ASUA("QTDI"),"T"),6),?131,ASUMX("CAT"),!
- ...S ASUCX("QTDIT")=$G(ASUA("QTDI")),ASUF("DESC")=1
- ...S ASUV("NSN")=ASUMS("ORD#") I ASUV("NSN")=$C(32)!(ASUV("NSN")="") S ASUV("NSN")=ASUMX("NSN")
- ...I $E(ASUV("NSN"))'="M" S ASUV("NSN")=$E(ASUV("NSN"),1,4)_"-"_$E(ASUV("NSN"),5,6)_"-"_$E(ASUV("NSN"),7,9)_"-"_$E(ASUV("NSN"),10,14)
- ...S ASUX("SQ")="" F S ASUX("SQ")=$O(^XTMP("ASUR","R11",ASUX("AS"),ASUX("AG"),ASUX("IX"),$G(ASUX("SQ")))) Q:ASUX("SQ")="" D
- ....S ASUHDA=^XTMP("ASUR","R11",ASUX("AS"),ASUX("AG"),ASUX("IX"),ASUX("SQ")) K ASUT D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']"" I "4A4C5A5C"[ASUT("TRCD") Q
- ....I ASUC("LN")>(IOSL-5) D HEADER^ASURD11P
- ....S ASUC("LI-TOT")=$G(ASUC("LI-TOT"))+1 S ASUV("CST/U")=""
- ....I ASUT("TRCD")="5D" S ASUCX("QTDIT")=0
- ....I $E(ASUT("TRCD"))="1" D
- .....S ASUX("QTDI")=ASUT(ASUT,"QTY")*ASUT(ASUT,"SIGN")
- .....I ASUX("QTDI")=0 D
- ......S (ASUX("QTDI"),ASUV("CST/U"))=0
- .....E D
- ......S ASUV("CST/U")=ASUT(ASUT,"VAL")/ASUX("QTDI")
- ....E D
- .....I ASUT(ASUT,"QTY")=0!(ASUT(ASUT,"QTY")="") S ASUV("CST/U")=ASUMS("LPP")
- .....E S ASUV("CST/U")=ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY")
- ....I ASUV("CST/U")<0 S ASUV("CST/U")=ASUV("CST/U")*-1
- ....I "2K2M2N2O2P323334363731"[ASUT("TRCD") D
- .....D P8 W ?51,$G(ASUT(ASUT,"U/I")),?52,ASUT(ASUT,"VOU") S:ASUT(ASUT,"QTY")=0 ASUV("CST/U")=0
- .....W ?63,ASUT("TRCD"),$G(ASUT(ASUT,"PST")),?68,$J($FN((ASUT(ASUT,"QTY")*-1),"T"),5),?75,$J($FN(ASUV("CST/U"),"T,",2),8) K X
- .....W:ASUT(ASUT,"FPN")="P" ?88,"P"
- .....W ?89,$J($FN((ASUT(ASUT,"VAL")*-1),"T,",2),12)
- .....S ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1,ASUCX("VLT")=$G(ASUCX("VLT"))+ASUT(ASUT,"VAL")
- .....S ASUCX("QTT")=$G(ASUCX("QTT"))-ASUT(ASUT,"QTY")
- .....I "2K2M2N2O"[ASUT("TRCD") S ASUC("VLR")=$G(ASUC("VLR"))+ASUT(ASUT,"VAL")
- .....I "313332"[ASUT("TRCD") S ASUC("VLI")=$G(ASUC("VLI"))+ASUT(ASUT,"VAL")
- .....I "2P343637"[ASUT("TRCD") S ASUC("VLJ")=$G(ASUC("VLJ"))+ASUT(ASUT,"VAL")
- ....I "22242526273K3L3M3O3P"[ASUT("TRCD") D
- .....W:ASUT(ASUT,"SRC")]"" ?7,$E(ASUT(ASUT,"SRC")) D P8 W $G(ASUT(ASUT,"U/I")),?52,ASUT(ASUT,"VOU"),?63,ASUT("TRCD")
- .....W ?68,$J($FN(ASUT(ASUT,"QTY"),"T"),5)
- .....W ?75,$J($FN(ASUV("CST/U"),"T,",2),8)
- .....W:ASUT(ASUT,"SRC")'=ASUMS("SRC") ?87,"*"
- .....W ?89,$J($FN(ASUT(ASUT,"VAL"),"T,",2),12)
- .....I $G(ASUT(ASUT,"D/IF"))]"" D
- ......S ASUX("QTDI")=ASUT(ASUT,"D/IF") S:ASUX("QTDI")=0 ASUX("QTDI")=(ASUT(ASUT,"QTY")*ASUT(ASUT,"SIGN"))
- ......W ?101,$J($FN(ASUX("QTDI"),"T",0),6) S ASUCX("QTDIT")=$G(ASUCX("QTDIT"))+ASUX("QTDI")
- .....S ASUX("QTDI")=0,ASUCX("VLT")=$G(ASUCX("VLT"))+ASUT(ASUT,"VAL")
- .....S ASUCX("QTT")=$G(ASUCX("QTT"))+ASUT(ASUT,"QTY")
- .....I "22242526"[ASUT("TRCD") S ASUC("VLR")=$G(ASUC("VLR"))+ASUT(ASUT,"VAL")
- .....I "3K3L"[ASUT("TRCD") S ASUC("VLI")=$G(ASUC("VLI"))+ASUT(ASUT,"VAL")
- .....I "273P3M3O"[ASUT("TRCD") S ASUC("VLJ")=$G(ASUC("VLJ"))+ASUT(ASUT,"VAL")
- ....I "121415161K1M1N1O"[ASUT("TRCD") D
- .....W ?7,$E(ASUT(ASUT,"SRC")) D P8 W ?51,$G(ASUT(ASUT,"U/I"))
- .....S ASUT(ASUT,"VAL")=0
- .....I $L(ASUT(ASUT,"DTD"))>0&(ASUT(ASUT,"DTD")'=" ") W ?52,$E(ASUT(ASUT,"DTD"),4,5)_"-"_$E(ASUT(ASUT,"DTD"),6,7)_"-"_$E(ASUT(ASUT,"DTD"),2,3)
- .....W ?63,ASUT("TRCD")
- .....;W ?68,$J($FN(ASUT(ASUT,"QTY"),"T"),5)
- .....W ?75,$J($FN(ASUV("CST/U"),"T,",2),8)
- .....;S ASUCX("VLT")=$G(ASUCX("VLT"))+ASUT(ASUT,"VAL"),ASUCX("QTT")=$G(ASUCX("QTT"))+ASUT(ASUT,"QTY")
- .....S ASUCX("QTDIT")=$G(ASUCX("QTDIT"))+ASUX("QTDI")
- .....W ?101,$J($FN(ASUX("QTDI"),"T"),6)
- ....I ASUT("TRCD")="5D" D
- .....W ?55,ASUT(ASUT,"VOU"),?91,"ITEM DEL" S (ASUCX("QTT"),ASUCX("QTDIT"),ASUCX("VLT"))=0
- ....W ?108,$G(ASUT(ASUT,"REQ TYP")),?110,$G(ASUT(ASUT,"SSA"))
- ....W:ASUT("TYPE")'=2 ?113,$G(ASUT(ASUT,"SST"))
- ....W ?116,$G(ASUT(ASUT,"PON"))
- ....W:ASUT("TYPE")'=2 ?117,$G(ASUT(ASUT,"CAN"))
- ....I ASUT("TYPE")>2 W ?126,$G(ASUT(ASUT,"USR")),!
- ....E W !
- ....S ASUC("LN")=ASUC("LN")+1
- ....I ASUC("LN")>(IOSL-5) D HEADER^ASURD11P
- ...I ASUF("DESC")=1 W !?19,$E(ASUMX("DESC"),31,60) S ASUF("DESC")=2,ASUC("LN")=ASUC("LN")+1
- ...I ASUF("DESC")=2 W !?33,ASUV("NSN") S ASUF("DESC")=3,ASUC("LN")=ASUC("LN")+1
- ...;S ASUCX("VLT")=$G(ASUCX("VLT"))+$G(ASUA("VL")),ASUCX("QTT")=$G(ASUCX("QTT"))+$G(ASUA("QTY"))
- ...I $G(ASUCX("QTDIT"))<0 S ASUCX("QTDIT")=0
- ...I $G(ASUCX("QTT"))<0 S ASUCX("QTT")=0
- ...W ?68,"______",?89,"___________",?102,"______",!?60,"TOTAL",?68,$J($FN(ASUCX("QTT"),"T",0),5),?89,$J($FN(ASUCX("VLT"),"T,",2),12),?101,$J(ASUCX("QTDIT"),6),?111,"PAMIQ=",ASUMS("PMIQ"),!
- ...S ASUC("LN")=ASUC("LN")+2 K ASUCX
- ..Q:$D(DUOUT)
- ..S ASUC("VLGT")=ASUC("VLR")+ASUC("VLI")+ASUC("VLJ")+$G(ASUA("VLN"))+$G(ASUA("VLA")),ASUC("LN")=ASUC("LN")+8 I ASUC("LN")>(IOSL-5) D HEADER Q:$D(DUOUT)
- ..W !?10,"OPENING ACTIVE INVENTORY VALUE:",$J($FN($G(ASUA("VLA")),"T,",2),14),?64,"ACTIVE LI:",$J($FN($G(ASUA("LIA")),",",0),7)
- ..W !?27,"RECEIPT VALUE:",$J($FN($G(ASUC("VLR")),"T,",2),14),?62,"INACTIVE LI:",$J($FN($G(ASUA("LIN")),"",0),7)
- ..W !?29,"ISSUE VALUE:",$J($FN($G(ASUC("VLI")),"T,",2),14),?65,"TOTAL LI:",$J($FN(($G(ASUA("LIN"))+$G(ASUA("LIA"))),",",0),7)
- ..W !?24,"ADJUSTMENT VALUE:",$J($FN($G(ASUC("VLJ")),"T,",2),14)
- ..W !?16,"INACTIVE INVENTORY VALUE:",$J($FN($G(ASUA("VLN")),"T,",2),14)
- ..W !?17,"TOTAL CLOSING INVENTORY:",$J($FN($G(ASUC("VLGT")),"T,",2),14)
- ..S (ASUC("VLR"),ASUC("VLI"),ASUC("VLJ"),ASUC("VLGT"),ASUA("VLA"),ASUA("VL"))=0,ASUC("LN")=IOSL+1
- K ;
- K ASUX,ASUV,ASUC,ASUCX,ASUQ D PAZ^ASUURHDR I ASUK("PTRSEL")]"" W @IOF Q
- D C^ASUUZIS Q
- Q:$G(ASUX("AG"))']""
- S ASUC("PG")=$G(ASUC("PG"))+1 I ASUC("PG")>1 D PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
- W ?5,"REPORT #11. SAMS STOCK TRANSACTION REGISTER",?100,"DATE: ",ASUX("DT"),?120,"PAGE: ",ASUC("PG")
- W !?3,"AREA: ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")
- W !?3,"STATION: ",$G(ASUL(2,"STA","CD")),?15,$G(ASUL(2,"STA","NM")),?50,"ACCOUNT GROUP: ",$S(ASUX("AG")=1:"PHARMACY",ASUX("AG")=3:"SUBSISTENCE",1:"GENERAL SUPPLIES")
- W !!?3,"A",?5,"T",?7,"S",?17,"S",?51,"U",?55,"DATE",?63,"TR",?67,"QUANTITY",?80,"UNIT",?91,"TOTAL",?99,"DUE-IN",?108,"T",?118,"PO",?125,"USR CAT"
- W !?3,"C",?5,"Y",?7,"O",?9,"INDEX",?17,"L",?19,"DESCRIPTION",?51,"I",?63,"CD",?80,"COST",?91,"VALUE",?99,"QUANTITY",?108,"I",?110,"SUB",?114,"SUB",?118,"OR",?130,"CD"
- W !?3,"C",?5,"P",?7,"U",?9,"NUMBER",?17,"C",?33,"ORDER NUMBER",?53,"VOUCHER NO",?108,"R",?110,"ACT",?114,"STA",?118,"CAN"
- W !,"------------------------------------------------------------------------------------------------------------------------------------",!!
- S ASUC("LN")=9
- Q
- P8 ;WRITE DESCRIPTION LINES
- I '$D(ASUF("DESC")) S ASUF("DESC")=1
- I ASUF("DESC")>2 S ASUF("DESC")=ASUF("DESC")+1
- I ASUF("DESC")=2 W ?33,ASUV("NSN") S ASUF("DESC")=3
- I ASUF("DESC")=1 W ?19,$E(ASUMX("DESC"),31,60) S ASUF("DESC")=2
- Q
- CALCT ;
- S ASUN("E#")="" F S ASUN("E#")=$O(^XTMP("ASUMA",ASUX("AS"),ASUX("AG"),ASUN("E#"))) Q:ASUN("E#")="" D
- .S ASUA(0)=^XTMP("ASUMA",ASUX("AS"),ASUX("AG"),ASUN("E#"))
- .I $P(ASUA(0),U)="A" D
- ..S ASUA("LIA")=$G(ASUA("LIA"))+1,ASUA("VLA")=$G(ASUA("VLA"))+$P(ASUA(0),U,2)
- .E D
- ..S ASUA("LIN")=$G(ASUA("LIN"))+1,ASUA("VLN")=$G(ASUA("VLN"))+$P(ASUA(0),U,2)
- Q
- CMPT ;EP;COMPUTE CONTENTS
- K ^XTMP("ASUR","R11") S ^XTMP("ASUR","R11",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM"),ASUTX=0
- D:$G(ASUN("TYP"))']"" ^ASUURANG
- S ASUHDA=$G(ASUN("B#"))-1
- F S ASUHDA=$O(^ASUH(ASUHDA)) Q:ASUHDA>$G(ASUN("E#")) Q:ASUHDA'?1N.N D
- .Q:ASUHDA=0
- .D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']"" Q:$E(ASUT("TRCD"))="4" Q:$E(ASUT("TRCD"))="0" Q:ASUT="UNK"
- .S ^XTMP("ASUR","R11",ASUT(ASUT,"PT","STA"),ASUL(9,"ACG"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
- Q
- ASURD11P ; IHS/ITSC/LMH -RPT 11 DAILY TRANS REGISTER ; [ 07/17/2000 9:13 AM ]
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine formats and prints Daily Transaction Register
- EN ;EP;PRIMARY
- +1 IF '$DATA(IO)
- DO HOME^%ZIS
- IF '$DATA(DUZ(2))
- WRITE !,"Report must be run from Kernel option"
- QUIT
- +2 IF '$DATA(ASUL(1,"AR","AP"))
- DO SETAREA^ASULARST
- +3 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
- IF ASUK("PTRSEL")]""
- GOTO PSER
- +4 SET ZTRTN="PSER^ASURD11P"
- SET ZTDESC="SAMS RPT 11"
- DO O^ASUUZIS
- IF POP
- SET IOP=$IO
- DO ^%ZIS
- QUIT
- +5 IF ASUK(ASUK("PTR"),"Q")
- QUIT
- PSER ;EP;FOR TM Q
- +1 IF '$DATA(^XTMP("ASUR","R11"))
- DO CMPT
- DO U^ASUUZIS
- SET ASUV("RPT")="R11"
- SET ASUQ("HDR")="HEADER^ASURD11P"
- DO ^ASUUDATA
- IF ASUX("NDTA")
- GOTO K
- +2 SET ASUC("LN")=9
- +3 SET (ASUC("LI-TOT"),ASUC("VLR"),ASUC("VLI"),ASUC("VLJ"),ASUA("LIA"),ASUC("DEL"),ASUC("TOT"),ASUC("VALTOT"))=0
- +4 SET ASUX("AS")=0
- FOR
- SET ASUX("AS")=$ORDER(^XTMP("ASUR","R11",ASUX("AS")))
- IF ASUX("AS")=""
- QUIT
- Begin DoDot:1
- +5 IF ASUV("ARST")'=ASUX("AS")
- Begin DoDot:2
- +6 KILL ASUL(2)
- DO STA^ASULARST($EXTRACT(ASUX("AS"),3,4))
- SET ASUV("ARST")=ASUX("AS")
- End DoDot:2
- +7 SET ASUX("AG")=""
- FOR
- SET ASUX("AG")=$ORDER(^XTMP("ASUR","R11",ASUX("AS"),$GET(ASUX("AG"))))
- IF ASUX("AG")=""
- QUIT
- Begin DoDot:2
- +8 IF ASUC("LN")<(IOSL-2)
- WRITE !
- SET ASUC("LN")=ASUC("LN")+1
- +9 IF ASUC("LN")>(IOSL-3)
- DO HEADER^ASURD11P
- +10 KILL ASUA
- DO CALCT
- +11 SET ASUA("VL")=0
- +12 SET ASUX("IX")=""
- FOR
- SET ASUX("IX")=$ORDER(^XTMP("ASUR","R11",ASUX("AS"),ASUX("AG"),$GET(ASUX("IX"))))
- IF ASUX("IX")=""
- QUIT
- Begin DoDot:3
- +13 SET ASUA(0)=$GET(^XTMP("ASUMA",ASUX("AS"),ASUX("AG"),ASUX("IX")))
- +14 SET (ASUCX("QTT"),ASUA("QTY"))=$PIECE(ASUA(0),U,3)
- SET (ASUCX("VLT"),ASUA("VAL"))=$PIECE(ASUA(0),U,2)
- SET (ASUCX("QTDIT"),ASUA("QTDI"))=$PIECE(ASUA(0),U,4)
- +15 SET (ASUMS("E#","IDX"),ASUMX("E#","IDX"))=ASUX("IX")
- DO READ^ASUMXDIO
- DO ^ASUMSTRD
- +16 SET ASUC("LN")=ASUC("LN")+1
- WRITE !?3,ASUMX("ACC"),?5,ASUMS("EOQ","TP"),?7,ASUMS("SRC"),?9,$EXTRACT(ASUX("IX"),3,7),".",$EXTRACT(ASUX("IX"),8),?17,ASUMS("SLC")
- +17 SET X=$SELECT(ASUMX("DESC")]"":ASUMX("DESC"),1:ASUMX("DELDS"))
- WRITE ?19,$EXTRACT(X,1,30),?51,ASUMX("AR U/I"),?55,$EXTRACT(ASUMS("ESTB"),2,3),"-",$EXTRACT(ASUMS("ESTB"),4,5)
- +18 IF $GET(ASUT("TYPE"))'=1
- WRITE ?68,$JUSTIFY($FNUMBER(ASUA("QTY"),"T"),5)
- +19 WRITE ?75,$JUSTIFY($FNUMBER(ASUMS("CST/U"),"T",2),8),?89,$JUSTIFY($FNUMBER(ASUA("VAL"),"T",2),12)
- +20 WRITE ?101,$JUSTIFY($FNUMBER(ASUA("QTDI"),"T"),6),?131,ASUMX("CAT"),!
- +21 SET ASUCX("QTDIT")=$GET(ASUA("QTDI"))
- SET ASUF("DESC")=1
- +22 SET ASUV("NSN")=ASUMS("ORD#")
- IF ASUV("NSN")=$CHAR(32)!(ASUV("NSN")="")
- SET ASUV("NSN")=ASUMX("NSN")
- +23 IF $EXTRACT(ASUV("NSN"))'="M"
- SET ASUV("NSN")=$EXTRACT(ASUV("NSN"),1,4)_"-"_$EXTRACT(ASUV("NSN"),5,6)_"-"_$EXTRACT(ASUV("NSN"),7,9)_"-"_$EXTRACT(ASUV("NSN"),10,14)
- +24 SET ASUX("SQ")=""
- FOR
- SET ASUX("SQ")=$ORDER(^XTMP("ASUR","R11",ASUX("AS"),ASUX("AG"),ASUX("IX"),$GET(ASUX("SQ"))))
- IF ASUX("SQ")=""
- QUIT
- Begin DoDot:4
- +25 SET ASUHDA=^XTMP("ASUR","R11",ASUX("AS"),ASUX("AG"),ASUX("IX"),ASUX("SQ"))
- KILL ASUT
- DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- IF "4A4C5A5C"[ASUT("TRCD")
- QUIT
- +26 IF ASUC("LN")>(IOSL-5)
- DO HEADER^ASURD11P
- +27 SET ASUC("LI-TOT")=$GET(ASUC("LI-TOT"))+1
- SET ASUV("CST/U")=""
- +28 IF ASUT("TRCD")="5D"
- SET ASUCX("QTDIT")=0
- +29 IF $EXTRACT(ASUT("TRCD"))="1"
- Begin DoDot:5
- +30 SET ASUX("QTDI")=ASUT(ASUT,"QTY")*ASUT(ASUT,"SIGN")
- +31 IF ASUX("QTDI")=0
- Begin DoDot:6
- +32 SET (ASUX("QTDI"),ASUV("CST/U"))=0
- End DoDot:6
- +33 IF '$TEST
- Begin DoDot:6
- +34 SET ASUV("CST/U")=ASUT(ASUT,"VAL")/ASUX("QTDI")
- End DoDot:6
- End DoDot:5
- +35 IF '$TEST
- Begin DoDot:5
- +36 IF ASUT(ASUT,"QTY")=0!(ASUT(ASUT,"QTY")="")
- SET ASUV("CST/U")=ASUMS("LPP")
- +37 IF '$TEST
- SET ASUV("CST/U")=ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY")
- End DoDot:5
- +38 IF ASUV("CST/U")<0
- SET ASUV("CST/U")=ASUV("CST/U")*-1
- +39 IF "2K2M2N2O2P323334363731"[ASUT("TRCD")
- Begin DoDot:5
- +40 DO P8
- WRITE ?51,$GET(ASUT(ASUT,"U/I")),?52,ASUT(ASUT,"VOU")
- IF ASUT(ASUT,"QTY")=0
- SET ASUV("CST/U")=0
- +41 WRITE ?63,ASUT("TRCD"),$GET(ASUT(ASUT,"PST")),?68,$JUSTIFY($FNUMBER((ASUT(ASUT,"QTY")*-1),"T"),5),?75,$JUSTIFY($FNUMBER(ASUV("CST/U"),"T,",2),8)
- KILL X
- +42 IF ASUT(ASUT,"FPN")="P"
- WRITE ?88,"P"
- +43 WRITE ?89,$JUSTIFY($FNUMBER((ASUT(ASUT,"VAL")*-1),"T,",2),12)
- +44 SET ASUT(ASUT,"VAL")=ASUT(ASUT,"VAL")*-1
- SET ASUCX("VLT")=$GET(ASUCX("VLT"))+ASUT(ASUT,"VAL")
- +45 SET ASUCX("QTT")=$GET(ASUCX("QTT"))-ASUT(ASUT,"QTY")
- +46 IF "2K2M2N2O"[ASUT("TRCD")
- SET ASUC("VLR")=$GET(ASUC("VLR"))+ASUT(ASUT,"VAL")
- +47 IF "313332"[ASUT("TRCD")
- SET ASUC("VLI")=$GET(ASUC("VLI"))+ASUT(ASUT,"VAL")
- +48 IF "2P343637"[ASUT("TRCD")
- SET ASUC("VLJ")=$GET(ASUC("VLJ"))+ASUT(ASUT,"VAL")
- End DoDot:5
- +49 IF "22242526273K3L3M3O3P"[ASUT("TRCD")
- Begin DoDot:5
- +50 IF ASUT(ASUT,"SRC")]""
- WRITE ?7,$EXTRACT(ASUT(ASUT,"SRC"))
- DO P8
- WRITE $GET(ASUT(ASUT,"U/I")),?52,ASUT(ASUT,"VOU"),?63,ASUT("TRCD")
- +51 WRITE ?68,$JUSTIFY($FNUMBER(ASUT(ASUT,"QTY"),"T"),5)
- +52 WRITE ?75,$JUSTIFY($FNUMBER(ASUV("CST/U"),"T,",2),8)
- +53 IF ASUT(ASUT,"SRC")'=ASUMS("SRC")
- WRITE ?87,"*"
- +54 WRITE ?89,$JUSTIFY($FNUMBER(ASUT(ASUT,"VAL"),"T,",2),12)
- +55 IF $GET(ASUT(ASUT,"D/IF"))]""
- Begin DoDot:6
- +56 SET ASUX("QTDI")=ASUT(ASUT,"D/IF")
- IF ASUX("QTDI")=0
- SET ASUX("QTDI")=(ASUT(ASUT,"QTY")*ASUT(ASUT,"SIGN"))
- +57 WRITE ?101,$JUSTIFY($FNUMBER(ASUX("QTDI"),"T",0),6)
- SET ASUCX("QTDIT")=$GET(ASUCX("QTDIT"))+ASUX("QTDI")
- End DoDot:6
- +58 SET ASUX("QTDI")=0
- SET ASUCX("VLT")=$GET(ASUCX("VLT"))+ASUT(ASUT,"VAL")
- +59 SET ASUCX("QTT")=$GET(ASUCX("QTT"))+ASUT(ASUT,"QTY")
- +60 IF "22242526"[ASUT("TRCD")
- SET ASUC("VLR")=$GET(ASUC("VLR"))+ASUT(ASUT,"VAL")
- +61 IF "3K3L"[ASUT("TRCD")
- SET ASUC("VLI")=$GET(ASUC("VLI"))+ASUT(ASUT,"VAL")
- +62 IF "273P3M3O"[ASUT("TRCD")
- SET ASUC("VLJ")=$GET(ASUC("VLJ"))+ASUT(ASUT,"VAL")
- End DoDot:5
- +63 IF "121415161K1M1N1O"[ASUT("TRCD")
- Begin DoDot:5
- +64 WRITE ?7,$EXTRACT(ASUT(ASUT,"SRC"))
- DO P8
- WRITE ?51,$GET(ASUT(ASUT,"U/I"))
- +65 SET ASUT(ASUT,"VAL")=0
- +66 IF $LENGTH(ASUT(ASUT,"DTD"))>0&(ASUT(ASUT,"DTD")'=" ")
- WRITE ?52,$EXTRACT(ASUT(ASUT,"DTD"),4,5)_"-"_$EXTRACT(ASUT(ASUT,"DTD"),6,7)_"-"_$EXTRACT(ASUT(ASUT,"DTD"),2,3)
- +67 WRITE ?63,ASUT("TRCD")
- +68 ;W ?68,$J($FN(ASUT(ASUT,"QTY"),"T"),5)
- +69 WRITE ?75,$JUSTIFY($FNUMBER(ASUV("CST/U"),"T,",2),8)
- +70 ;S ASUCX("VLT")=$G(ASUCX("VLT"))+ASUT(ASUT,"VAL"),ASUCX("QTT")=$G(ASUCX("QTT"))+ASUT(ASUT,"QTY")
- +71 SET ASUCX("QTDIT")=$GET(ASUCX("QTDIT"))+ASUX("QTDI")
- +72 WRITE ?101,$JUSTIFY($FNUMBER(ASUX("QTDI"),"T"),6)
- End DoDot:5
- +73 IF ASUT("TRCD")="5D"
- Begin DoDot:5
- +74 WRITE ?55,ASUT(ASUT,"VOU"),?91,"ITEM DEL"
- SET (ASUCX("QTT"),ASUCX("QTDIT"),ASUCX("VLT"))=0
- End DoDot:5
- +75 WRITE ?108,$GET(ASUT(ASUT,"REQ TYP")),?110,$GET(ASUT(ASUT,"SSA"))
- +76 IF ASUT("TYPE")'=2
- WRITE ?113,$GET(ASUT(ASUT,"SST"))
- +77 WRITE ?116,$GET(ASUT(ASUT,"PON"))
- +78 IF ASUT("TYPE")'=2
- WRITE ?117,$GET(ASUT(ASUT,"CAN"))
- +79 IF ASUT("TYPE")>2
- WRITE ?126,$GET(ASUT(ASUT,"USR")),!
- +80 IF '$TEST
- WRITE !
- +81 SET ASUC("LN")=ASUC("LN")+1
- +82 IF ASUC("LN")>(IOSL-5)
- DO HEADER^ASURD11P
- End DoDot:4
- +83 IF ASUF("DESC")=1
- WRITE !?19,$EXTRACT(ASUMX("DESC"),31,60)
- SET ASUF("DESC")=2
- SET ASUC("LN")=ASUC("LN")+1
- +84 IF ASUF("DESC")=2
- WRITE !?33,ASUV("NSN")
- SET ASUF("DESC")=3
- SET ASUC("LN")=ASUC("LN")+1
- +85 ;S ASUCX("VLT")=$G(ASUCX("VLT"))+$G(ASUA("VL")),ASUCX("QTT")=$G(ASUCX("QTT"))+$G(ASUA("QTY"))
- +86 IF $GET(ASUCX("QTDIT"))<0
- SET ASUCX("QTDIT")=0
- +87 IF $GET(ASUCX("QTT"))<0
- SET ASUCX("QTT")=0
- +88 WRITE ?68,"______",?89,"___________",?102,"______",!?60,"TOTAL",?68,$JUSTIFY($FNUMBER(ASUCX("QTT"),"T",0),5),?89,$JUSTIFY($FNUMBER(ASUCX("VLT"),"T,",2),12),?101,$JUSTIFY(ASUCX("QTDIT"),6),?111,"PAMIQ=",ASUMS("PMIQ"),!
- +89 SET ASUC("LN")=ASUC("LN")+2
- KILL ASUCX
- End DoDot:3
- IF $DATA(DUOUT)
- QUIT
- +90 IF $DATA(DUOUT)
- QUIT
- +91 SET ASUC("VLGT")=ASUC("VLR")+ASUC("VLI")+ASUC("VLJ")+$GET(ASUA("VLN"))+$GET(ASUA("VLA"))
- SET ASUC("LN")=ASUC("LN")+8
- IF ASUC("LN")>(IOSL-5)
- DO HEADER
- IF $DATA(DUOUT)
- QUIT
- +92 WRITE !?10,"OPENING ACTIVE INVENTORY VALUE:",$JUSTIFY($FNUMBER($GET(ASUA("VLA")),"T,",2),14),?64,"ACTIVE LI:",$JUSTIFY($FNUMBER($GET(ASUA("LIA")),",",0),7)
- +93 WRITE !?27,"RECEIPT VALUE:",$JUSTIFY($FNUMBER($GET(ASUC("VLR")),"T,",2),14),?62,"INACTIVE LI:",$JUSTIFY($FNUMBER($GET(ASUA("LIN")),"",0),7)
- +94 WRITE !?29,"ISSUE VALUE:",$JUSTIFY($FNUMBER($GET(ASUC("VLI")),"T,",2),14),?65,"TOTAL LI:",$JUSTIFY($FNUMBER(($GET(ASUA("LIN"))+$GET(ASUA("LIA"))),",",0),7)
- +95 WRITE !?24,"ADJUSTMENT VALUE:",$JUSTIFY($FNUMBER($GET(ASUC("VLJ")),"T,",2),14)
- +96 WRITE !?16,"INACTIVE INVENTORY VALUE:",$JUSTIFY($FNUMBER($GET(ASUA("VLN")),"T,",2),14)
- +97 WRITE !?17,"TOTAL CLOSING INVENTORY:",$JUSTIFY($FNUMBER($GET(ASUC("VLGT")),"T,",2),14)
- +98 SET (ASUC("VLR"),ASUC("VLI"),ASUC("VLJ"),ASUC("VLGT"),ASUA("VLA"),ASUA("VL"))=0
- SET ASUC("LN")=IOSL+1
- End DoDot:2
- IF $DATA(DUOUT)
- QUIT
- End DoDot:1
- IF $DATA(DUOUT)
- QUIT
- K ;
- +1 KILL ASUX,ASUV,ASUC,ASUCX,ASUQ
- DO PAZ^ASUURHDR
- IF ASUK("PTRSEL")]""
- WRITE @IOF
- QUIT
- +2 DO C^ASUUZIS
- QUIT
- +1 IF $GET(ASUX("AG"))']""
- QUIT
- +2 SET ASUC("PG")=$GET(ASUC("PG"))+1
- IF ASUC("PG")>1
- DO PAZ^ASUURHDR
- IF $DATA(DUOUT)
- QUIT
- WRITE @IOF
- +3 WRITE ?5,"REPORT #11. SAMS STOCK TRANSACTION REGISTER",?100,"DATE: ",ASUX("DT"),?120,"PAGE: ",ASUC("PG")
- +4 WRITE !?3,"AREA: ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")
- +5 WRITE !?3,"STATION: ",$GET(ASUL(2,"STA","CD")),?15,$GET(ASUL(2,"STA","NM")),?50,"ACCOUNT GROUP: ",$SELECT(ASUX("AG")=1:"PHARMACY",ASUX("AG")=3:"SUBSISTENCE",1:"GENERAL SUPPLIES")
- +6 WRITE !!?3,"A",?5,"T",?7,"S",?17,"S",?51,"U",?55,"DATE",?63,"TR",?67,"QUANTITY",?80,"UNIT",?91,"TOTAL",?99,"DUE-IN",?108,"T",?118,"PO",?125,"USR CAT"
- +7 WRITE !?3,"C",?5,"Y",?7,"O",?9,"INDEX",?17,"L",?19,"DESCRIPTION",?51,"I",?63,"CD",?80,"COST",?91,"VALUE",?99,"QUANTITY",?108,"I",?110,"SUB",?114,"SUB",?118,"OR",?130,"CD"
- +8 WRITE !?3,"C",?5,"P",?7,"U",?9,"NUMBER",?17,"C",?33,"ORDER NUMBER",?53,"VOUCHER NO",?108,"R",?110,"ACT",?114,"STA",?118,"CAN"
- +9 WRITE !,"------------------------------------------------------------------------------------------------------------------------------------",!!
- +10 SET ASUC("LN")=9
- +11 QUIT
- P8 ;WRITE DESCRIPTION LINES
- +1 IF '$DATA(ASUF("DESC"))
- SET ASUF("DESC")=1
- +2 IF ASUF("DESC")>2
- SET ASUF("DESC")=ASUF("DESC")+1
- +3 IF ASUF("DESC")=2
- WRITE ?33,ASUV("NSN")
- SET ASUF("DESC")=3
- +4 IF ASUF("DESC")=1
- WRITE ?19,$EXTRACT(ASUMX("DESC"),31,60)
- SET ASUF("DESC")=2
- +5 QUIT
- CALCT ;
- +1 SET ASUN("E#")=""
- FOR
- SET ASUN("E#")=$ORDER(^XTMP("ASUMA",ASUX("AS"),ASUX("AG"),ASUN("E#")))
- IF ASUN("E#")=""
- QUIT
- Begin DoDot:1
- +2 SET ASUA(0)=^XTMP("ASUMA",ASUX("AS"),ASUX("AG"),ASUN("E#"))
- +3 IF $PIECE(ASUA(0),U)="A"
- Begin DoDot:2
- +4 SET ASUA("LIA")=$GET(ASUA("LIA"))+1
- SET ASUA("VLA")=$GET(ASUA("VLA"))+$PIECE(ASUA(0),U,2)
- End DoDot:2
- +5 IF '$TEST
- Begin DoDot:2
- +6 SET ASUA("LIN")=$GET(ASUA("LIN"))+1
- SET ASUA("VLN")=$GET(ASUA("VLN"))+$PIECE(ASUA(0),U,2)
- End DoDot:2
- End DoDot:1
- +7 QUIT
- CMPT ;EP;COMPUTE CONTENTS
- +1 KILL ^XTMP("ASUR","R11")
- SET ^XTMP("ASUR","R11",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- SET ASUTX=0
- +2 IF $GET(ASUN("TYP"))']""
- DO ^ASUURANG
- +3 SET ASUHDA=$GET(ASUN("B#"))-1
- +4 FOR
- SET ASUHDA=$ORDER(^ASUH(ASUHDA))
- IF ASUHDA>$GET(ASUN("E#"))
- QUIT
- IF ASUHDA'?1N.N
- QUIT
- Begin DoDot:1
- +5 IF ASUHDA=0
- QUIT
- +6 DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- IF $EXTRACT(ASUT("TRCD"))="4"
- QUIT
- IF $EXTRACT(ASUT("TRCD"))="0"
- QUIT
- IF ASUT="UNK"
- QUIT
- +7 SET ^XTMP("ASUR","R11",ASUT(ASUT,"PT","STA"),ASUL(9,"ACG"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
- End DoDot:1
- +8 QUIT
