Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCODJM

PRCODJM.m

Go to the documentation of this file.
  1. PRCODJM ;WISC/DJM/BGJ-IFCAP TESTING READER CODE ; 7/22/99 2:19pm
  1. V ;;5.1;IFCAP;**48**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; THIS ROUTINE IS CALLED FROM THE OPTION 'PRCO EDI REPORTS'
  1. ; AT THE 'ENTRY ACTION'. THE CODE IN THIS ROUTINE WAS ATTEMPTED
  1. ; TO BE PLACED IN THE ROUTINE 'PRCOER' BUT WHEN 'HELP1' (?? HELP)
  1. ; WAS SELECTED AND EXITED THE QUESTION/S IN THIS ROUTINE WERE ASKED
  1. ; AGAIN. PUTTING THE QUESTION/S HERE ELIMINATED THE PROBLEM.
  1. ;
  1. BEGIN ; FIND OUT STATUS OF USER.
  1. K PRCOFLG
  1. N DIC,DIR
  1. S USER=$P($G(^VA(200,DUZ,400)),U)
  1. S SENDER=0
  1. S PRCOFLG=""
  1. I USER'>0 S PRCOFLG=-1 D EN^DDIOL("You are not an A&MM EMPLOYEE, exiting option.","","!!?10") G EXIT
  1. ;
  1. ; FIND OUT IF USER WANTS TO SEE EVERYTHING.
  1. ;
  1. S DIR("A")="Do you want to see all the records now"
  1. S DIR("B")="Yes"
  1. S DIR(0)="Y"
  1. S DIR("?",1)="Answering Yes or Y to this question will let you"
  1. S DIR("?",2)="see information about all the PHA, RFQ and TXT"
  1. S DIR("?",3)="transactions from all SENDERs."
  1. S DIR("?",4)=""
  1. S DIR("?",5)="Answering No or N will limit you to viewing the"
  1. S DIR("?",6)="PHA, RFQ and TXT transactions from one SENDER."
  1. S DIR("?",7)=""
  1. S DIR("?")="Enter '^' to exit this option."
  1. D ^DIR
  1. I Y["^" S PRCOFLG=-1 D EN^DDIOL("Exiting option.","","!!?10") G EXIT
  1. ;
  1. ; Y=1 is YES, I want to see all the entries.
  1. ;
  1. I Y=1 G EXIT
  1. ;
  1. SENDER ; COME HERE TO SELECT ONE PERSON THAT ENTERED RECORDS IN FILE 443.75.
  1. D EN^DDIOL("","","!")
  1. K DTOUT
  1. K DUOUT
  1. K Y
  1. I $O(^PRC(443.75,"C",DUZ,0))>0 D
  1. . S DIC("B")=$P($G(^VA(200,DUZ,0)),U)
  1. . Q
  1. S DIC="^PRC(443.75,"
  1. S DIC(0)="AEQ"
  1. S D="C"
  1. D IX^DIC
  1. I Y=-1!($D(DTOUT))!($D(DUOUT)) S PRCOFLG=-1 G EXIT
  1. S:$P(Y,U)>0 SENDER=$P(^PRC(443.75,$P(Y,U),0),U,11)
  1. ;
  1. EXIT ; LETS QUIT
  1. I $G(PRCOFLG)'=-1 D
  1. . D EN^DDIOL("","","!!")
  1. . D WAIT^DICD
  1. . Q
  1. Q