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