PRCFINQ ;WISC/CLH,LEM-AUDIT REPORTS ;3/18/93 9:01 AM
V ;;5.1;IFCAP;**185**;Oct 20, 2000;Build 3
;Per VHA Directive 2004-038, this routine should not be modified.
;
;PRC*5.1*185 Add switch PRCPRTTF to inquiry EN1 & EN3 to prevent
; the full PCARD number from displaying. Modified files
; 410 & 442 PCARD number field to display last 4 digits
; of PCARD number when switch set to on.
;
;FULL INQUIRE TO FILE 410
EN1 S PRCPRTTF=1,DIC=410,DIC(0)="AEMQ",DIC("A")="Select CONTROL POINT ACTIVITY NUMBER: " D ^DIC G Q:+Y<0 W:$D(IOF) @IOF W !!,"Processing History for:",!!,$C(7) S DA=+Y,DIQ(0)="AC" D EN^DIQ G EN1 ;PRC*5.1*185
;FULL INQUIRE TO FILE 430
EN2 I '$D(^DIC(430)) S X="No Accounts Receivable information available in File 430 on this system.*" D MSG^PRCFQ G Q
S DIC=430,DIC(0)="AEMQ",DIC("A")="Select ACCOUNTS RECEIVABLE NUMBER: " D ^DIC G Q:+Y<0 W:$D(IOF) @IOF W !!,"Processing History for:",!!,$C(7) S DA=+Y,DIQ(0)="AC" D EN^DIQ G EN2
;FULL INQUIRE TO FILE 442
EN3 S PRCPRTTF=1,DIC=442,DIC(0)="AEMQ" D ^DIC G Q:+Y<0 W:$D(IOF) @IOF W !!,"Processing History for:",!!,$C(7) S DA=+Y,DIQ(0)="AC" D EN^DIQ G EN3 ;PRC*5.1*185
Q K PRCPRTTF,DIC,X,Y,DA,DIQ Q ;PRC*5.1*185
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFINQ 1239 printed Oct 16, 2024@18:04:54 Page 2
PRCFINQ ;WISC/CLH,LEM-AUDIT REPORTS ;3/18/93 9:01 AM
V ;;5.1;IFCAP;**185**;Oct 20, 2000;Build 3
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;
+3 ;PRC*5.1*185 Add switch PRCPRTTF to inquiry EN1 & EN3 to prevent
+4 ; the full PCARD number from displaying. Modified files
+5 ; 410 & 442 PCARD number field to display last 4 digits
+6 ; of PCARD number when switch set to on.
+7 ;
+8 ;FULL INQUIRE TO FILE 410
EN1 ;PRC*5.1*185
SET PRCPRTTF=1
SET DIC=410
SET DIC(0)="AEMQ"
SET DIC("A")="Select CONTROL POINT ACTIVITY NUMBER: "
DO ^DIC
if +Y<0
GOTO Q
if $DATA(IOF)
WRITE @IOF
WRITE !!,"Processing History for:",!!,$CHAR(7)
SET DA=+Y
SET DIQ(0)="AC"
DO EN^DIQ
GOTO EN1
+1 ;FULL INQUIRE TO FILE 430
EN2 IF '$DATA(^DIC(430))
SET X="No Accounts Receivable information available in File 430 on this system.*"
DO MSG^PRCFQ
GOTO Q
+1 SET DIC=430
SET DIC(0)="AEMQ"
SET DIC("A")="Select ACCOUNTS RECEIVABLE NUMBER: "
DO ^DIC
if +Y<0
GOTO Q
if $DATA(IOF)
WRITE @IOF
WRITE !!,"Processing History for:",!!,$CHAR(7)
SET DA=+Y
SET DIQ(0)="AC"
DO EN^DIQ
GOTO EN2
+2 ;FULL INQUIRE TO FILE 442
EN3 ;PRC*5.1*185
SET PRCPRTTF=1
SET DIC=442
SET DIC(0)="AEMQ"
DO ^DIC
if +Y<0
GOTO Q
if $DATA(IOF)
WRITE @IOF
WRITE !!,"Processing History for:",!!,$CHAR(7)
SET DA=+Y
SET DIQ(0)="AC"
DO EN^DIQ
GOTO EN3
Q ;PRC*5.1*185
KILL PRCPRTTF,DIC,X,Y,DA,DIQ
QUIT
