| [613] | 1 | PRCFARRT ;WISC@ALTOONA/CTB-SEND RECEIVING REPORT TO AUSTIN ;9/21/94 10:52
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D:$D(ZTQUEUED) KILL^%ZTLOAD
|
|---|
| 5 | I '$D(PRCFA("RETRANS")) D BUILD Q:$G(LCKFLG) D CREATE Q
|
|---|
| 6 | S PRCACT="M"
|
|---|
| 7 | D BUILD Q:$G(LCKFLG)
|
|---|
| 8 | D RETRANS Q
|
|---|
| 9 | BUILD ;BUILD MESSAGE IN UTILITY AND TRANSMIT
|
|---|
| 10 | S PRCFPO=PRCFA("PODA"),PRCFPR=PRCFA("PARTIAL")
|
|---|
| 11 | D EN^PRCFARR Q:$G(LCKFLG)
|
|---|
| 12 | ;SET VARIABLES FOR MAILMAN AND TRANSMIT
|
|---|
| 13 | S XMDUZ=$S($D(DUZ)#2:DUZ,1:.5),XMSUB="RECEIVING REPORT "_$P(^PRC(442,PRCFA("PODA"),0),"^",1)_" PARTIAL #: "_PRCFA("PARTIAL"),XMTEXT="^TMP(""PRCFARR"","_$J_","
|
|---|
| 14 | ;
|
|---|
| 15 | ; Note: CRD was changed to CRT for 5.0 lab testing only. It needs
|
|---|
| 16 | ; to be changed back before 5.0 is released for Alpha test.
|
|---|
| 17 | ;
|
|---|
| 18 | S XMY(XMDUZ)=""
|
|---|
| 19 | S XMY("XXX@Q-CRD.VA.GOV")="" ;,DIC=3.8,DIC(0)="MOX",X="CRD" D ^DIC K DIC I Y<0 S XMY(.5)=""
|
|---|
| 20 | ;I Y>0 S DA=+Y,D1=0 F I=1:1 S D1=$O(^XMB(3.8,DA,1,"B",D1)) Q:'D1 S XMY(D1)=""
|
|---|
| 21 | D ^XMD K ^TMP("PRCFARR",$J) Q
|
|---|
| 22 | CREATE ;CREATE TRANSMISSION RECORD
|
|---|
| 23 | S (X,BATCH)=PRC("SITE")_"-RR-"_$P($P(^PRC(442,PRCFA("PODA"),0),"^"),"-",2)_"-"_PRCFA("PARTIAL")
|
|---|
| 24 | S DIC=421.2,DLAYGO=DIC,DIC(0)="MOL" D ^DIC K DIC,DLAYGO Q:Y<0
|
|---|
| 25 | S DA=+Y
|
|---|
| 26 | D NOW^PRCFQ
|
|---|
| 27 | S $P(^PRCF(421.2,DA,0),"^",3,4)="R^"_%X
|
|---|
| 28 | S $P(^PRCF(421.2,DA,0),"^",11,12)=DUZ_"^"_XMZ
|
|---|
| 29 | K %X,%Y,X,Y
|
|---|
| 30 | S MESSAGE=""
|
|---|
| 31 | D ENCODE^PRCFAES1(DA,+PRC("PER"),.MESSAGE)
|
|---|
| 32 | K MESSAGE
|
|---|
| 33 | S ^PRCF(421.2,"D",XMZ,DA)=""
|
|---|
| 34 | ;ENTER BATCH # INTO 442
|
|---|
| 35 | S $P(^PRC(442,PRCFA("PODA"),11,PRCFA("PARTIAL"),0),"^",19)=BATCH K BATCH
|
|---|
| 36 | Q
|
|---|
| 37 | RETRANS ;CREATE RETRANSMISSION RECORD
|
|---|
| 38 | S (X,BATCH)=PRC("SITE")_"-RR-"_$P($P(^PRC(442,PRCFA("PODA"),0),"^"),"-",2)_"-"_PRCFA("PARTIAL")
|
|---|
| 39 | S DIC=421.2,DIC(0)="MO" D ^DIC K DIC,DLAYGO G:Y<0 CREATE
|
|---|
| 40 | S DA=+Y
|
|---|
| 41 | D NOW^PRCFQ
|
|---|
| 42 | S XX=^PRCF(421.2,DA,0)
|
|---|
| 43 | S $P(XX,"^",4)=%X,$P(XX,"^",12)=XMZ,^PRCF(421.2,DA,0)=XX
|
|---|
| 44 | K %X,%Y,X,Y
|
|---|
| 45 | D REMOVE^PRCFAES2(DA)
|
|---|
| 46 | I $P(XX,"^",12)]"" K ^PRCF(421.2,"D",$P(XX,"^",12),DA)
|
|---|
| 47 | S MESSAGE=""
|
|---|
| 48 | D ENCODE^PRCFAES2(DA,PRC("PER"),.MESSAGE)
|
|---|
| 49 | K MESSAGE
|
|---|
| 50 | S ^PRCF(421.2,"D",XMZ,DA)=""
|
|---|
| 51 | OUT Q
|
|---|
| 52 | PRINT ;RECEIVING REPORT HISTORY REPORT
|
|---|
| 53 | S PRCF("X")="AS" D ^PRCFSITE Q:'%
|
|---|
| 54 | S DIC="^PRCF(421.2,",L=0,(BY,FLDS)="[PRCFA RR INQUIRY LISTING]",FR=",?,"_PRC("SITE"),TO=",?,"_PRC("SITE")+1 D EN1^DIP Q
|
|---|
