| 1 | PRCHPOO ;WISC/TGH-GENERATE PROOF OF ORDER FOR GUARANTEED DELIVERY P.O.'S ;7/18/95 12:06
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN W $C(7),!!,"Now Generating Proof of Order (Receiving Report) for Guaranteed Delivery",!,"P.O. (please wait...)",!!!
|
|---|
| 6 | I '$D(DT) D NOW^%DTC S DT=$P(%,".",1)
|
|---|
| 7 | S PRCHPO=PRCFA("PODA"),PRCHRD=DT,PRCHRT0="",(PRCHRT,PRCHRFIN)=0,X=$P(^PRC(442,PRCHPO,0),U,19) D:X'=2 TM^PRCHREC2
|
|---|
| 8 | K PRCHR S X="C",PRCHPOO=1 D COM1^PRCHREC1
|
|---|
| 9 | K PRCHPOO
|
|---|
| 10 | ;ELECTRONICALLY TRANSMIT RR TO AUSTIN
|
|---|
| 11 | I $G(PRCFA("PODA"))>0,$D(PRCFA("PARTIAL")) D
|
|---|
| 12 | . D:'$G(PRCFA("RETRAN"))
|
|---|
| 13 | . . N PNO,XA,XB,XC,XD,GECSFMS,POESIG
|
|---|
| 14 | . . S PNO="" D ALPHA^PRCFPAR(PRCFA("PARTIAL"),.PNO)
|
|---|
| 15 | . . S XD=$P($G(^PRC(442,PRCFA("PODA"),0)),U),GECSFMS("DA")=""
|
|---|
| 16 | . . S GECSFMS("DOC")="^^RR^"_$TR(XD,"-")_PNO,POESIG=1,XA="RR",XB="E"
|
|---|
| 17 | . . S XC=$P($G(^PRC(442,PRCFA("PODA"),11,PRCFA("PARTIAL"),0)),U)
|
|---|
| 18 | . . S XD=$P(XD,"-",2) K PRCFA("TT")
|
|---|
| 19 | . . D EN7^PRCFFU41(XA,XB,XC,XD)
|
|---|
| 20 | . S DA=PRCFA("PARTIAL"),DA(1)=PRCFA("PODA"),DIE="^PRC(442,"_DA(1)_",11,"
|
|---|
| 21 | . S DR="23R//^S X=$P(""JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"",U,$E(DT,4,5))_"" ""_($E(DT,1,3)+1700)"
|
|---|
| 22 | . D ^DIE K DA,DIE,DR Q:$D(DTOUT)!$D(DUOUT)!$D(Y)
|
|---|
| 23 | . D LOAD^PRCFARRQ
|
|---|
| 24 | K %Y,B,DG,DIE,DIG,DIH,DIK,DIR,DIU,DIV,DIW,DLAYGO,DR,FSO,P,Q,Q1,S,X,Y
|
|---|
| 25 | Q
|
|---|
