| 1 | PRCPUTRX ;WISC/RFJ-transaction history file 445.2 sets ;07 Jul 92
|
|---|
| 2 | V ;;5.1;IFCAP;**1**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | ADDTRAN(INVPT,ITEMDA,TRANTYPE,ORDERNO,PRCPDATA) ; add transaction entry
|
|---|
| 8 | ;prcpdata nodes:
|
|---|
| 9 | ; date) = date of transaction (posted or issued, etc)
|
|---|
| 10 | ; (optional) if not set it uses current date
|
|---|
| 11 | ; qty) = quantity of transaction
|
|---|
| 12 | ; invval) = inventory value
|
|---|
| 13 | ; selval) = sales value
|
|---|
| 14 | ; avgunit) = average unit cost
|
|---|
| 15 | ; selunit) = selling unit cost
|
|---|
| 16 | ; pkg) = unit per issue / units
|
|---|
| 17 | ; (optional) set to current if not passed
|
|---|
| 18 | ; ref) = reference number
|
|---|
| 19 | ; 2237po) = 2237 or purchase order number
|
|---|
| 20 | ; issue) = issue/nonissue
|
|---|
| 21 | ; (optional) set to I for issuable, N for non
|
|---|
| 22 | ; otherpt) = other inventory point
|
|---|
| 23 | ; reason) = n:reason (if n=1 ask reason)
|
|---|
| 24 | ; reasoncode) = reason code (for whse other adjustments)
|
|---|
| 25 | ; recipient = who got the supply
|
|---|
| 26 | ; user = person who took the supply from the cabinet
|
|---|
| 27 | ;
|
|---|
| 28 | ; returns variable y = da of entry added
|
|---|
| 29 | S Y=0
|
|---|
| 30 | ;
|
|---|
| 31 | ; inventory point is not keeping a detailed transaction reg.
|
|---|
| 32 | I $P($G(^PRCP(445,+INVPT,0)),"^",6)'="Y" Q
|
|---|
| 33 | ;
|
|---|
| 34 | N %,%DT,D,D0,DA,DD,DI,DIC,DIE,DLAYGO,DQ,DR,NOW,PRCPDR,PRCPPRIV,PRCPREAS,TRANDA,X
|
|---|
| 35 | D NOW^%DTC S NOW=%
|
|---|
| 36 | ;
|
|---|
| 37 | ; set up all variables not defined
|
|---|
| 38 | I '$G(PRCPDATA("DATE")) S PRCPDATA("DATE")=$E(NOW,1,7)
|
|---|
| 39 | I '$D(PRCPDATA("PKG")) S PRCPDATA("PKG")=$$UNIT^PRCPUX1(INVPT,ITEMDA,"/")
|
|---|
| 40 | F %="QTY","INVVAL","SELVAL" I '$G(PRCPDATA(%)) S PRCPDATA(%)=0
|
|---|
| 41 | S %=$G(^PRCP(445,INVPT,1,ITEMDA,0))
|
|---|
| 42 | S:'$G(PRCPDATA("AVGUNIT")) PRCPDATA("AVGUNIT")=+$P(%,"^",22)
|
|---|
| 43 | S:'$G(PRCPDATA("SELUNIT")) PRCPDATA("SELUNIT")=+$P(%,"^",15)
|
|---|
| 44 | F %="REF","2237PO","ISSUE","OTHERPT","REASON","RECIPIENT","USER" I '$D(PRCPDATA(%)) S PRCPDATA(%)=""
|
|---|
| 45 | ;
|
|---|
| 46 | ; add new transaction history entry
|
|---|
| 47 | S DIC(0)="L",DLAYGO=445.2,DIC="^PRCP(445.2,",X=INVPT,PRCPPRIV=1
|
|---|
| 48 | D FILE^DICN I Y<1 S Y=0 Q
|
|---|
| 49 | S (TRANDA,DA)=+Y,DIE="^PRCP(445.2,"
|
|---|
| 50 | 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"))_";"
|
|---|
| 51 | 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")_";"
|
|---|
| 52 | S DR=DR_"23////"_PRCPDATA("RECIPIENT")_";"
|
|---|
| 53 | S DR=DR_"22////"_PRCPDATA("USER")_";"
|
|---|
| 54 | ; additional reason text (for asking in second call to die)
|
|---|
| 55 | S PRCPDR="" I $D(PRCPDATA("REASONCODE")) S PRCPDR="9////"_$E(PRCPDATA("REASONCODE"),1,3)_";"
|
|---|
| 56 | S PRCPDR=PRCPDR_"9.5//"_$S($P(PRCPDATA("REASON"),":"):"",1:"/")_"^S X=PRCPREAS",PRCPREAS=$E($P(PRCPDATA("REASON"),":",2,99),1,80)
|
|---|
| 57 | L +^PRCP(445.2,TRANDA)
|
|---|
| 58 | D ^DIE
|
|---|
| 59 | S DR=PRCPDR
|
|---|
| 60 | D ^DIE
|
|---|
| 61 | L -^PRCP(445.2,TRANDA)
|
|---|
| 62 | S Y=DA
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | ;
|
|---|
| 66 | ORDERNO(INVPT) ; get next order number for inventory point
|
|---|
| 67 | ; returns orderno
|
|---|
| 68 | S Y=0
|
|---|
| 69 | 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)
|
|---|
| 70 | Q Y
|
|---|
