| 1 | PRCPAWC0 ;WISC/RFJ-adjustment code sheets create and trans ;9.9.97
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | CODESHTS(INVPT,TRANID) ; create and transmit code sheets
|
|---|
| 8 | ; for invpt and transaction register id
|
|---|
| 9 | N %,%H,%X,%Y,ACCT,DA,DATA,INVVALUE,ISMSCNT,ISMSFLAG,ITEMDA,NSN,PRCPXMZ,QSIGN,QTY,SELVALUE,STRING,VOUCHER,VSIGN
|
|---|
| 10 | S ISMSFLAG=$$ISMSFLAG^PRCPUX2(PRC("SITE"))
|
|---|
| 11 | K ^TMP($J,"PRCPAWN1")
|
|---|
| 12 | S ISMSCNT=0
|
|---|
| 13 | S DA=0 F S DA=$O(^PRCP(445.2,"T",INVPT,TRANID,DA)) Q:'DA S DATA=$G(^PRCP(445.2,DA,0)) I DATA'="" D
|
|---|
| 14 | . I '$D(VOUCHER),$L($P(DATA,"^",15)) S VOUCHER=$P(DATA,"^",15)
|
|---|
| 15 | . S ITEMDA=+$P(DATA,"^",5) I 'ITEMDA Q
|
|---|
| 16 | . S NSN=$$NSN^PRCPUX1(ITEMDA),ACCT=$$ACCT1^PRCPUX1($E(NSN,1,4))
|
|---|
| 17 | . S QTY=+$P(DATA,"^",7),INVVALUE=+$P(DATA,"^",22),SELVALUE=+$P(DATA,"^",23)
|
|---|
| 18 | . I ISMSFLAG=2 D ISMS Q
|
|---|
| 19 | . D LOG
|
|---|
| 20 | ;
|
|---|
| 21 | ; transmit isms code sheets
|
|---|
| 22 | I ISMSFLAG=2,ISMSCNT D
|
|---|
| 23 | . K ^TMP($J,"STRING")
|
|---|
| 24 | . S %X="^TMP("_$J_",""PRCPAWN1"",",%Y="^TMP("_$J_",""STRING""," D %XY^%RCR
|
|---|
| 25 | . D CODESHT^PRCPSMGO(PRC("SITE"),"ADJ",VOUCHER)
|
|---|
| 26 | ;
|
|---|
| 27 | ; transmit log code sheets to isms
|
|---|
| 28 | I ISMSFLAG'=2,ISMSCNT D
|
|---|
| 29 | . K ^TMP($J,"STRING")
|
|---|
| 30 | . S %X="^TMP("_$J_",""PRCPAWN1"",",%Y="^TMP("_$J_",""STRING""," D %XY^%RCR
|
|---|
| 31 | . D TRANSMIT^PRCPSMCL(PRC("SITE"),605,"LOG")
|
|---|
| 32 | . W !!?4,"LOG 605 Transmitted in MailMan Messages:" I $D(PRCPXMZ) S %=0 F S %=$O(PRCPXMZ(%)) Q:'% W " ",PRCPXMZ(%)," "
|
|---|
| 33 | K ^TMP($J,"PRCPAWN1"),^TMP($J,"STRING")
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | ;
|
|---|
| 37 | ISMS ; format isms code sheet
|
|---|
| 38 | I QTY D ADJUST^PRCPSMA0(INVPT,ITEMDA,QTY,"","","") I STRING("AT")'="" S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=STRING("AT")
|
|---|
| 39 | I INVVALUE D ADJUST^PRCPSMA0(INVPT,ITEMDA,"",INVVALUE,+$P($G(^PRCP(445,INVPT,1,ITEMDA,0)),"^",22),"") I STRING("AT")'="" S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=STRING("AT")
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
| 43 | LOG ; format log code sheets for isms
|
|---|
| 44 | S NSN=$E($TR($P(NSN,"-",2,4),"-")_" ",1,10)
|
|---|
| 45 | ; format quantity
|
|---|
| 46 | S QSIGN="+"
|
|---|
| 47 | I QTY<0 S QSIGN="-",QTY=QTY*-1
|
|---|
| 48 | S QTY=$S(QTY=0:" ",1:$E("00000",$L(QTY)+1,5)_QTY)
|
|---|
| 49 | ; format inventory value
|
|---|
| 50 | S VSIGN=QSIGN
|
|---|
| 51 | I INVVALUE S INVVALUE=$TR($J(INVVALUE,0,2),"."),VSIGN="+" I INVVALUE<0 S VSIGN="-",INVVALUE=INVVALUE*-1
|
|---|
| 52 | S INVVALUE=$S('INVVALUE:" ",1:$E("0000000",$L(INVVALUE)+1,7)_INVVALUE)
|
|---|
| 53 | ; build code sheets
|
|---|
| 54 | S %="",$P(%," ",80)=""
|
|---|
| 55 | I '$D(VOUCHER) S VOUCHER=" "
|
|---|
| 56 | I QSIGN=VSIGN S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_QTY_INVVALUE_QSIGN_VOUCHER_$E(DT,4,7)_$E(DT,2,3)_$E(%,1,35) Q
|
|---|
| 57 | I +QTY S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_QTY_"0000000"_QSIGN_VOUCHER_$E(DT,4,7)_$E(DT,2,3)_$E(%,1,35)
|
|---|
| 58 | I +INVVALUE S ISMSCNT=ISMSCNT+1,^TMP($J,"PRCPAWN1",ISMSCNT)=" "_NSN_PRC("SITE")_"605A"_ACCT_"00000"_INVVALUE_VSIGN_VOUCHER_$E(DT,4,5)_$E(DT,6,7)_$E(DT,2,3)_$E(%,1,35)
|
|---|
| 59 | Q
|
|---|
