source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFARRQ.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1PRCFARRQ ;WISC@ALTOONA/CTB-QUEUE RECEIVING REPORT FOR TRANSMISSION ;7/18/95 12:05
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4LOAD Q:$$QUEUED
5 Q:$P(^PRC(442,PRCFA("PODA"),0),U,2)=25
6 S X=$P(PRC("PARAM"),"^",6),X=$S(X=1:"NOW",X=2:"LATER",1:"MAIL") D @X Q
7NOW I '$D(^XUSEC("PRCFA TRANSMIT",DUZ)) G LATER
8 S %A="Are you sure you wish to send this Receiving Report to Austin",%B="A 'NO' or an '^' will prevent release to Austin.",%=1 D ^PRCFYN
9 I %'=1 S X=" Receiving Report has NOT been released to Austin.*" D MSG^PRCFQ Q
10 S ZTDTH=$H,ZTIO="",ZTSAVE("PRC*")="",ZTSAVE("PRCFA*")="",ZTDESC="TRANSMIT RR "_$P(^PRC(442,PRCFA("PODA"),0),"^")_"-"_PRCFA("PARTIAL")_" TO AUSTIN",ZTRTN="^PRCFARRT" D ^%ZTLOAD K ZTSK
11 S X="Receiving Report Queued for Immediate Transmission*" D MSG^PRCFQ Q
12LATER ;STORE DATA IN FILE 442.9 FOR LATER RELEASE OF RECEIVING REPORT
13 S %A="Are you sure you wish to send this Receiving Report to Austin",%B="A 'NO' or an '^' will prevent release to Austin.",%=1 D ^PRCFYN
14 I %'=1 S X=" Receiving Report has NOT been released to Austin.*" D MSG^PRCFQ Q
15 I $G(PRCACT)="E",$P(^PRC(442,PRCFA("PODA"),11,PRCFA("PARTIAL"),0),"^",19)]"" D Q
16 . W !!?5,"This receiving report has already been transmitted to Austin."
17 . W !?5,"It may NOT be rereleased using this option."
18 . W !?5,"RECEIVING REPORT HAS NOT BEEN RELEASED.",$C(7)
19 . Q
20 S DIC=442.9,DIC(0)="ML",DLAYGO=442.9,X=$P(^PRC(442,PRCFA("PODA"),0),"^",1)_"."_PRCFA("PARTIAL") D ^DIC K DIC,DLAYGO
21 I +Y<0 W !,"Unable to Queue at this time, Please use option to queue manually.",$C(7) Q
22 S DA=+Y,DR="1////"_PRCFA("PODA")_";2////"_+PRC("PER")_";3//T;4////"_$S('$D(PRCFA("RETRANS")):"",1:1),DIE="^PRC(442.9," D ^DIE
23 S X="Receiving report placed on transmission list.*" D MSG^PRCFQ
24 Q
25MAIL S X="Don't forget to mail this Receiving Report to Austin.*" D MSG^PRCFQ
26 Q
27SINGLE ;QUEUE SINGLE RECEIVING REPORT FOR TRANSMISSION
28 S PRCF("X")="AS" D ^PRCFSITE Q:'% S DIC("A")="Select PURCHASE ORDER NUMBER: "
29S1 S DIC="^PRC(442,",DIC(0)="AEQM",DIC("S")="I $O(^PRC(442,+Y,11,0)),+^PRC(442,+Y,0)=PRC(""SITE""),$P(^PRC(442,+Y,0),U,2)'=25" D ^DIC K DIC G:Y<0 OUT S DA(1)=+Y,PRCFA("PODA")=+Y
30 S DIC("A")="Select Partial Number: ",DIC="^PRC(442,"_DA(1)_",11,",DIC(0)="AEQM" D ^DIC K DIC I Y<1 K PRCFA G OUT
31 I $P(^PRC(442,PRCFA("PODA"),11,+Y,0),"^",19)]"" W !!,"This partial has already been transmitted to Austin. <No Action Taken>",$C(7) G S2
32 S PRCFA("PARTIAL")=+Y
33 D ACCTGPER G OUT:$D(DTOUT)!$D(DUOUT)!$D(Y)
34 I '$$QUEUED D ASK I '% S X=" <No Action Taken>*" D MSG^PRCFQ
35S2 S DIC("A")="Select Next PURCHASE ORDER NUMBER: "
36 G S1
37OUT K D,D0,DA,DI,DIC,DIE,DQ,DR,PRCFA Q
38RETRANS ;RETRANSMIT SINGLE RECEIVING REPORT
39 S PRCF("X")="AS" D ^PRCFSITE Q:'% S DIC("A")="Select PURCHASE ORDER NUMBER: "
40R1 S DIC="^PRC(442,",DIC(0)="AEQM",DIC("S")="I $O(^PRC(442,+Y,11,0)),+^PRC(442,+Y,0)=PRC(""SITE""),$P(^PRC(442,+Y,0),U,2)'=25" D ^DIC K DIC G:Y<0 OUT S DA(1)=+Y,PRCFA("PODA")=+Y
41 S DIC("A")="Select Partial Number: ",DIC="^PRC(442,"_DA(1)_",11,",DIC(0)="AEQM" D ^DIC K DIC I Y<1 K PRCFA G OUT
42 I $P(^PRC(442,PRCFA("PODA"),11,+Y,0),"^",19)="" W !!,"This partial has not yet been transmitted to Austin. <No Action Taken>",$C(7) G R2
43 S PRCFA("PARTIAL")=+Y,PRCFA("RETRANS")=""
44 D ACCTGPER G OUT:$D(DTOUT)!$D(DUOUT)!$D(Y)
45 I '$$QUEUED D ASK I '% S X=" <No action taken>*" D MSG^PRCFQ
46R2 S DIC("A")="Select Next PURCHASE ORDER NUMBER: "
47 G R1
48ASK ;ASK NOW OR LATER ANSWER IN % 1=NOW, 2=LATER -1=ABORT
49 K DA
50 I '$D(^XUSEC("PRCFA TRANSMIT",DUZ)) S %=2 G ASK1
51 S %=2,%A="Do you want this transmitted immediately",%B="A 'YES' will cause the receiving report to go to Austin immediately.",%B(1)="A 'NO' will queue it for release using the 'Transmit Receiving Reports'"
52 S %B(2)="Option. An '^' will terminate this option." D ^PRCFYN
53ASK1 G:%<0 ASKX I %=1 D NOW S %=1 G ASKX
54 S X=$P(^PRC(442,PRCFA("PODA"),0),"^")_"."_PRCFA("PARTIAL"),DIC=442.9,DIC(0)="ML",DLAYGO=442.9 D ^DIC K DIC,DLAYGO
55 I Y<0 S %=0 W !,"Unable to QUEUE at this time" G ASK
56 S DIE="^PRC(442.9,",DA=+Y,DR="2////"_+PRC("PER")_";1////"_PRCFA("PODA")_";3//T;4////"_$S('$D(PRCFA("RETRANS")):"",1:1) D ^DIE K DIE,DR
57 I $D(Y) S DIK="^PRC(442.9," D ^DIK K DIK,DA S X=" Not Queued>*" D MSG^PRCFQ S %=0 G ASKX
58 S X=" Receiving report has been put on transmission list.*" D MSG^PRCFQ S %=1
59ASKX K DA
60 Q
61QUEUED() ;Check if in batch already
62 N X,Y S X=$P($G(^PRC(442,+PRCFA("PODA"),0)),U)_"."_PRCFA("PARTIAL") ; + added by REW for Patch 90 to prevent NULL SUB error
63 S Y=$O(^PRC(442.9,"B",X,""))
64 I +Y>0 W !," This Receiving Report is ALREADY Queued for Transmission." Q 1
65 Q 0
66ACCTGPER ;Ask Accounting Period
67 S DA(1)=PRCFA("PODA"),DA=PRCFA("PARTIAL")
68 S DIE="^PRC(442,"_PRCFA("PODA")_",11,",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)"
69 D ^DIE K DA,DIE,DR
70 Q
Note: See TracBrowser for help on using the repository browser.