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

PRCPRDIS.m

Go to the documentation of this file.
  1. PRCPRDIS ;WISC/CC-supply station quantity discrepancy report ;4/00
  1. V ;;5.1;IFCAP;**1,24**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. I '$D(PRCP("DPTYPE")) S PRCP("DPTYPE")="S"
  1. D ^PRCPUSEL Q:'$G(PRCP("I"))
  1. I PRCP("DPTYPE")'="S" Q
  1. I $P($G(^PRCP(445,PRCP("I"),5)),"^",1)']"" Q
  1. ;
  1. N %,I,INVPT,PRCPINNM,X,XP,XH,Y
  1. S INVPT=PRCP("I"),PRCPINNM=$$INVNAME^PRCPUX1(INVPT)
  1. ;
  1. K X S X(1)="This report displays items whose on-hand quantity in "_PRCPINNM_" differs from the supply station's on-hand amount"
  1. D DISPLAY^PRCPUX2(40,79,.X)
  1. ;
  1. K X
  1. S Y=$P($G(^PRCP(445,PRCP("I"),6)),"^",1)
  1. I Y']"" S X(1)="No QOH information was ever received. It is recommended you request a QOH update."
  1. I Y]"" D
  1. . X ^DD("DD")
  1. . S I=$P(Y,"@",1),Y=$P(Y,"@",2,99)
  1. . S X(1)="The Last QOH update was received on "_I
  1. . I Y]"" S X(1)=X(1)_" at "_Y_"."
  1. . S X(2)="If this date is too old, you may now request an update."
  1. D DISPLAY^PRCPUX2(2,40,.X)
  1. S XP="Do you want to request a refresh of the supply station QOH"
  1. S XH(1)="Enter YES to request the supply station send a QOH update to GIP,"
  1. S XH(2)="Enter NO to continue with the report using what has already been received,"
  1. S XH(3)="Enter '^' to exit."
  1. S %=$$YN^PRCPUYN(2) I '% Q
  1. I %'=1,%'=2 Q
  1. I %=1 D Q
  1. . W !
  1. . D EN^DDIOL("Sending request...")
  1. . D EN^DDIOL("Please give GIP time to get the information before printing the report.")
  1. . D BLDSEG^PRCPHLQU(INVPT)
  1. ;
  1. W ! S %ZIS="Q" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
  1. . S ZTDESC="Item discrepancy report",ZTRTN="PRINT^PRCPRDIS"
  1. . S ZTSAVE("PRCP*")=""
  1. W !!,"<*> please wait <*>"
  1. ;
  1. PRINT N %,GIPCNT,INVPT,ITEM,NOW,PAGE,REFILL,SCREEN,SSCNT,X,Y
  1. D NOW^%DTC S Y=% D DD^%DT S NOW=Y
  1. S PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
  1. S INVPT=PRCP("I")
  1. S ITEM=0
  1. F S ITEM=$O(^PRCP(445,INVPT,1,ITEM)) Q:'+ITEM D I $D(PRCPFLAG) Q
  1. . I $P($G(^PRCP(445,INVPT,1,ITEM,0)),"^",9)<1 Q ; not a SS item
  1. . S GIPCNT=$P($G(^PRCP(445,INVPT,1,ITEM,0)),"^",7)
  1. . S SSCNT=$P($G(^PRCP(445,INVPT,1,ITEM,9)),"^",1)
  1. . I 'GIPCNT,'SSCNT Q
  1. . I GIPCNT=SSCNT Q
  1. . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
  1. . ; W !,$J(ITEM,7)," ",$P($G(^PRCP(445,INVPT,1,ITEM,6)),"^",1)
  1. . ; W !,"GIP: ",$J(GIPCNT,7)," SUPPLY STATION: ",$J(SSCNT,7)
  1. . W $J(GIPCNT,7)," ",$J(SSCNT,7)
  1. . S Y=$P($G(^PRCP(445,INVPT,1,ITEM,9)),"^",2)
  1. . I Y']"" W " "
  1. . I Y]"" D
  1. . . X ^DD("DD")
  1. . . W $J(" ("_Y_")",23)
  1. . W " ",$J(ITEM,7)," ",$E($P($G(^PRCP(445,INVPT,1,ITEM,6)),"^",1),1,32)
  1. . S REFILL=$$REFILLS(ITEM,INVPT) I REFILL]"" W !,?8,REFILL
  1. . W !
  1. ;
  1. I '$G(PRCPFLAG) D END^PRCPUREP
  1. D ^%ZISC Q
  1. ;
  1. REFILLS(ITEMDA,PRCPINPT) ; is the item refilled in an unposted order
  1. ; ITEMDA = DA of item
  1. ; PRCPINT = DA of inventory point
  1. ;
  1. N ORD,OUTORD,PRIMVN,REFILL,X
  1. S ORD=0,OUTORD=0,REFILL=""
  1. F S ORD=$O(^PRCP(445.3,"AD",PRCPINPT,ORD)) Q:+ORD'>0 D
  1. . S X=^PRCP(445.3,ORD,0)
  1. . I $P(X,"^",10)]"",$P(X,"^",6)="R",$D(^PRCP(445.3,ORD,1,ITEMDA)),($P(X,"^",8))="R" D
  1. . . I $P(^PRCP(445.3,ORD,1,ITEMDA,0),"^",7) D
  1. . . . I OUTORD S REFILL=REFILL_"; "
  1. . . . I 'OUTORD S REFILL=REFILL_"unposted refills: " S OUTORD=1
  1. . . . S REFILL=REFILL_"ORD# "_$P(^PRCP(445.3,ORD,0),"^",1)
  1. . . . S PRIMVN=$P(X,"^",2)_";PRCP(445,"
  1. . . . S X=$$GETVEN^PRCPUVEN(PRCPINPT,ITEMDA,PRIMVN,1)
  1. . . . S X=$P(X,"^",4) ; pkg multiple (conversion factor)
  1. . . . I 'X S X=1
  1. . . . S REFILL=REFILL_"("_($P(^PRCP(445.3,ORD,1,ITEMDA,0),"^",7)*X)_")"
  1. Q REFILL
  1. ;
  1. H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
  1. W $C(13),"SUPPLY STATION QUANTITY DISCREPANCY REPORT",?(IOM-$L(%)),%
  1. W !,"FOR: ",PRCPINNM,!
  1. W !,?2,"GIP",?19,"SUPPLY STATION"
  1. W !,"QTY NOW QTY (AS OF DATE and TIME) ITEM NUMBER AND DESCRIPTION"
  1. ; W !,"ITEM NUMBER AND DESCRIPTION"
  1. ; W ?58,$J("STAND",6),$J("NORM",6),$J("UNIT",10),!,"DESCRIPTION",?29,"MI#",?35,"NSN",?50,$J("UNIT/IS",8),$J("REOPT",6),$J("STLVL",6),$J("COST",10)
  1. S %="",$P(%,"-",IOM+1)="" W !,%,!
  1. Q