source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAWC0.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1PRCPAWC0 ;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 ;
7CODESHTS(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 ;
37ISMS ; 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 ;
43LOG ; 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
Note: See TracBrowser for help on using the repository browser.