75 lines
3.6 KiB
Mathematica
75 lines
3.6 KiB
Mathematica
|
PRCPAWI1 ;WISC/RFJ/DL-adjust inventory level - issue adjustment cont. ;1/28/98 0915
|
||
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
||
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
;
|
||
|
|
ISUECONT ; issue book adjustment continuation
|
||
|
|
N CANTEEN,DATA,DRUGACCT,FY,ITEMDA,LINEDA,ORDERNO,PRCPID,PRIMORDR,QTR,TOTALINV,TOTALSAL,X,Y
|
||
|
|
S ORDERNO=$$ORDERNO^PRCPUTRX(PRCP("I"))
|
||
|
|
I DISTRPT S PRIMORDR=$$ORDERNO^PRCPUTRX(DISTRPT)
|
||
|
|
I $G(PRIMORDR),$P($G(^PRCP(445,+DISTRPT,0)),"^",20)="D" S X="PSAGIP" I $D(^%ZOSF("TEST")) X ^%ZOSF("TEST") I $T S DRUGACCT=1 W !!?10,">> NOTE: Primary is set up for DRUG ACCOUNTABILITY. <<"
|
||
|
|
I $P($G(^PRC(420,PRCPPSTA,1,PRCPPFCP,0)),"^",12)=4 S CANTEEN=1
|
||
|
|
;
|
||
|
|
S (LINEDA,TOTALINV,TOTALSAL)=0 F S LINEDA=$O(^TMP($J,"PRCPAWI0","PROCESS",LINEDA)) Q:'LINEDA S DATA=^(LINEDA) I DATA'="" S ITEMDA=+$P(DATA,"^",7) I ITEMDA D
|
||
|
|
. ; update issue book
|
||
|
|
. D POSTDATA(PRCPDA,LINEDA,$P(DATA,"^"),$P(DATA,"^",3),$P(DATA,"^",2))
|
||
|
|
. S TOTALINV=TOTALINV+$P(DATA,"^",3),TOTALSAL=TOTALSAL+$P(DATA,"^",2)
|
||
|
|
. ; update whse
|
||
|
|
. K PRCPAWI0
|
||
|
|
. S PRCPAWI0("QTY")=-$P(DATA,"^"),PRCPAWI0("INVVAL")=-$P(DATA,"^",3),PRCPAWI0("SELVAL")=-$P(DATA,"^",2),PRCPAWI0("REF")=VOUCHER,PRCPAWI0("2237PO")=TRANNO
|
||
|
|
. S PRCPAWI0("REASON")="0:"_$S($G(CANTEEN):"2:",1:"")_$P(DATA,"^",6)
|
||
|
|
. I OTHERPT S PRCPAWI0("OTHERPT")=OTHERPT
|
||
|
|
. D ITEM^PRCPUUIW(PRCP("I"),ITEMDA,"A",ORDERNO,.PRCPAWI0)
|
||
|
|
. ; set issue book line number in TR
|
||
|
|
. I $D(^PRCP(445.2,+$G(PRCPID),0)) S $P(^(0),"^",24)=LINEDA
|
||
|
|
. K PRCPAWI0
|
||
|
|
. ; update primary
|
||
|
|
. I '$G(PRIMORDR) Q
|
||
|
|
. S PRCPAWI0("QTY")=$P(DATA,"^")*$P($$GETVEN^PRCPUVEN(OTHERPT,ITEMDA,+$O(^PRC(440,"AC","S",0))_";PRC(440,",1),"^",4)
|
||
|
|
. S (PRCPAWI0("INVVAL"),PRCPAWI0("SELVAL"))=$P(DATA,"^",2),PRCPAWI0("REF")=VOUCHER,PRCPAWI0("REASON")="0:ISSUE adjustment by the WHSE",PRCPAWI0("2237PO")=TRANNO,PRCPAWI0("OTHERPT")=PRCP("I")
|
||
|
|
. I $G(DRUGACCT) S PRCPAWI0("DRUGACCT")=1
|
||
|
|
. D ITEM^PRCPUUIW(OTHERPT,ITEMDA,"A",PRIMORDR,.PRCPAWI0)
|
||
|
|
. K PRCPAWI0
|
||
|
|
;
|
||
|
|
I $G(DRUGACCT) D EX^PSAGIP
|
||
|
|
;
|
||
|
|
S FY=$E(DT,2,3),FY=$E(100+$S(+$E(DT,4,5)>9:FY+1,1:FY),2,3)
|
||
|
|
S QTR=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",+$E(DT,4,5))
|
||
|
|
;I TOTALINV,'$G(CANTEEN) D ISSUES^PRCSREC2(PRCPWSTA,FY,PRCPWFCP,QTR,-TOTALINV)
|
||
|
|
;I TOTALSAL,'$G(CANTEEN) D ISSUES^PRCSREC2(PRCPPSTA,FY,PRCPPFCP,QTR,-TOTALSAL)
|
||
|
|
; update 410 for running balance
|
||
|
|
S $P(^PRCS(410,PRCPDA,445),"^",3)=$P($G(^PRCS(410,PRCPDA,445)),"^",3)+TOTALSAL
|
||
|
|
I TOTALSAL,'$G(CANTEEN) D
|
||
|
|
. N A,B
|
||
|
|
. S A=^PRCS(410,PRCPDA,0),B=$P($G(^(3)),"^",11),A=$P($$QTRDATE^PRC0D($P(A,"-",2),$P(A,"-",3)),"^",7)
|
||
|
|
. S PRCPRBSL=PRCPWSTA_"^"_PRCPWFCP_"^"_"A"_"^"_"^"_DT_"^"_-TOTALSAL_"^"_$P(^PRCS(410,PRCPDA,4),"^",5)_"-ADJ"
|
||
|
|
. S $P(PRCPRBSL,"^",10,11)=A_"^"_+$$DATE^PRC0C(B,"I")
|
||
|
|
. D A410^PRC0F(.PRCPXX,PRCPRBSL)
|
||
|
|
. S PRCPRBBY=PRCPPSTA_"^"_PRCPPFCP_"^"_"A"_"^"_"^"_DT_"^"_TOTALSAL_"^"_$P(^PRCS(410,PRCPDA,4),"^",5)_"-ADJ" D
|
||
|
|
. S $P(PRCPRBBY,"^",10,11)=A_"^"_+$$DATE^PRC0C(B,"I")
|
||
|
|
. D A410^PRC0F(.PRCPXX,PRCPRBBY)
|
||
|
|
. K PRCPRBSL,PRCPRBBY,PRCPXX
|
||
|
|
;
|
||
|
|
; create fms iv adjustment document
|
||
|
|
W !
|
||
|
|
I '$G(CANTEEN) D IV^PRCPSFIV(PRCP("I"),"A"_ORDERNO,TRANNO,"","")
|
||
|
|
I $G(CANTEEN) D SV^PRCPSFSV(PRCP("I"),"A"_ORDERNO,"","")
|
||
|
|
; create log or isms code sheets
|
||
|
|
D CODESHTS^PRCPAWC0(PRCP("I"),"A"_ORDERNO)
|
||
|
|
; print form
|
||
|
|
D PRINFORM^PRCPAWR0("A"_ORDERNO)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
;
|
||
|
|
POSTDATA(PRCPDA,LINEDA,QTY,INVVALUE,SELVALUE) ; update posting values for IB
|
||
|
|
; add qty,invvalue,selvalue to posting data
|
||
|
|
I '$D(^PRCS(410,PRCPDA,"IT",LINEDA,0)) Q
|
||
|
|
N POSTDATA
|
||
|
|
S POSTDATA=$G(^PRCS(410,PRCPDA,"IT",LINEDA,445))
|
||
|
|
S $P(POSTDATA,"^",3)=$P(POSTDATA,"^",3)+QTY
|
||
|
|
S $P(POSTDATA,"^",4)=$P(POSTDATA,"^",4)+INVVALUE
|
||
|
|
S $P(POSTDATA,"^",5)=$P(POSTDATA,"^",5)+SELVALUE
|
||
|
|
S $P(^PRCS(410,PRCPDA,"IT",LINEDA,445),"^",3,5)=$P(POSTDATA,"^",3,5)
|
||
|
|
Q
|