PRCFINQ.m

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 ---PRCFINQ   1239     printed  Apr 09, 2024@21:03:41                                                                                                                                                                                                     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