Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCFARRT

PRCFARRT.m

Go to the documentation of this file. 
  1. PRCFARRT ;WISC@ALTOONA/CTB-SEND RECEIVING REPORT TO AUSTIN ;9/21/94  10:52
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  D:$D(ZTQUEUED) KILL^%ZTLOAD
  1.  I '$D(PRCFA("RETRANS")) D BUILD Q:$G(LCKFLG)  D CREATE Q
  1.  S PRCACT="M"
  1.  D BUILD Q:$G(LCKFLG)
  1.  D RETRANS Q
  1. BUILD ;BUILD MESSAGE IN UTILITY AND TRANSMIT
  1.  S PRCFPO=PRCFA("PODA"),PRCFPR=PRCFA("PARTIAL")
  1.  D EN^PRCFARR Q:$G(LCKFLG) 
  1.  ;SET VARIABLES FOR MAILMAN AND TRANSMIT
  1.  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_","
  1.  ;
  1.  ; Note: CRD was changed to CRT for 5.0 lab testing only.  It needs
  1.  ;       to be changed back before 5.0 is released for Alpha test.
  1.  ;
  1.  S XMY(XMDUZ)=""
  1.  S XMY("XXX@Q-CRD.DOMAIN.EXT")="" ;,DIC=3.8,DIC(0)="MOX",X="CRD" D ^DIC K DIC I Y<0 S XMY(.5)=""
  1.  ;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)=""
  1.  D ^XMD K ^TMP("PRCFARR",$J) Q
  1. CREATE ;CREATE TRANSMISSION RECORD
  1.  S (X,BATCH)=PRC("SITE")_"-RR-"_$P($P(^PRC(442,PRCFA("PODA"),0),"^"),"-",2)_"-"_PRCFA("PARTIAL")
  1.  S DIC=421.2,DLAYGO=DIC,DIC(0)="MOL" D ^DIC K DIC,DLAYGO Q:Y<0
  1.  S DA=+Y
  1.  D NOW^PRCFQ
  1.  S $P(^PRCF(421.2,DA,0),"^",3,4)="R^"_%X
  1.  S $P(^PRCF(421.2,DA,0),"^",11,12)=DUZ_"^"_XMZ
  1.  K %X,%Y,X,Y
  1.  S MESSAGE=""
  1.  D ENCODE^PRCFAES1(DA,+PRC("PER"),.MESSAGE)
  1.  K MESSAGE
  1.  S ^PRCF(421.2,"D",XMZ,DA)=""
  1.  ;ENTER BATCH # INTO 442
  1.  S $P(^PRC(442,PRCFA("PODA"),11,PRCFA("PARTIAL"),0),"^",19)=BATCH K BATCH
  1.  Q
  1. RETRANS ;CREATE RETRANSMISSION RECORD
  1.  S (X,BATCH)=PRC("SITE")_"-RR-"_$P($P(^PRC(442,PRCFA("PODA"),0),"^"),"-",2)_"-"_PRCFA("PARTIAL")
  1.  S DIC=421.2,DIC(0)="MO" D ^DIC K DIC,DLAYGO G:Y<0 CREATE
  1.  S DA=+Y
  1.  D NOW^PRCFQ
  1.  S XX=^PRCF(421.2,DA,0)
  1.  S $P(XX,"^",4)=%X,$P(XX,"^",12)=XMZ,^PRCF(421.2,DA,0)=XX
  1.  K %X,%Y,X,Y
  1.  D REMOVE^PRCFAES2(DA)
  1.  I $P(XX,"^",12)]"" K ^PRCF(421.2,"D",$P(XX,"^",12),DA)
  1.  S MESSAGE=""
  1.  D ENCODE^PRCFAES2(DA,PRC("PER"),.MESSAGE)
  1.  K MESSAGE
  1.  S ^PRCF(421.2,"D",XMZ,DA)=""
  1. OUT Q
  1. PRINT ;RECEIVING REPORT HISTORY REPORT
  1.  S PRCF("X")="AS" D ^PRCFSITE Q:'%
  1.  S DIC="^PRCF(421.2,",L=0,(BY,FLDS)="[PRCFA RR INQUIRY LISTING]",FR=",?,"_PRC("SITE"),TO=",?,"_PRC("SITE")+1 D EN1^DIP Q