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

PRCPUTRX.m

Go to the documentation of this file.
  1. PRCPUTRX ;WISC/RFJ-transaction history file 445.2 sets ;07 Jul 92
  1. V ;;5.1;IFCAP;**1,126**;Oct 20, 2000;Build 2
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. ADDTRAN(INVPT,ITEMDA,TRANTYPE,ORDERNO,PRCPDATA) ; add transaction entry
  1. ;prcpdata nodes:
  1. ; date) = date of transaction (posted or issued, etc)
  1. ; (optional) if not set it uses current date
  1. ; qty) = quantity of transaction
  1. ; invval) = inventory value
  1. ; selval) = sales value
  1. ; avgunit) = average unit cost
  1. ; selunit) = selling unit cost
  1. ; pkg) = unit per issue / units
  1. ; (optional) set to current if not passed
  1. ; ref) = reference number
  1. ; 2237po) = 2237 or purchase order number
  1. ; issue) = issue/nonissue
  1. ; (optional) set to I for issuable, N for non
  1. ; otherpt) = other inventory point
  1. ; reason) = n:reason (if n=1 ask reason)
  1. ; reasoncode) = reason code (for whse other adjustments)
  1. ; recipient = who got the supply
  1. ; user = person who took the supply from the cabinet
  1. ;
  1. ; returns variable y = da of entry added
  1. S Y=0
  1. ;
  1. ; inventory point is not keeping a detailed transaction reg.
  1. I $P($G(^PRCP(445,+INVPT,0)),"^",6)'="Y" Q
  1. ;
  1. N %,%DT,D,D0,DA,DD,DI,DIC,DIE,DLAYGO,DQ,DR,NOW,PRCPDR,PRCPPRIV,PRCPREAS,TRANDA,X
  1. D NOW^%DTC S NOW=%
  1. ;
  1. ; set up all variables not defined
  1. I '$G(PRCPDATA("DATE")) S PRCPDATA("DATE")=$E(NOW,1,7)
  1. I '$D(PRCPDATA("PKG")) S PRCPDATA("PKG")=$$UNIT^PRCPUX1(INVPT,ITEMDA,"/")
  1. F %="QTY","INVVAL","SELVAL" I '$G(PRCPDATA(%)) S PRCPDATA(%)=0
  1. S %=$G(^PRCP(445,INVPT,1,ITEMDA,0))
  1. I '$G(PRCPDATA("AVGUNIT")) D
  1. . S PRCPDATA("AVGUNIT")=+$P(%,"^",22)
  1. . I TRANTYPE="P",PRCPDATA("AVGUNIT")=0 S PRCPDATA("AVGUNIT")=+$P(%,"^",15)
  1. S:'$G(PRCPDATA("SELUNIT")) PRCPDATA("SELUNIT")=+$P(%,"^",15)
  1. F %="REF","2237PO","ISSUE","OTHERPT","REASON","RECIPIENT","USER" I '$D(PRCPDATA(%)) S PRCPDATA(%)=""
  1. ;
  1. ; add new transaction history entry
  1. S DIC(0)="L",DLAYGO=445.2,DIC="^PRCP(445.2,",X=INVPT,PRCPPRIV=1
  1. D FILE^DICN I Y<1 S Y=0 Q
  1. S (TRANDA,DA)=+Y,DIE="^PRCP(445.2,"
  1. S DR="1///"_TRANTYPE_ORDERNO_";2///"_PRCPDATA("DATE")_";2.5///"_NOW_";3///"_TRANTYPE_";4////"_ITEMDA_";5////"_PRCPDATA("PKG")_";6////"_PRCPDATA("QTY")_";7////"_(+PRCPDATA("AVGUNIT"))_";8////"_(+PRCPDATA("SELUNIT"))_";"
  1. S DR=DR_"6.1////"_(+PRCPDATA("INVVAL"))_";6.2////"_(+PRCPDATA("SELVAL"))_";8.5////"_DUZ_";10////"_PRCPDATA("ISSUE")_";13////"_PRCPDATA("REF")_";14////"_PRCPDATA("OTHERPT")_";410////"_PRCPDATA("2237PO")_";"
  1. S DR=DR_"23////"_PRCPDATA("RECIPIENT")_";"
  1. S DR=DR_"22////"_PRCPDATA("USER")_";"
  1. ; additional reason text (for asking in second call to die)
  1. S PRCPDR="" I $D(PRCPDATA("REASONCODE")) S PRCPDR="9////"_$E(PRCPDATA("REASONCODE"),1,3)_";"
  1. S PRCPDR=PRCPDR_"9.5//"_$S($P(PRCPDATA("REASON"),":"):"",1:"/")_"^S X=PRCPREAS",PRCPREAS=$E($P(PRCPDATA("REASON"),":",2,99),1,80)
  1. L +^PRCP(445.2,TRANDA)
  1. D ^DIE
  1. S DR=PRCPDR
  1. D ^DIE
  1. L -^PRCP(445.2,TRANDA)
  1. S Y=DA
  1. Q
  1. ;
  1. ;
  1. ORDERNO(INVPT) ; get next order number for inventory point
  1. ; returns orderno
  1. S Y=0
  1. I $P($G(^PRCP(445,+INVPT,0)),"^",6)="Y" L +^PRCP(445.2,"ANXT",INVPT) S Y=$G(^PRCP(445.2,"ANXT",INVPT))+1 S:Y>9999999 Y=1 S ^(INVPT)=Y L -^PRCP(445.2,"ANXT",INVPT)
  1. Q Y