- 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 ---[H[J[2J[HPRCODJM 1897 printed Jan 18, 2025@03:12:53 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