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

PRCPRIT1.m

Go to the documentation of this file. 
  1. PRCPRIT1 ;WISC/RFJ/VAC-display item (print) ; 10/27/06 2:01pm
  1.  ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;Routine modified to show "D" for On-Demand Item and to correct
  1.  ;   column #IM heading
  1.  Q
  1.  ;
  1.  ;
  1. DQ ;queue comes here
  1.  N %I,D,D0,ITEMDATA,PRCPDA,DATA,DATE,INVNAME,NOW,PAGE,PRCPFLAG,SCREEN,UNIT,X,Y,ODI,X1,X2,MASTDATA
  1.  D NOW^%DTC S Y=%,DATE=$E(%,1,7) D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP,INVNAME=$$INVNAME^PRCPUX1(INVPT) U IO D H
  1.  S MASTDATA=$G(^PRC(441,ITEMDA,0)),ITEMDATA=$G(^PRCP(445,INVPT,1,ITEMDA,0))
  1.  W !,$P(MASTDATA,"^",5),?19,$E($$DESCR^PRCPUX1(INVPT,ITEMDA),1,28),?49,"[#",ITEMDA,"]",?59,$E($$GROUPNM^PRCPEGRP(+$P(ITEMDATA,"^",21)),1,20)
  1.  ; Insert logic to print ODI flag of "D"
  1.  I ODIFLAG="P"  D
  1.  .W !,?8,"ON-DEMAND: "
  1.  .S ODI=""
  1.  .S ODI=$$ODITEM^PRCPUX2(INVPT,ITEMDA)
  1.  .I ODI="Y" W "D"
  1.  .W ?36,"BOC: ",$E($P($G(^PRCD(420.2,+$P(MASTDATA,"^",10),0)),"^"),1,39)
  1.  I ODIFLAG="W" D
  1.  .W ?14,"BOC: ",$E($P($G(^PRCD(420.2,+$P(MASTDATA,"^",10),0)),"^"),1,39)
  1.  S UNIT=$$UNIT^PRCPUX1(INVPT,ITEMDA," per ") W !?3,"UNIT per ISSUE: ",UNIT
  1.  W !?6,"QTY ON HAND: ",+$P(ITEMDATA,"^",7),?33,"DUE-IN: ",$$GETIN^PRCPUDUE(INVPT,ITEMDA),?60,"DUE-OUT: ",$$GETOUT^PRCPUDUE(INVPT,ITEMDA),!?6,"QTY NON-ISS: ",+$P(ITEMDATA,"^",19)
  1.  I $P(ITEMDATA,"^",26)="Y" W !?19,"** DELETE ITEM WHEN QTY ON HAND REACHES ZERO **"
  1.  W !?6,"TOTAL VALUE: ",$P(ITEMDATA,"^",27)
  1.  W !?5,"NORM STL LVL: ",$P(ITEMDATA,"^",9),?29,"REORDER PT: ",$P(ITEMDATA,"^",10),?55,"INT ORDER PT: ",$P(ITEMDATA,"^",4)
  1.  W !?4,"EMERGENCY LVL: ",$P(ITEMDATA,"^",11),?29,"ISSUE MULT: ",$P(ITEMDATA,"^",25),?54,"MIN ISSUE QTY: ",$P(ITEMDATA,"^",17)
  1.  I $P(ITEMDATA,"^",23) S Y=$P(ITEMDATA,"^",24) D DD^%DT W !?5,"TEMP STK LVL: ",$P(ITEMDATA,"^",23),?29,"UNTIL DATE: ",Y
  1.  S Y=$P(ITEMDATA,"^",3) D DD^%DT W !?8,"LAST COST: ",$P(ITEMDATA,"^",15),?29,"LAST REC'D: ",Y,?55,"AVERAGE COST: ",$P(ITEMDATA,"^",22)
  1.  W !?1,"MAIN STORAGE LOC: ",$$STORELOC^PRCPESTO(+$P(ITEMDATA,"^",6))
  1.  I $O(^PRCP(445,INVPT,1,ITEMDA,5,0)) D
  1.  .   D HS S PRCPDA=0 F  S PRCPDA=$O(^PRCP(445,INVPT,1,ITEMDA,5,PRCPDA)) Q:'PRCPDA!($G(PRCPFLAG))  S DATA=$G(^(PRCPDA,0)) D
  1.  .   .   W ! I $P(ITEMDATA,"^",12)=$P(DATA,"^") W ?3,"m"
  1.  .   .   S Y=$P(DATA,"^"),Y=$S(Y["PRC(440":$P($G(^PRC(440,+Y,0)),"^"),1:$P($G(^PRCP(445,+Y,0)),"^")) S:'+$P(DATA,"^",4) $P(DATA,"^",4)=1
  1.  .   .   W ?5,$E(Y,1,27),?37,"[#",+DATA,"]",?45,$J($P(DATA,"^",4),9),?68,$J($$UNITVAL^PRCPUX1($P(DATA,"^",3),$P(DATA,"^",2)," per "),11)
  1.  .   .   I $Y>(IOSL-5),$O(^PRCP(445,INVPT,1,ITEMDA,5,PRCPDA)) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG)  D H,HS
  1.  I $G(PRCPFLAG) D Q Q
  1.  I $O(^PRCP(445,INVPT,1,ITEMDA,7,0)) D
  1.  .   I $Y>(IOSL-7) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG)  D H
  1.  .   D HO S PRCPDA=0 F  S PRCPDA=$O(^PRCP(445,INVPT,1,ITEMDA,7,PRCPDA)) Q:'PRCPDA!($G(PRCPFLAG))  S DATA=$G(^(PRCPDA,0)) D
  1.  .   .   S:'+$P(DATA,"^",5) $P(DATA,"^",5)=1
  1.  .   .   W !?1,$P($G(^PRCS(410,PRCPDA,0)),"^"),?21,$J(+$P(DATA,"^",2),7),?32,$J(UNIT,11),?50,$J($P(DATA,"^",5),5),?57,$J($P(DATA,"^",2)/$P(DATA,"^",5),7),?68,$J($$UNITVAL^PRCPUX1($P(DATA,"^",4),$P(DATA,"^",3)," per "),11)
  1.  .   .   S D0=PRCPDA D STATUS^PRCSES W !?10,"REQUEST STATUS: ",X
  1.  .   .   I $Y>(IOSL-5),$O(^PRCP(445,INVPT,1,ITEMDA,7,PRCPDA)) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG)  D H,HO
  1.  I $G(PRCPFLAG) D Q Q
  1.  S X1=$E(DATE,1,5)_"01",X2=-180 D C^%DTC S X=$E(X,1,5)
  1.  I $O(^PRCP(445,INVPT,1,ITEMDA,2,X)) D
  1.  .   I $Y>(IOSL-7) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG)  D H
  1.  .   D HU S PRCPDA=X F  S PRCPDA=$O(^PRCP(445,INVPT,1,ITEMDA,2,PRCPDA)) Q:'PRCPDA!($G(PRCPFLAG))  S DATA=$G(^(PRCPDA,0)) D
  1.  .   .   W !?9,$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(PRCPDA,4,5))," ",17+$E(PRCPDA),$E(PRCPDA,2,3),?29,$J($P(DATA,"^",2),15),?47,$J($P(DATA,"^",3),17,3)
  1.  .   .   I $Y>(IOSL-5),$O(^PRCP(445,INVPT,1,ITEMDA,2,PRCPDA)) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG)  D H,HU
  1.  I $G(PRCPFLAG) D Q Q
  1.  I $O(^PRCP(445,INVPT,1,ITEMDA,3,X_"01")) D
  1.  .   I $Y>(IOSL-7) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG)  D H
  1.  .   D HR S PRCPDA=X_"01" F  S PRCPDA=$O(^PRCP(445,INVPT,1,ITEMDA,3,PRCPDA)) Q:'PRCPDA!($G(PRCPFLAG))  S DATA=$G(^(PRCPDA,0)) D
  1.  .   .   W !?9,$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(PRCPDA,4,5))," ",$E(PRCPDA,6,7),", ",17+$E(PRCPDA),$E(PRCPDA,2,3),?29,$J($P(DATA,"^",2),13)
  1.  .   .   I $Y>(IOSL-5),$O(^PRCP(445,INVPT,1,ITEMDA,3,PRCPDA)) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG)  D H,HR
  1.  I '$G(PRCPFLAG) D END^PRCPUREP
  1. Q D ^%ZISC Q
  1.  ;
  1.  ;
  1. H S %=NOW_"  PAGE: "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
  1.  W $C(13),"DISPLAY ITEM REPORT FOR ",INVNAME,?(80-$L(%)),%
  1.  S %="",$P(%,"-",81)="" W !,"NSN",?19,"DESCRIPTION",?49,"[IM#]",?59,"GROUP : DESCRIPTION",!,%
  1.  Q
  1.  ;
  1.  ;
  1. HS ;header for procurement sources
  1.  W !?15,"-----POSSIBLE SOURCES (m=MANDATORY SOURCE)-----",!?5,"VENDOR",?37,"[#V]",?45,"CONV FACT",?68,"UNIT per REC"
  1.  Q
  1.  ;
  1.  ;
  1. HO ;header for outstanding transactions
  1.  W !?22,"-----OUTSTANDING TRANSACTIONS-----",!?1,"TRANSACTION NO.     QTY ORD in UNIT per ISS  CONV FACT  QTY REC in UNIT per REC"
  1.  Q
  1.  ;
  1.  ;
  1. HU ;header for usage
  1.  W !?24,"-----USAGE/ISSUES HISTORY-----",!?9,"DATE USED/ISSUED    QTY USED/ISSUED    COST USED/ISSUED"
  1.  Q
  1.  ;
  1.  ;
  1. HR ;header for receipts
  1.  W !?26,"-----RECEIPTS HISTORY-----",!?9,"DATE RECEIVED        QTY RECEIVED"
  1.  Q