ASUV5FS ; IHS/ITSC/LMH -RPT FACT SHEET ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine creates the Physical Inventory Fact Sheet Report
D ASUV5FS0
PRINT ;
D:'$D(DT) ^XBKVAR S %H=$H D YX^%DTC S ASUK("RUN","DT")=$P(Y,"@") K X,Y,%H
D:'$D(IO(0)) HOME^%ZIS
D CLS^ASUUHDG
S %DT="T",X="NOW" D ^%DT S ASUV("DT")=Y
I '$D(IO) D HOME^%ZIS
I '$D(DUZ(2)) W !,"Report must be run from Kernel option" G XIT0
I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
S ZTRTN="ASUV5FS4^ASUV5FS",ZTDESC="SAMS INVENTORY FACT SHEET LIST" D O^ASUUZIS
I POP S IOP=$I D ^%ZIS G XIT0
I ASUK(ASUK("PTR"),"Q") G XIT0
S ASUMV("E#","ASA")=ASUL(2,"STA","E#")
F S ASUMV("E#","ASA")=$O(^ASUV("FS",ASUMV("E#","ASA"))) Q:ASUMV("E#","ASA")']"" D ASUV5FS4
XIT0 ;
K ASUC,ASUR,ASUMV,ASUV
K DTOUT,DUOUT,DIR,DIC,X,Y,X1
D XK^ASUMXDIO
K IOP,POP,ZTDESC,ZTRTN,ZTSK
;I $D(ASUK("PTR")) K ASUK(ASUK("PTR")),ASUK("PTR"),ASUK("PTR-Q") ;CHG 3-15-95 CSC
D C^ASUUZIS
Q
ASUV5FS0 ;
K ^ASUV("FS")
S ASUMV("E#","ASA")=ASUL(2,"STA","E#")
F S ASUMV("E#","ASA")=$O(^ASUMV(ASUMV("E#","ASA"))) Q:ASUMV("E#","ASA")'?1N.N D
.D ACCOUNT^ASUV9IMR
.Q:ASUMV("MODE")'=4
.S ASUMV("E#","SLC")=0
.F S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N D
..D STORLOC^ASUV9IMR
..S ASUMV("E#","INDX")=0
..F S ASUMV("E#","INDX")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"))) Q:ASUMV("E#","INDX")'?1N.N D
...D INDEX^ASUV9IMR
...Q:ASUMV("IDX")["*" ;MASTER HAS BEEN DELETED
...S ASUV("CNT","LST")=$S(ASUMV("CNT","2ND"):ASUMV("CNT","2ND"),1:ASUMV("CNT","1ST"))
...S ASUV("ADJUST VAL")=$FN((ASUMV("QTY","DIF")*ASUMV("U/C")),"",2)
...S ASUV("VALMST")=$FN((ASUMV("QTY","STAM")*ASUMV("U/C")),"",2)
...S ASUV("VAL","1ST")=$FN(((ASUMV("CNT","1ST")-ASUMV("QTY","STAM"))*ASUMV("U/C")),"",2)
...S ASUV("VAL","2ND")=$FN(((ASUMV("CNT","2ND")-ASUMV("QTY","STAM"))*ASUMV("U/C")),"",2)
...I '$D(ASUA(ASUMV("E#","ASA"),0)) D
....F ASUMV("E#","TYPE")=0:1:8 S ASUA(ASUMV("E#","ASA"),ASUMV("E#","TYPE"))="0^0^0^0" I ASUMV("E#","TYPE")>2 D
.....F ASUU(12)=1:1:2 S ASUA(ASUMV("E#","ASA"),ASUMV("E#","TYPE"),ASUU(12))="0^0^0^0"
...S $P(ASUA(ASUMV("E#","ASA"),0),U)=$P(ASUA(ASUMV("E#","ASA"),0),U)+1
...S $P(ASUA(ASUMV("E#","ASA"),0),U,2)=$P(ASUA(ASUMV("E#","ASA"),0),U,2)+ASUV("VALMST")
...I ASUMV("QTY","STAM")=0,ASUMV("CNT","1ST")=0,ASUMV("CNT","2ND")>0 D ASUV5FS7 Q
...I ASUMV("CNT","1ST")=ASUMV("QTY","STAM") D
....S $P(ASUA(ASUMV("E#","ASA"),1),U)=$P(ASUA(ASUMV("E#","ASA"),1),U)+1
....S $P(ASUA(ASUMV("E#","ASA"),1),U,2)=$P(ASUA(ASUMV("E#","ASA"),1),U,2)+ASUV("VALMST")
...E D
....D ASUV5FS7
.D ASUV5FS6
K ASUU(12),ASUMV,ASUV
Q
ASUV5FS1 ;
HEADING ;
D CLS^ASUUHDG S ASUC("PG")=ASUC("PG")+1,ASUC("LN")=6
W "REPORT 37D INVENTORY FACT SHEET",?40,"DATE: ",ASUK("RUN","DT"),?70," PAGE: ",ASUC("PG")
W !,"AREA: ",ASUL(1,"AR","NM")
W !,"STAT: ",ASUL(2,"STA","NM")
W !,"ACCOUNT : ",ASUMV("ACC")," ",ASUL(9,"ACC","NM"),?25,"VOUCHER NO: ",ASUV("VOU"),?50,"INV. DATE: ",ASUV("DTPRNT")
D SEPERATE
Q
SEPERATE ;
W !,"_______________________________________________________________________________",!
Q
S ASUC("LN")=0
Q
ASUV5FS2 ;
S ASUV(ASUV("NOS"),"LI")=$P(ASUV(0),U)
S ASUV(ASUV("NOS"),"VAL")=$P(ASUV(0),U,2)
S ASUV(ASUV("NOS"),"LITM%")=$P(ASUV(0),U,3)
S ASUV(ASUV("NOS"),"VAL%")=$P(ASUV(0),U,4)
S ASUV(ASUV("NOS"),"VAL")=$FN(ASUV(ASUV("NOS"),"VAL"),"",2)
Q
ASUV5FS4 ;
D U^ASUUZIS
S (ASUC("PG"),ASUC("LN"))=0
D ACCOUNT^ASUV9IMR
S ASUV("VOU")=$E(ASUMV("VOU"),1,2)_"-"_$E(ASUMV("VOU"),3,4)_"-"_$E(ASUMV("VOU"),5,8)
S Y=ASUMV("INVBEG") X ^DD("DD") S ASUV("DTPRNT")=Y
D:ASUC("LN")<1 ASUV5FS1
F ASUMV("E#","TYPE")=0:1:8 D
.D:ASUC("LN")>59 FOOTING,ASUV5FS1
.S ASUV(0)=^ASUV("FS",ASUMV("E#","ASA"),ASUMV("E#","TYPE"))
.S ASUV("NOS")="NET" D ASUV5FS2
.S ASUV("LINE HEADING")=$P($T(TYPES+(ASUMV("E#","TYPE")+1)),";",3)
.W !?5,ASUV("LINE HEADING")
.S ASUC("LN")=ASUC("LN")+1
.I ASUMV("E#","TYPE")>3 D
..S ASUV(0)=^ASUV("FS",ASUMV("E#","ASA"),ASUMV("E#","TYPE"),1)
..S ASUV("NOS")="OVR" D ASUV5FS2
..W !?10,"OVERAGES",?20,"NO. LI: ",?32,$J(ASUV("OVR","LI"),6),?40,"VALUE: ",?50,$J(ASUV("OVR","VAL"),10)
..S ASUC("LN")=ASUC("LN")+1 Q:ASUMV("E#","TYPE")=1
..W !?10,"PERCENT OF ",$S(ASUMV("E#","TYPE")=3:"RECOUNTS",1:"TOT"),": ",?31,$J(ASUV("OVR","LITM%"),8),?53,$J(ASUV("OVR","VAL%"),8)
..S ASUV(0)=^ASUV("FS",ASUMV("E#","ASA"),ASUMV("E#","TYPE"),2)
..S ASUV("NOS")="SHT" D ASUV5FS2
..W !?10,"SHORTAGES",?20,"NO. LI: ",?32,$J(ASUV("SHT","LI"),6),?40,"VALUE: ",?50,$J(ASUV("SHT","VAL"),10)
..W !?10,"PERCENT OF ",$S(ASUMV("E#","TYPE")=3:"RECOUNTS",1:"TOT"),": ",?31,$J(ASUV("SHT","LITM%"),8),?53,$J(ASUV("SHT","VAL%"),8)
..W !?10,"NET PERCENTAGE: ",?31,$J(ASUV("NET","LITM%"),8),?53,$J(ASUV("NET","VAL%"),8)
..S ASUC("LN")=ASUC("LN")+5
.E D
..W !?20,"NO. LI: ",?32,$J(ASUV("NET","LI"),6),?40,"VALUE: ",?50,$J($FN(ASUV("NET","VAL"),",",2),10)
..S ASUC("LN")=ASUC("LN")+1 Q:ASUMV("E#","TYPE")=0
..W !?10,"PERCENT OF ",$S(ASUMV("E#","TYPE")=3:"RECOUNTS",1:"TOT"),": ",?31,$J(ASUV("NET","LITM%"),8),?53,$J(ASUV("NET","VAL%"),8)
..S ASUC("LN")=ASUC("LN")+2
.W !
.S ASUC("LN")=ASUC("LN")+1
D:ASUC("LN")>7 FOOTING
D CLS^ASUUHDG
Q
TYPES ;;COUNT TYPES
;;1. BEGINNING BALANCES
;;2. FIRST COUNT AGREEMENTS
;;3. INVENTORY RECOUNTS
;;4. SECOND COUNT AGREEMENTS WITH FIRST COUNT
;;5. ITEMS WITH QUANTITY DIFFERENCE OF ONE
;;6. ITEMS WITH ADJUSTMENT VALUE UNDER $25.00
;;7. INITIAL OVERAGES/SHORTAGES TO BE RESEARCHED
;;8. OVERAGES/SHORTAGES AFTER RESEARCH
;;9. TOTAL INVENTORY ADJUSTMENTS
ASUV5FS5 ;
S ASUV("VAL")=ASUV("VAL","LST"),ASUU(11)=1
I ASUV("DIFF")<0 S ASUV("VAL")=(ASUV("VAL")*-1),ASUU(11)=2
S $P(ASUA(ASUMV("E#","ASA"),ASUV("TYP"),ASUU(11)),U)=$P(ASUA(ASUMV("E#","ASA"),ASUV("TYP"),ASUU(11)),U)+1
S $P(ASUA(ASUMV("E#","ASA"),ASUV("TYP"),ASUU(11)),U,2)=$P(ASUA(ASUMV("E#","ASA"),ASUV("TYP"),ASUU(11)),U,2)+ASUV("VAL")
S $P(ASUA(ASUMV("E#","ASA"),ASUV("TYP")),U)=$P(ASUA(ASUMV("E#","ASA"),ASUV("TYP")),U)+1
S $P(ASUA(ASUMV("E#","ASA"),ASUV("TYP")),U,2)=$P(ASUA(ASUMV("E#","ASA"),ASUV("TYP")),U,2)+ASUV("VAL")
Q
ASUV5FS6 ;SET % IN EXTRACT
S ASUV("STA")=""
F S ASUV("STA")=$O(ASUA(ASUV("STA"))) Q:ASUV("STA")'?1N.N D
.D STA^ASULARST(ASUV("STA")) S ASUV("ASA")=""
.F S ASUV("ASA")=$O(ASUA(ASUV("ASA"))) Q:ASUV("ASA")'?1N.N D
..S ASUV("TYP")=""
..F S ASUV("TYP")=$O(ASUA(ASUV("ASA"),ASUV("TYP"))) Q:ASUV("TYP")'?1N.N D WRITE
K ASUV("TYS")
Q
WRITE ;
S ASUV("TYS")=$S(ASUV("TYP")=3:2,1:0)
I $P(ASUA(ASUV("ASA"),ASUV("TYS")),U)=0 S X=0 G SET11
I $P(ASUA(ASUV("ASA"),ASUV("TYP")),U)=0 S X=0 G SET11
S X=$P(ASUA(ASUV("ASA"),ASUV("TYP")),U)/$P(ASUA(ASUV("ASA"),ASUV("TYS")),U)
SET11 ;
S X=$FN((X*100),"",2)_"%"
S $P(ASUA(ASUV("ASA"),ASUV("TYP")),U,3)=X
I $P(ASUA(ASUV("ASA"),ASUV("TYS")),U,2)=0 S X=0 G SET12
I $P(ASUA(ASUV("ASA"),ASUV("TYP")),U,2)=0 S X=0 G SET12
S X=$P(ASUA(ASUV("ASA"),ASUV("TYP")),U,2)/$P(ASUA(ASUV("ASA"),ASUV("TYS")),U,2)
SET12 ;
S X=$FN((X*100),"",2)_"%"
S $P(ASUA(ASUV("ASA"),ASUV("TYP")),U,4)=X
S ^ASUV("FS",ASUV("ASA"),ASUV("TYP"))=ASUA(ASUV("ASA"),ASUV("TYP"))
Q:ASUV("TYP")<4
I $P(ASUA(ASUV("ASA"),0),U)=0 S X=0 G SET21
I $P(ASUA(ASUV("ASA"),ASUV("TYP"),1),U)=0 S X=0 G SET21
S X=$P(ASUA(ASUV("ASA"),ASUV("TYP"),1),U)/$P(ASUA(ASUV("ASA"),0),U)
SET21 ;
S X=$FN((X*100),"",2)_"%"
S $P(ASUA(ASUV("ASA"),ASUV("TYP"),1),U,3)=X
I $P(ASUA(ASUV("ASA"),0),U,2)=0 S X=0 G SET22
I $P(ASUA(ASUV("ASA"),ASUV("TYP"),1),U,2)=0 S X=0 G SET22
S X=$P(ASUA(ASUV("ASA"),ASUV("TYP"),1),U,2)/$P(ASUA(ASUV("ASA"),0),U,2)
SET22 ;
S X=$FN((X*100),"",2)_"%"
S $P(ASUA(ASUV("ASA"),ASUV("TYP"),1),U,4)=X
S ^ASUV("FS",ASUV("ASA"),ASUV("TYP"),1)=ASUA(ASUV("ASA"),ASUV("TYP"),1)
I $P(ASUA(ASUV("ASA"),0),U)=0 S X=0 G SET31
I $P(ASUA(ASUV("ASA"),ASUV("TYP"),2),U)=0 S X=0 G SET31
S X=$P(ASUA(ASUV("ASA"),ASUV("TYP"),2),U)/$P(ASUA(ASUV("ASA"),0),U)
SET31 ;
S X=$FN((X*100),"",2)_"%"
S $P(ASUA(ASUV("ASA"),ASUV("TYP"),2),U,3)=X
I $P(ASUA(ASUV("ASA"),0),U,2)=0 S X=0 G SET32
I $P(ASUA(ASUV("ASA"),ASUV("TYP"),2),U,2)=0 S X=0 G SET32
S X=$P(ASUA(ASUV("ASA"),ASUV("TYP"),2),U,2)/$P(ASUA(ASUV("ASA"),0),U,2)
SET32 ;
S X=$FN((X*100),"",2)_"%"
S $P(ASUA(ASUV("ASA"),ASUV("TYP"),2),U,4)=X
S ^ASUV("FS",ASUV("ASA"),ASUV("TYP"),2)=ASUA(ASUV("ASA"),ASUV("TYP"),2)
Q
ASUV5FS7 ;
S $P(ASUA(ASUMV("E#","ASA"),2),U)=$P(ASUA(ASUMV("E#","ASA"),2),U)+1
S $P(ASUA(ASUMV("E#","ASA"),2),U,2)=$P(ASUA(ASUMV("E#","ASA"),2),U,2)+ASUV("VALMST")
I ASUMV("CNT","1ST")=ASUMV("CNT","2ND") D
.S $P(ASUA(ASUMV("E#","ASA"),3),U)=$P(ASUA(ASUMV("E#","ASA"),3),U)+1
.S $P(ASUA(ASUMV("E#","ASA"),3),U,2)=$P(ASUA(ASUMV("E#","ASA"),3),U,2)+ASUV("VALMST")
I ASUMV("CNT","2ND")'=ASUMV("QTY","STAM") D
.S ASUV("VAL","LST")=$S(ASUMV("CNT","2ND")]"":ASUV("VAL","2ND"),1:ASUV("VAL","1ST"))
.S ASUV("ADJQTY")=ASUMV("QTY","STAM")-ASUV("CNT","LST")
.I ASUV("ADJQTY")=1!(ASUV("ADJQTY")=-1) D
..S ASUV("DIFF")=ASUMV("QTY","DIF"),ASUV("TYP")=4 D ASUV5FS5
.E D
..S X=ASUMV("U/C")*(ASUV("CNT","LST")-ASUMV("QTY","STAM")) S:X<0 X=X*-1
..I X>25 D
...S ASUV("DIFF")=ASUV("CNT","LST")-ASUMV("QTY","STAM"),ASUV("TYP")=6 D ASUV5FS5
...I ASUMV("QTY","DIF")'=0 S ASUV("DIFF")=ASUMV("QTY","DIF") F ASUV("TYP")=7,8 D ASUV5FS5
..E D
...S ASUV("DIFF")=ASUMV("QTY","DIF"),ASUV("TYP")=5 D ASUV5FS5
..I ASUMV("QTY","DIF")'=0 S ASUV("DIFF")=ASUMV("QTY","DIF"),ASUV("TYP")=8 D ASUV5FS5
Q
ASUV5FS ; IHS/ITSC/LMH -RPT FACT SHEET ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine creates the Physical Inventory Fact Sheet Report
+3 DO ASUV5FS0
PRINT ;
+1 IF '$DATA(DT)
DO ^XBKVAR
SET %H=$HOROLOG
DO YX^%DTC
SET ASUK("RUN","DT")=$PIECE(Y,"@")
KILL X,Y,%H
+2 IF '$DATA(IO(0))
DO HOME^%ZIS
+3 DO CLS^ASUUHDG
+4 SET %DT="T"
SET X="NOW"
DO ^%DT
SET ASUV("DT")=Y
+5 IF '$DATA(IO)
DO HOME^%ZIS
+6 IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
GOTO XIT0
+7 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+8 SET ZTRTN="ASUV5FS4^ASUV5FS"
SET ZTDESC="SAMS INVENTORY FACT SHEET LIST"
DO O^ASUUZIS
+9 IF POP
SET IOP=$IO
DO ^%ZIS
GOTO XIT0
+10 IF ASUK(ASUK("PTR"),"Q")
GOTO XIT0
+11 SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")
+12 FOR
SET ASUMV("E#","ASA")=$ORDER(^ASUV("FS",ASUMV("E#","ASA")))
IF ASUMV("E#","ASA")']""
QUIT
DO ASUV5FS4
XIT0 ;
+1 KILL ASUC,ASUR,ASUMV,ASUV
+2 KILL DTOUT,DUOUT,DIR,DIC,X,Y,X1
+3 DO XK^ASUMXDIO
+4 KILL IOP,POP,ZTDESC,ZTRTN,ZTSK
+5 ;I $D(ASUK("PTR")) K ASUK(ASUK("PTR")),ASUK("PTR"),ASUK("PTR-Q") ;CHG 3-15-95 CSC
+6 DO C^ASUUZIS
+7 QUIT
ASUV5FS0 ;
+1 KILL ^ASUV("FS")
+2 SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")
+3 FOR
SET ASUMV("E#","ASA")=$ORDER(^ASUMV(ASUMV("E#","ASA")))
IF ASUMV("E#","ASA")'?1N.N
QUIT
Begin DoDot:1
+4 DO ACCOUNT^ASUV9IMR
+5 IF ASUMV("MODE")'=4
QUIT
+6 SET ASUMV("E#","SLC")=0
+7 FOR
SET ASUMV("E#","SLC")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC")))
IF ASUMV("E#","SLC")'?1N.N
QUIT
Begin DoDot:2
+8 DO STORLOC^ASUV9IMR
+9 SET ASUMV("E#","INDX")=0
+10 FOR
SET ASUMV("E#","INDX")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX")))
IF ASUMV("E#","INDX")'?1N.N
QUIT
Begin DoDot:3
+11 DO INDEX^ASUV9IMR
+12 ;MASTER HAS BEEN DELETED
IF ASUMV("IDX")["*"
QUIT
+13 SET ASUV("CNT","LST")=$SELECT(ASUMV("CNT","2ND"):ASUMV("CNT","2ND"),1:ASUMV("CNT","1ST"))
+14 SET ASUV("ADJUST VAL")=$FNUMBER((ASUMV("QTY","DIF")*ASUMV("U/C")),"",2)
+15 SET ASUV("VALMST")=$FNUMBER((ASUMV("QTY","STAM")*ASUMV("U/C")),"",2)
+16 SET ASUV("VAL","1ST")=$FNUMBER(((ASUMV("CNT","1ST")-ASUMV("QTY","STAM"))*ASUMV("U/C")),"",2)
+17 SET ASUV("VAL","2ND")=$FNUMBER(((ASUMV("CNT","2ND")-ASUMV("QTY","STAM"))*ASUMV("U/C")),"",2)
+18 IF '$DATA(ASUA(ASUMV("E#","ASA"),0))
Begin DoDot:4
+19 FOR ASUMV("E#","TYPE")=0:1:8
SET ASUA(ASUMV("E#","ASA"),ASUMV("E#","TYPE"))="0^0^0^0"
IF ASUMV("E#","TYPE")>2
Begin DoDot:5
+20 FOR ASUU(12)=1:1:2
SET ASUA(ASUMV("E#","ASA"),ASUMV("E#","TYPE"),ASUU(12))="0^0^0^0"
End DoDot:5
End DoDot:4
+21 SET $PIECE(ASUA(ASUMV("E#","ASA"),0),U)=$PIECE(ASUA(ASUMV("E#","ASA"),0),U)+1
+22 SET $PIECE(ASUA(ASUMV("E#","ASA"),0),U,2)=$PIECE(ASUA(ASUMV("E#","ASA"),0),U,2)+ASUV("VALMST")
+23 IF ASUMV("QTY","STAM")=0
IF ASUMV("CNT","1ST")=0
IF ASUMV("CNT","2ND")>0
DO ASUV5FS7
QUIT
+24 IF ASUMV("CNT","1ST")=ASUMV("QTY","STAM")
Begin DoDot:4
+25 SET $PIECE(ASUA(ASUMV("E#","ASA"),1),U)=$PIECE(ASUA(ASUMV("E#","ASA"),1),U)+1
+26 SET $PIECE(ASUA(ASUMV("E#","ASA"),1),U,2)=$PIECE(ASUA(ASUMV("E#","ASA"),1),U,2)+ASUV("VALMST")
End DoDot:4
+27 IF '$TEST
Begin DoDot:4
+28 DO ASUV5FS7
End DoDot:4
End DoDot:3
End DoDot:2
+29 DO ASUV5FS6
End DoDot:1
+30 KILL ASUU(12),ASUMV,ASUV
+31 QUIT
ASUV5FS1 ;
HEADING ;
+1 DO CLS^ASUUHDG
SET ASUC("PG")=ASUC("PG")+1
SET ASUC("LN")=6
+2 WRITE "REPORT 37D INVENTORY FACT SHEET",?40,"DATE: ",ASUK("RUN","DT"),?70," PAGE: ",ASUC("PG")
+3 WRITE !,"AREA: ",ASUL(1,"AR","NM")
+4 WRITE !,"STAT: ",ASUL(2,"STA","NM")
+5 WRITE !,"ACCOUNT : ",ASUMV("ACC")," ",ASUL(9,"ACC","NM"),?25,"VOUCHER NO: ",ASUV("VOU"),?50,"INV. DATE: ",ASUV("DTPRNT")
+6 DO SEPERATE
+7 QUIT
SEPERATE ;
+1 WRITE !,"_______________________________________________________________________________",!
+2 QUIT
+1 SET ASUC("LN")=0
+2 QUIT
ASUV5FS2 ;
+1 SET ASUV(ASUV("NOS"),"LI")=$PIECE(ASUV(0),U)
+2 SET ASUV(ASUV("NOS"),"VAL")=$PIECE(ASUV(0),U,2)
+3 SET ASUV(ASUV("NOS"),"LITM%")=$PIECE(ASUV(0),U,3)
+4 SET ASUV(ASUV("NOS"),"VAL%")=$PIECE(ASUV(0),U,4)
+5 SET ASUV(ASUV("NOS"),"VAL")=$FNUMBER(ASUV(ASUV("NOS"),"VAL"),"",2)
+6 QUIT
ASUV5FS4 ;
+1 DO U^ASUUZIS
+2 SET (ASUC("PG"),ASUC("LN"))=0
+3 DO ACCOUNT^ASUV9IMR
+4 SET ASUV("VOU")=$EXTRACT(ASUMV("VOU"),1,2)_"-"_$EXTRACT(ASUMV("VOU"),3,4)_"-"_$EXTRACT(ASUMV("VOU"),5,8)
+5 SET Y=ASUMV("INVBEG")
XECUTE ^DD("DD")
SET ASUV("DTPRNT")=Y
+6 IF ASUC("LN")<1
DO ASUV5FS1
+7 FOR ASUMV("E#","TYPE")=0:1:8
Begin DoDot:1
+8 IF ASUC("LN")>59
DO FOOTING
DO ASUV5FS1
+9 SET ASUV(0)=^ASUV("FS",ASUMV("E#","ASA"),ASUMV("E#","TYPE"))
+10 SET ASUV("NOS")="NET"
DO ASUV5FS2
+11 SET ASUV("LINE HEADING")=$PIECE($TEXT(TYPES+(ASUMV("E#","TYPE")+1)),";",3)
+12 WRITE !?5,ASUV("LINE HEADING")
+13 SET ASUC("LN")=ASUC("LN")+1
+14 IF ASUMV("E#","TYPE")>3
Begin DoDot:2
+15 SET ASUV(0)=^ASUV("FS",ASUMV("E#","ASA"),ASUMV("E#","TYPE"),1)
+16 SET ASUV("NOS")="OVR"
DO ASUV5FS2
+17 WRITE !?10,"OVERAGES",?20,"NO. LI: ",?32,$JUSTIFY(ASUV("OVR","LI"),6),?40,"VALUE: ",?50,$JUSTIFY(ASUV("OVR","VAL"),10)
+18 SET ASUC("LN")=ASUC("LN")+1
IF ASUMV("E#","TYPE")=1
QUIT
+19 WRITE !?10,"PERCENT OF ",$SELECT(ASUMV("E#","TYPE")=3:"RECOUNTS",1:"TOT"),": ",?31,$JUSTIFY(ASUV("OVR","LITM%"),8),?53,$JUSTIFY(ASUV("OVR","VAL%"),8)
+20 SET ASUV(0)=^ASUV("FS",ASUMV("E#","ASA"),ASUMV("E#","TYPE"),2)
+21 SET ASUV("NOS")="SHT"
DO ASUV5FS2
+22 WRITE !?10,"SHORTAGES",?20,"NO. LI: ",?32,$JUSTIFY(ASUV("SHT","LI"),6),?40,"VALUE: ",?50,$JUSTIFY(ASUV("SHT","VAL"),10)
+23 WRITE !?10,"PERCENT OF ",$SELECT(ASUMV("E#","TYPE")=3:"RECOUNTS",1:"TOT"),": ",?31,$JUSTIFY(ASUV("SHT","LITM%"),8),?53,$JUSTIFY(ASUV("SHT","VAL%"),8)
+24 WRITE !?10,"NET PERCENTAGE: ",?31,$JUSTIFY(ASUV("NET","LITM%"),8),?53,$JUSTIFY(ASUV("NET","VAL%"),8)
+25 SET ASUC("LN")=ASUC("LN")+5
End DoDot:2
+26 IF '$TEST
Begin DoDot:2
+27 WRITE !?20,"NO. LI: ",?32,$JUSTIFY(ASUV("NET","LI"),6),?40,"VALUE: ",?50,$JUSTIFY($FNUMBER(ASUV("NET","VAL"),",",2),10)
+28 SET ASUC("LN")=ASUC("LN")+1
IF ASUMV("E#","TYPE")=0
QUIT
+29 WRITE !?10,"PERCENT OF ",$SELECT(ASUMV("E#","TYPE")=3:"RECOUNTS",1:"TOT"),": ",?31,$JUSTIFY(ASUV("NET","LITM%"),8),?53,$JUSTIFY(ASUV("NET","VAL%"),8)
+30 SET ASUC("LN")=ASUC("LN")+2
End DoDot:2
+31 WRITE !
+32 SET ASUC("LN")=ASUC("LN")+1
End DoDot:1
+33 IF ASUC("LN")>7
DO FOOTING
+34 DO CLS^ASUUHDG
+35 QUIT
TYPES ;;COUNT TYPES
+1 ;;1. BEGINNING BALANCES
+2 ;;2. FIRST COUNT AGREEMENTS
+3 ;;3. INVENTORY RECOUNTS
+4 ;;4. SECOND COUNT AGREEMENTS WITH FIRST COUNT
+5 ;;5. ITEMS WITH QUANTITY DIFFERENCE OF ONE
+6 ;;6. ITEMS WITH ADJUSTMENT VALUE UNDER $25.00
+7 ;;7. INITIAL OVERAGES/SHORTAGES TO BE RESEARCHED
+8 ;;8. OVERAGES/SHORTAGES AFTER RESEARCH
+9 ;;9. TOTAL INVENTORY ADJUSTMENTS
ASUV5FS5 ;
+1 SET ASUV("VAL")=ASUV("VAL","LST")
SET ASUU(11)=1
+2 IF ASUV("DIFF")<0
SET ASUV("VAL")=(ASUV("VAL")*-1)
SET ASUU(11)=2
+3 SET $PIECE(ASUA(ASUMV("E#","ASA"),ASUV("TYP"),ASUU(11)),U)=$PIECE(ASUA(ASUMV("E#","ASA"),ASUV("TYP"),ASUU(11)),U)+1
+4 SET $PIECE(ASUA(ASUMV("E#","ASA"),ASUV("TYP"),ASUU(11)),U,2)=$PIECE(ASUA(ASUMV("E#","ASA"),ASUV("TYP"),ASUU(11)),U,2)+ASUV("VAL")
+5 SET $PIECE(ASUA(ASUMV("E#","ASA"),ASUV("TYP")),U)=$PIECE(ASUA(ASUMV("E#","ASA"),ASUV("TYP")),U)+1
+6 SET $PIECE(ASUA(ASUMV("E#","ASA"),ASUV("TYP")),U,2)=$PIECE(ASUA(ASUMV("E#","ASA"),ASUV("TYP")),U,2)+ASUV("VAL")
+7 QUIT
ASUV5FS6 ;SET % IN EXTRACT
+1 SET ASUV("STA")=""
+2 FOR
SET ASUV("STA")=$ORDER(ASUA(ASUV("STA")))
IF ASUV("STA")'?1N.N
QUIT
Begin DoDot:1
+3 DO STA^ASULARST(ASUV("STA"))
SET ASUV("ASA")=""
+4 FOR
SET ASUV("ASA")=$ORDER(ASUA(ASUV("ASA")))
IF ASUV("ASA")'?1N.N
QUIT
Begin DoDot:2
+5 SET ASUV("TYP")=""
+6 FOR
SET ASUV("TYP")=$ORDER(ASUA(ASUV("ASA"),ASUV("TYP")))
IF ASUV("TYP")'?1N.N
QUIT
DO WRITE
End DoDot:2
End DoDot:1
+7 KILL ASUV("TYS")
+8 QUIT
WRITE ;
+1 SET ASUV("TYS")=$SELECT(ASUV("TYP")=3:2,1:0)
+2 IF $PIECE(ASUA(ASUV("ASA"),ASUV("TYS")),U)=0
SET X=0
GOTO SET11
+3 IF $PIECE(ASUA(ASUV("ASA"),ASUV("TYP")),U)=0
SET X=0
GOTO SET11
+4 SET X=$PIECE(ASUA(ASUV("ASA"),ASUV("TYP")),U)/$PIECE(ASUA(ASUV("ASA"),ASUV("TYS")),U)
SET11 ;
+1 SET X=$FNUMBER((X*100),"",2)_"%"
+2 SET $PIECE(ASUA(ASUV("ASA"),ASUV("TYP")),U,3)=X
+3 IF $PIECE(ASUA(ASUV("ASA"),ASUV("TYS")),U,2)=0
SET X=0
GOTO SET12
+4 IF $PIECE(ASUA(ASUV("ASA"),ASUV("TYP")),U,2)=0
SET X=0
GOTO SET12
+5 SET X=$PIECE(ASUA(ASUV("ASA"),ASUV("TYP")),U,2)/$PIECE(ASUA(ASUV("ASA"),ASUV("TYS")),U,2)
SET12 ;
+1 SET X=$FNUMBER((X*100),"",2)_"%"
+2 SET $PIECE(ASUA(ASUV("ASA"),ASUV("TYP")),U,4)=X
+3 SET ^ASUV("FS",ASUV("ASA"),ASUV("TYP"))=ASUA(ASUV("ASA"),ASUV("TYP"))
+4 IF ASUV("TYP")<4
QUIT
+5 IF $PIECE(ASUA(ASUV("ASA"),0),U)=0
SET X=0
GOTO SET21
+6 IF $PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),1),U)=0
SET X=0
GOTO SET21
+7 SET X=$PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),1),U)/$PIECE(ASUA(ASUV("ASA"),0),U)
SET21 ;
+1 SET X=$FNUMBER((X*100),"",2)_"%"
+2 SET $PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),1),U,3)=X
+3 IF $PIECE(ASUA(ASUV("ASA"),0),U,2)=0
SET X=0
GOTO SET22
+4 IF $PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),1),U,2)=0
SET X=0
GOTO SET22
+5 SET X=$PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),1),U,2)/$PIECE(ASUA(ASUV("ASA"),0),U,2)
SET22 ;
+1 SET X=$FNUMBER((X*100),"",2)_"%"
+2 SET $PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),1),U,4)=X
+3 SET ^ASUV("FS",ASUV("ASA"),ASUV("TYP"),1)=ASUA(ASUV("ASA"),ASUV("TYP"),1)
+4 IF $PIECE(ASUA(ASUV("ASA"),0),U)=0
SET X=0
GOTO SET31
+5 IF $PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),2),U)=0
SET X=0
GOTO SET31
+6 SET X=$PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),2),U)/$PIECE(ASUA(ASUV("ASA"),0),U)
SET31 ;
+1 SET X=$FNUMBER((X*100),"",2)_"%"
+2 SET $PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),2),U,3)=X
+3 IF $PIECE(ASUA(ASUV("ASA"),0),U,2)=0
SET X=0
GOTO SET32
+4 IF $PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),2),U,2)=0
SET X=0
GOTO SET32
+5 SET X=$PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),2),U,2)/$PIECE(ASUA(ASUV("ASA"),0),U,2)
SET32 ;
+1 SET X=$FNUMBER((X*100),"",2)_"%"
+2 SET $PIECE(ASUA(ASUV("ASA"),ASUV("TYP"),2),U,4)=X
+3 SET ^ASUV("FS",ASUV("ASA"),ASUV("TYP"),2)=ASUA(ASUV("ASA"),ASUV("TYP"),2)
+4 QUIT
ASUV5FS7 ;
+1 SET $PIECE(ASUA(ASUMV("E#","ASA"),2),U)=$PIECE(ASUA(ASUMV("E#","ASA"),2),U)+1
+2 SET $PIECE(ASUA(ASUMV("E#","ASA"),2),U,2)=$PIECE(ASUA(ASUMV("E#","ASA"),2),U,2)+ASUV("VALMST")
+3 IF ASUMV("CNT","1ST")=ASUMV("CNT","2ND")
Begin DoDot:1
+4 SET $PIECE(ASUA(ASUMV("E#","ASA"),3),U)=$PIECE(ASUA(ASUMV("E#","ASA"),3),U)+1
+5 SET $PIECE(ASUA(ASUMV("E#","ASA"),3),U,2)=$PIECE(ASUA(ASUMV("E#","ASA"),3),U,2)+ASUV("VALMST")
End DoDot:1
+6 IF ASUMV("CNT","2ND")'=ASUMV("QTY","STAM")
Begin DoDot:1
+7 SET ASUV("VAL","LST")=$SELECT(ASUMV("CNT","2ND")]"":ASUV("VAL","2ND"),1:ASUV("VAL","1ST"))
+8 SET ASUV("ADJQTY")=ASUMV("QTY","STAM")-ASUV("CNT","LST")
+9 IF ASUV("ADJQTY")=1!(ASUV("ADJQTY")=-1)
Begin DoDot:2
+10 SET ASUV("DIFF")=ASUMV("QTY","DIF")
SET ASUV("TYP")=4
DO ASUV5FS5
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 SET X=ASUMV("U/C")*(ASUV("CNT","LST")-ASUMV("QTY","STAM"))
IF X<0
SET X=X*-1
+13 IF X>25
Begin DoDot:3
+14 SET ASUV("DIFF")=ASUV("CNT","LST")-ASUMV("QTY","STAM")
SET ASUV("TYP")=6
DO ASUV5FS5
+15 IF ASUMV("QTY","DIF")'=0
SET ASUV("DIFF")=ASUMV("QTY","DIF")
FOR ASUV("TYP")=7,8
DO ASUV5FS5
End DoDot:3
+16 IF '$TEST
Begin DoDot:3
+17 SET ASUV("DIFF")=ASUMV("QTY","DIF")
SET ASUV("TYP")=5
DO ASUV5FS5
End DoDot:3
+18 IF ASUMV("QTY","DIF")'=0
SET ASUV("DIFF")=ASUMV("QTY","DIF")
SET ASUV("TYP")=8
DO ASUV5FS5
End DoDot:2
End DoDot:1
+19 QUIT
