PRCFARRQ ;WISC@ALTOONA/CTB-QUEUE RECEIVING REPORT FOR TRANSMISSION ;7/18/95 12:05
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
LOAD Q:$$QUEUED
Q:$P(^PRC(442,PRCFA("PODA"),0),U,2)=25
S X=$P(PRC("PARAM"),"^",6),X=$S(X=1:"NOW",X=2:"LATER",1:"MAIL") D @X Q
NOW I '$D(^XUSEC("PRCFA TRANSMIT",DUZ)) G LATER
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
I %'=1 S X=" Receiving Report has NOT been released to Austin.*" D MSG^PRCFQ Q
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
S X="Receiving Report Queued for Immediate Transmission*" D MSG^PRCFQ Q
LATER ;STORE DATA IN FILE 442.9 FOR LATER RELEASE OF RECEIVING REPORT
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
I %'=1 S X=" Receiving Report has NOT been released to Austin.*" D MSG^PRCFQ Q
I $G(PRCACT)="E",$P(^PRC(442,PRCFA("PODA"),11,PRCFA("PARTIAL"),0),"^",19)]"" D Q
. W !!?5,"This receiving report has already been transmitted to Austin."
. W !?5,"It may NOT be rereleased using this option."
. W !?5,"RECEIVING REPORT HAS NOT BEEN RELEASED.",$C(7)
. Q
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
I +Y<0 W !,"Unable to Queue at this time, Please use option to queue manually.",$C(7) Q
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
S X="Receiving report placed on transmission list.*" D MSG^PRCFQ
Q
MAIL S X="Don't forget to mail this Receiving Report to Austin.*" D MSG^PRCFQ
Q
SINGLE ;QUEUE SINGLE RECEIVING REPORT FOR TRANSMISSION
S PRCF("X")="AS" D ^PRCFSITE Q:'% S DIC("A")="Select PURCHASE ORDER NUMBER: "
S1 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
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
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
S PRCFA("PARTIAL")=+Y
D ACCTGPER G OUT:$D(DTOUT)!$D(DUOUT)!$D(Y)
I '$$QUEUED D ASK I '% S X=" <No Action Taken>*" D MSG^PRCFQ
S2 S DIC("A")="Select Next PURCHASE ORDER NUMBER: "
G S1
OUT K D,D0,DA,DI,DIC,DIE,DQ,DR,PRCFA Q
RETRANS ;RETRANSMIT SINGLE RECEIVING REPORT
S PRCF("X")="AS" D ^PRCFSITE Q:'% S DIC("A")="Select PURCHASE ORDER NUMBER: "
R1 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
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
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
S PRCFA("PARTIAL")=+Y,PRCFA("RETRANS")=""
D ACCTGPER G OUT:$D(DTOUT)!$D(DUOUT)!$D(Y)
I '$$QUEUED D ASK I '% S X=" <No action taken>*" D MSG^PRCFQ
R2 S DIC("A")="Select Next PURCHASE ORDER NUMBER: "
G R1
ASK ;ASK NOW OR LATER ANSWER IN % 1=NOW, 2=LATER -1=ABORT
K DA
I '$D(^XUSEC("PRCFA TRANSMIT",DUZ)) S %=2 G ASK1
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'"
S %B(2)="Option. An '^' will terminate this option." D ^PRCFYN
ASK1 G:%<0 ASKX I %=1 D NOW S %=1 G ASKX
S X=$P(^PRC(442,PRCFA("PODA"),0),"^")_"."_PRCFA("PARTIAL"),DIC=442.9,DIC(0)="ML",DLAYGO=442.9 D ^DIC K DIC,DLAYGO
I Y<0 S %=0 W !,"Unable to QUEUE at this time" G ASK
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
I $D(Y) S DIK="^PRC(442.9," D ^DIK K DIK,DA S X=" Not Queued>*" D MSG^PRCFQ S %=0 G ASKX
S X=" Receiving report has been put on transmission list.*" D MSG^PRCFQ S %=1
ASKX K DA
Q
QUEUED() ;Check if in batch already
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
S Y=$O(^PRC(442.9,"B",X,""))
I +Y>0 W !," This Receiving Report is ALREADY Queued for Transmission." Q 1
Q 0
ACCTGPER ;Ask Accounting Period
S DA(1)=PRCFA("PODA"),DA=PRCFA("PARTIAL")
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)"
D ^DIE K DA,DIE,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFARRQ 4943 printed Apr 09, 2024@21:00:30 Page 2
PRCFARRQ ;WISC@ALTOONA/CTB-QUEUE RECEIVING REPORT FOR TRANSMISSION ;7/18/95 12:05
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
LOAD if $$QUEUED
QUIT
+1 if $PIECE(^PRC(442,PRCFA("PODA"),0),U,2)=25
QUIT
+2 SET X=$PIECE(PRC("PARAM"),"^",6)
SET X=$SELECT(X=1:"NOW",X=2:"LATER",1:"MAIL")
DO @X
QUIT
NOW IF '$DATA(^XUSEC("PRCFA TRANSMIT",DUZ))
GOTO LATER
+1 SET %A="Are you sure you wish to send this Receiving Report to Austin"
SET %B="A 'NO' or an '^' will prevent release to Austin."
SET %=1
DO ^PRCFYN
+2 IF %'=1
SET X=" Receiving Report has NOT been released to Austin.*"
DO MSG^PRCFQ
QUIT
+3 SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTSAVE("PRC*")=""
SET ZTSAVE("PRCFA*")=""
SET ZTDESC="TRANSMIT RR "_$PIECE(^PRC(442,PRCFA("PODA"),0),"^")_"-"_PRCFA("PARTIAL")_" TO AUSTIN"
SET ZTRTN="^PRCFARRT"
DO ^%ZTLOAD
KILL ZTSK
+4 SET X="Receiving Report Queued for Immediate Transmission*"
DO MSG^PRCFQ
QUIT
LATER ;STORE DATA IN FILE 442.9 FOR LATER RELEASE OF RECEIVING REPORT
+1 SET %A="Are you sure you wish to send this Receiving Report to Austin"
SET %B="A 'NO' or an '^' will prevent release to Austin."
SET %=1
DO ^PRCFYN
+2 IF %'=1
SET X=" Receiving Report has NOT been released to Austin.*"
DO MSG^PRCFQ
QUIT
+3 IF $GET(PRCACT)="E"
IF $PIECE(^PRC(442,PRCFA("PODA"),11,PRCFA("PARTIAL"),0),"^",19)]""
Begin DoDot:1
+4 WRITE !!?5,"This receiving report has already been transmitted to Austin."
+5 WRITE !?5,"It may NOT be rereleased using this option."
+6 WRITE !?5,"RECEIVING REPORT HAS NOT BEEN RELEASED.",$CHAR(7)
+7 QUIT
End DoDot:1
QUIT
+8 SET DIC=442.9
SET DIC(0)="ML"
SET DLAYGO=442.9
SET X=$PIECE(^PRC(442,PRCFA("PODA"),0),"^",1)_"."_PRCFA("PARTIAL")
DO ^DIC
KILL DIC,DLAYGO
+9 IF +Y<0
WRITE !,"Unable to Queue at this time, Please use option to queue manually.",$CHAR(7)
QUIT
+10 SET DA=+Y
SET DR="1////"_PRCFA("PODA")_";2////"_+PRC("PER")_";3//T;4////"_$SELECT('$DATA(PRCFA("RETRANS")):"",1:1)
SET DIE="^PRC(442.9,"
DO ^DIE
+11 SET X="Receiving report placed on transmission list.*"
DO MSG^PRCFQ
+12 QUIT
MAIL SET X="Don't forget to mail this Receiving Report to Austin.*"
DO MSG^PRCFQ
+1 QUIT
SINGLE ;QUEUE SINGLE RECEIVING REPORT FOR TRANSMISSION
+1 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
SET DIC("A")="Select PURCHASE ORDER NUMBER: "
S1 SET DIC="^PRC(442,"
SET DIC(0)="AEQM"
SET DIC("S")="I $O(^PRC(442,+Y,11,0)),+^PRC(442,+Y,0)=PRC(""SITE""),$P(^PRC(442,+Y,0),U,2)'=25"
DO ^DIC
KILL DIC
if Y<0
GOTO OUT
SET DA(1)=+Y
SET PRCFA("PODA")=+Y
+1 SET DIC("A")="Select Partial Number: "
SET DIC="^PRC(442,"_DA(1)_",11,"
SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
IF Y<1
KILL PRCFA
GOTO OUT
+2 IF $PIECE(^PRC(442,PRCFA("PODA"),11,+Y,0),"^",19)]""
WRITE !!,"This partial has already been transmitted to Austin. <No Action Taken>",$CHAR(7)
GOTO S2
+3 SET PRCFA("PARTIAL")=+Y
+4 DO ACCTGPER
if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(Y)
GOTO OUT
+5 IF '$$QUEUED
DO ASK
IF '%
SET X=" <No Action Taken>*"
DO MSG^PRCFQ
S2 SET DIC("A")="Select Next PURCHASE ORDER NUMBER: "
+1 GOTO S1
OUT KILL D,D0,DA,DI,DIC,DIE,DQ,DR,PRCFA
QUIT
RETRANS ;RETRANSMIT SINGLE RECEIVING REPORT
+1 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
SET DIC("A")="Select PURCHASE ORDER NUMBER: "
R1 SET DIC="^PRC(442,"
SET DIC(0)="AEQM"
SET DIC("S")="I $O(^PRC(442,+Y,11,0)),+^PRC(442,+Y,0)=PRC(""SITE""),$P(^PRC(442,+Y,0),U,2)'=25"
DO ^DIC
KILL DIC
if Y<0
GOTO OUT
SET DA(1)=+Y
SET PRCFA("PODA")=+Y
+1 SET DIC("A")="Select Partial Number: "
SET DIC="^PRC(442,"_DA(1)_",11,"
SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
IF Y<1
KILL PRCFA
GOTO OUT
+2 IF $PIECE(^PRC(442,PRCFA("PODA"),11,+Y,0),"^",19)=""
WRITE !!,"This partial has not yet been transmitted to Austin. <No Action Taken>",$CHAR(7)
GOTO R2
+3 SET PRCFA("PARTIAL")=+Y
SET PRCFA("RETRANS")=""
+4 DO ACCTGPER
if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(Y)
GOTO OUT
+5 IF '$$QUEUED
DO ASK
IF '%
SET X=" <No action taken>*"
DO MSG^PRCFQ
R2 SET DIC("A")="Select Next PURCHASE ORDER NUMBER: "
+1 GOTO R1
ASK ;ASK NOW OR LATER ANSWER IN % 1=NOW, 2=LATER -1=ABORT
+1 KILL DA
+2 IF '$DATA(^XUSEC("PRCFA TRANSMIT",DUZ))
SET %=2
GOTO ASK1
+3 SET %=2
SET %A="Do you want this transmitted immediately"
SET %B="A 'YES' will cause the receiving report to go to Austin immediately."
SET %B(1)="A 'NO' will queue it for release using the 'Transmit Receiving Reports'"
+4 SET %B(2)="Option. An '^' will terminate this option."
DO ^PRCFYN
ASK1 if %<0
GOTO ASKX
IF %=1
DO NOW
SET %=1
GOTO ASKX
+1 SET X=$PIECE(^PRC(442,PRCFA("PODA"),0),"^")_"."_PRCFA("PARTIAL")
SET DIC=442.9
SET DIC(0)="ML"
SET DLAYGO=442.9
DO ^DIC
KILL DIC,DLAYGO
+2 IF Y<0
SET %=0
WRITE !,"Unable to QUEUE at this time"
GOTO ASK
+3 SET DIE="^PRC(442.9,"
SET DA=+Y
SET DR="2////"_+PRC("PER")_";1////"_PRCFA("PODA")_";3//T;4////"_$SELECT('$DATA(PRCFA("RETRANS")):"",1:1)
DO ^DIE
KILL DIE,DR
+4 IF $DATA(Y)
SET DIK="^PRC(442.9,"
DO ^DIK
KILL DIK,DA
SET X=" Not Queued>*"
DO MSG^PRCFQ
SET %=0
GOTO ASKX
+5 SET X=" Receiving report has been put on transmission list.*"
DO MSG^PRCFQ
SET %=1
ASKX KILL DA
+1 QUIT
QUEUED() ;Check if in batch already
+1 ; + added by REW for Patch 90 to prevent NULL SUB error
NEW X,Y
SET X=$PIECE($GET(^PRC(442,+PRCFA("PODA"),0)),U)_"."_PRCFA("PARTIAL")
+2 SET Y=$ORDER(^PRC(442.9,"B",X,""))
+3 IF +Y>0
WRITE !," This Receiving Report is ALREADY Queued for Transmission."
QUIT 1
+4 QUIT 0
ACCTGPER ;Ask Accounting Period
+1 SET DA(1)=PRCFA("PODA")
SET DA=PRCFA("PARTIAL")
+2 SET DIE="^PRC(442,"_PRCFA("PODA")_",11,"
SET 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)"
+3 DO ^DIE
KILL DA,DIE,DR
+4 QUIT
