PRCODJM.m

PRCODJM ;WISC/DJM/BGJ-IFCAP TESTING READER CODE ; 7/22/99 2:19pm

V ;;5.1;IFCAP;**48**;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ; THIS ROUTINE IS CALLED FROM THE OPTION 'PRCO EDI REPORTS'

 ; AT THE 'ENTRY ACTION'.  THE CODE IN THIS ROUTINE WAS ATTEMPTED

 ; TO BE PLACED IN THE ROUTINE 'PRCOER' BUT WHEN 'HELP1' (?? HELP)

 ; WAS SELECTED AND EXITED THE QUESTION/S IN THIS ROUTINE WERE ASKED

 ; AGAIN.  PUTTING THE QUESTION/S HERE ELIMINATED THE PROBLEM.

 ;

BEGIN ; FIND OUT STATUS OF USER.

 K PRCOFLG

 N DIC,DIR

 S USER=$P($G(^VA(200,DUZ,400)),U)

 S SENDER=0

 S PRCOFLG=""

 I USER'>0 S PRCOFLG=-1 D EN^DDIOL("You are not an A&MM EMPLOYEE, exiting option.","","!!?10") G EXIT

 ;

 ; FIND OUT IF USER WANTS TO SEE EVERYTHING.

 ;

 S DIR("A")="Do you want to see all the records now"

 S DIR("B")="Yes"

 S DIR(0)="Y"

 S DIR("?",1)="Answering Yes or Y to this question will let you"

 S DIR("?",2)="see information about all the PHA, RFQ and TXT"

 S DIR("?",3)="transactions from all SENDERs."

 S DIR("?",4)=""

 S DIR("?",5)="Answering No or N will limit you to viewing the"

 S DIR("?",6)="PHA, RFQ and TXT transactions from one SENDER."

 S DIR("?",7)=""

 S DIR("?")="Enter '^' to exit this option."

 D ^DIR

 I Y["^" S PRCOFLG=-1 D EN^DDIOL("Exiting option.","","!!?10") G EXIT

 ;

 ; Y=1 is YES, I want to see all the entries.

 ;

 I Y=1 G EXIT

 ;

SENDER ; COME HERE TO SELECT ONE PERSON THAT ENTERED RECORDS IN FILE 443.75.

 D EN^DDIOL("","","!")

 K DTOUT

 K DUOUT

 K Y

 I $O(^PRC(443.75,"C",DUZ,0))>0 D

 .  S DIC("B")=$P($G(^VA(200,DUZ,0)),U)

 .  Q

 S DIC="^PRC(443.75,"

 S DIC(0)="AEQ"

 S D="C"

 D IX^DIC

 I Y=-1!($D(DTOUT))!($D(DUOUT)) S PRCOFLG=-1 G EXIT

 S:$P(Y,U)>0 SENDER=$P(^PRC(443.75,$P(Y,U),0),U,11)

 ;

EXIT ; LETS QUIT

 I $G(PRCOFLG)'=-1 D

 .  D EN^DDIOL("","","!!")

 .  D WAIT^DICD

 .  Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCODJM   1897     printed  Apr 09, 2024@21:13:34                                                                                                                                                                                                     Page 2

PRCODJM   ;WISC/DJM/BGJ-IFCAP TESTING READER CODE ; 7/22/99 2:19pm

V         ;;5.1;IFCAP;**48**;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;

 +3       ; THIS ROUTINE IS CALLED FROM THE OPTION 'PRCO EDI REPORTS'

 +4       ; AT THE 'ENTRY ACTION'.  THE CODE IN THIS ROUTINE WAS ATTEMPTED

 +5       ; TO BE PLACED IN THE ROUTINE 'PRCOER' BUT WHEN 'HELP1' (?? HELP)

 +6       ; WAS SELECTED AND EXITED THE QUESTION/S IN THIS ROUTINE WERE ASKED

 +7       ; AGAIN.  PUTTING THE QUESTION/S HERE ELIMINATED THE PROBLEM.

 +8       ;

BEGIN     ; FIND OUT STATUS OF USER.

 +1        KILL PRCOFLG

 +2        NEW DIC,DIR

 +3        SET USER=$PIECE($GET(^VA(200,DUZ,400)),U)

 +4        SET SENDER=0

 +5        SET PRCOFLG=""

 +6        IF USER'>0

               SET PRCOFLG=-1

               DO EN^DDIOL("You are not an A&MM EMPLOYEE, exiting option.","","!!?10")

               GOTO EXIT

 +7       ;

 +8       ; FIND OUT IF USER WANTS TO SEE EVERYTHING.

 +9       ;

 +10       SET DIR("A")="Do you want to see all the records now"

 +11       SET DIR("B")="Yes"

 +12       SET DIR(0)="Y"

 +13       SET DIR("?",1)="Answering Yes or Y to this question will let you"

 +14       SET DIR("?",2)="see information about all the PHA, RFQ and TXT"

 +15       SET DIR("?",3)="transactions from all SENDERs."

 +16       SET DIR("?",4)=""

 +17       SET DIR("?",5)="Answering No or N will limit you to viewing the"

 +18       SET DIR("?",6)="PHA, RFQ and TXT transactions from one SENDER."

 +19       SET DIR("?",7)=""

 +20       SET DIR("?")="Enter '^' to exit this option."

 +21       DO ^DIR

 +22       IF Y["^"

               SET PRCOFLG=-1

               DO EN^DDIOL("Exiting option.","","!!?10")

               GOTO EXIT

 +23      ;

 +24      ; Y=1 is YES, I want to see all the entries.

 +25      ;

 +26       IF Y=1

               GOTO EXIT

 +27      ;

SENDER    ; COME HERE TO SELECT ONE PERSON THAT ENTERED RECORDS IN FILE 443.75.

 +1        DO EN^DDIOL("","","!")

 +2        KILL DTOUT

 +3        KILL DUOUT

 +4        KILL Y

 +5        IF $ORDER(^PRC(443.75,"C",DUZ,0))>0

               Begin DoDot:1

 +6                SET DIC("B")=$PIECE($GET(^VA(200,DUZ,0)),U)

 +7                QUIT 

               End DoDot:1

 +8        SET DIC="^PRC(443.75,"

 +9        SET DIC(0)="AEQ"

 +10       SET D="C"

 +11       DO IX^DIC

 +12       IF Y=-1!($DATA(DTOUT))!($DATA(DUOUT))

               SET PRCOFLG=-1

               GOTO EXIT

 +13       if $PIECE(Y,U)>0

               SET SENDER=$PIECE(^PRC(443.75,$PIECE(Y,U),0),U,11)

 +14      ;

EXIT      ; LETS QUIT

 +1        IF $GET(PRCOFLG)'=-1

               Begin DoDot:1

 +2                DO EN^DDIOL("","","!!")

 +3                DO WAIT^DICD

 +4                QUIT 

               End DoDot:1

 +5        QUIT