Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ASUV5FS

ASUV5FS.m

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