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