| [613] | 1 | PRCPSSQT ;WISC/CC-Request GIP QOH be overwitten by supply station values ;04/01
|
|---|
| 2 | V ;;5.1;IFCAP;**24**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ; option requires multiple keys and other access privileges.
|
|---|
| 5 | N %,%DT,DA,DIE,DIR,DR,DTOUT,DUOUT,PRCPACT,PRCPDATA,PRCPNEXT
|
|---|
| 6 | N PRCPREQ,PRCPSTOP,PRCPTIME,X,Y,%
|
|---|
| 7 | ;
|
|---|
| 8 | I '$D(PRCP("DPTYPE")) S PRCP("DPTYPE")="S"
|
|---|
| 9 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 10 | I PRCP("DPTYPE")'="S" Q
|
|---|
| 11 | I $P($G(^PRCP(445,PRCP("I"),5)),"^",1)']"" D EN^DDIOL("This secondary is not linked to a supply station") Q
|
|---|
| 12 | I '$$KEY^PRCPUREP("PRCP2 MGRKEY",DUZ) D EN^DDIOL("You must be a secondary inventory point manager to user this option.") Q
|
|---|
| 13 | I '$$KEY^PRCPUREP("PRCPSSQOH",DUZ) D EN^DDIOL("You must be authorized to request an adjustment to supply station values") Q
|
|---|
| 14 | I '$D(^PRCP(445,PRCP("I"),8,DUZ,0)) D Q
|
|---|
| 15 | . D EN^DDIOL("You may not request an update for this inventory point.")
|
|---|
| 16 | . D EN^DDIOL("Please contact your application coordinator.")
|
|---|
| 17 | ;
|
|---|
| 18 | L +^PRCP(445,PRCP("I"),7):3 I $T=0 D EN^DDIOL("The request file is busy. Please try again later.") Q
|
|---|
| 19 | D ADD^PRCPULOC(445,PRCP("I")_"-7",0,"Request GIP Quantity Replacement")
|
|---|
| 20 | S PRCPSTOP=0
|
|---|
| 21 | ;
|
|---|
| 22 | ; check to see if request is pending - allow deletion if exists
|
|---|
| 23 | S PRCPREQ=$G(^PRCP(445,PRCP("I"),7))
|
|---|
| 24 | I $P(PRCPREQ,"^")]"" D I PRCPSTOP G EXIT
|
|---|
| 25 | . S Y=$P(PRCPREQ,"^",2) X ^DD("DD")
|
|---|
| 26 | . S PRCPTIME=Y
|
|---|
| 27 | . D EN^DDIOL(" ")
|
|---|
| 28 | . N DA,DIE,DIR,DR
|
|---|
| 29 | . S DIR(0)="Y"
|
|---|
| 30 | . S DIR("A",1)=$P(^VA(200,+PRCPREQ,0),"^")_" made a request on "_PRCPTIME
|
|---|
| 31 | . S DIR("A",2)=" "
|
|---|
| 32 | . S DIR("A")="Do you wish to remove this"
|
|---|
| 33 | . S DIR("?")="Enter 'Y' or 'YES' to delete the current request"
|
|---|
| 34 | . S DIR("?",1)="Enter 'N' or 'NO' to retain the current request and quit"
|
|---|
| 35 | . D ^DIR
|
|---|
| 36 | . I $D(DUOUT)!$D(DTOUT) S PRCPSTOP=1 Q
|
|---|
| 37 | . I Y=0 S PRCPSTOP=1 Q
|
|---|
| 38 | . S DIE="^PRCP(445,",DA=PRCP("I"),DR="24////@;25////@"
|
|---|
| 39 | . D ^DIE
|
|---|
| 40 | . D EN^DDIOL("The current request has been deleted.")
|
|---|
| 41 | . Q
|
|---|
| 42 | ;
|
|---|
| 43 | K X S X(1)="WARNING: USE THIS OPTION ONLY IF THE INTERFACE IS FUNCTIONING WELL AND IS "
|
|---|
| 44 | S X(2)=" UP-TO-DATE ON PROCESSING TRANSACTIONS."
|
|---|
| 45 | D DISPLAY^PRCPUX2(1,79,.X)
|
|---|
| 46 | D EN^DDIOL(" ")
|
|---|
| 47 | D EN^DDIOL("Your name will be on the Transaction Register for all adjusted items.")
|
|---|
| 48 | D EN^DDIOL("Please keep any records needed to justify these adjustments.")
|
|---|
| 49 | ;
|
|---|
| 50 | ; ask if they wish to proceed.
|
|---|
| 51 | D EN^DDIOL(" ")
|
|---|
| 52 | S DIR(0)="Y"
|
|---|
| 53 | S DIR("A")="Do you wish to create a new request"
|
|---|
| 54 | D ^DIR K DIR
|
|---|
| 55 | I $D(DUOUT)!$D(DTOUT) G EXIT
|
|---|
| 56 | I Y=0 D EN^DDIOL("No request created.") G EXIT
|
|---|
| 57 | ;
|
|---|
| 58 | I $$ORDCHK^PRCPUITM(0,+PRCP("I"),"R","R") D G EXIT
|
|---|
| 59 | . D EN^DDIOL(" ")
|
|---|
| 60 | . D EN^DDIOL("This inventory has released orders that are not yet posted.")
|
|---|
| 61 | . D EN^DDIOL("YOU MUST FIRST POST OR DELETE ALL RELEASED ORDERS ON THIS INVENTORY POINT.")
|
|---|
| 62 | ;
|
|---|
| 63 | D EN^DDIOL(" ")
|
|---|
| 64 | S DIR("A")="Is recent supply station activity on the transaction register"
|
|---|
| 65 | S DIR(0)="Y"
|
|---|
| 66 | D ^DIR K DIR
|
|---|
| 67 | I Y=0 D I PRCPSTOP G EXIT
|
|---|
| 68 | . S X(1)="Do not run this option until you know the interface is working correctly. "
|
|---|
| 69 | . S X(2)="Call your IRM to verify:"
|
|---|
| 70 | . S X(3)="1) TaskMan is running"
|
|---|
| 71 | . S X(4)="2) PRCP2 SUPPLY STATION TXN RUN is scheduled for every 3-5 minutes."
|
|---|
| 72 | . S X(5)="3) The interface links are set up properly and are open."
|
|---|
| 73 | . D DISPLAY^PRCPUX2(1,79,.X)
|
|---|
| 74 | . S PRCPSTOP=1
|
|---|
| 75 | ;
|
|---|
| 76 | ; check for unprocessed transactions, stop if first transaction is older than 20 minutes
|
|---|
| 77 | S PRCPNEXT=$O(^PRCP(447.1,"C",+PRCP("PAR"),PRCP("I"),""))
|
|---|
| 78 | I PRCPNEXT]"" D I PRCPSTOP=1 G EXIT
|
|---|
| 79 | . ; get info about txn, if older than 20 minutes, stop
|
|---|
| 80 | . N DIR,PRCPACT,PRCPTIME
|
|---|
| 81 | . D EN^DDIOL(" ")
|
|---|
| 82 | . D EN^DDIOL("There are supply station transactions waiting to be processed.")
|
|---|
| 83 | . S PRCPDATA=^PRCP(447.1,PRCPNEXT,0)
|
|---|
| 84 | . S %DT="S",Y=$P(PRCPDATA,"^",4) D DD^%DT S PRCPACT=Y
|
|---|
| 85 | . D EN^DDIOL("The oldest transaction was created at "_PRCPACT)
|
|---|
| 86 | . S %DT="S",Y=$P(PRCPDATA,"^",8) D DD^%DT S PRCPTIME=Y
|
|---|
| 87 | . D EN^DDIOL("and was received by VistA at "_PRCPTIME)
|
|---|
| 88 | . S Y=$P(PRCPDATA,"^",8) D NOW^%DTC
|
|---|
| 89 | . I %-Y>.002 D S PRCPSTOP=1 QUIT
|
|---|
| 90 | . . S X(1)="This is more than 20 minutes ago. You may not proceed until these"
|
|---|
| 91 | . . S X(2)="transactions are processed. Call IRM and verify the PRCP2 Supply Station"
|
|---|
| 92 | . . S X(3)="TXN Run option is scheduled to run every 3 to 5 minutes in TaskMan."
|
|---|
| 93 | . . D DISPLAY^PRCPUX2(1,79,.X)
|
|---|
| 94 | . S Y=$P(PRCPDATA,"^",4),PRCPTIME=$P(PRCPDATA,"^",8)
|
|---|
| 95 | . I PRCPTIME-PRCPDATA>0 D
|
|---|
| 96 | . . D EN^DDIOL(" ")
|
|---|
| 97 | . . D EN^DDIOL("This transaction implies the clock setting on the supply station is wrong.")
|
|---|
| 98 | . . D EN^DDIOL("Please adjust the time on the supply station system to match the VistA")
|
|---|
| 99 | . . D EN^DDIOL("system before filing your request")
|
|---|
| 100 | . S DIR("A")="Do you wish to proceed?"
|
|---|
| 101 | . S DIR(0)="Y"
|
|---|
| 102 | . D ^DIR
|
|---|
| 103 | . I $D(DUOUT)!$D(DTOUT) S PRCPSTOP=1 QUIT
|
|---|
| 104 | . I Y=0 S PRCPSTOP=1 QUIT
|
|---|
| 105 | . Q
|
|---|
| 106 | ;
|
|---|
| 107 | ; ask for signature, if verified save DUZ and date/time in node 7 of file 445
|
|---|
| 108 | D ESIG^PRCUESIG(DUZ,.PRCPSTOP)
|
|---|
| 109 | I PRCPSTOP'=1 D EN^DDIOL("No request to replace the GIP quantities was filed.")
|
|---|
| 110 | I PRCPSTOP=1 D
|
|---|
| 111 | . W !
|
|---|
| 112 | . D NOW^%DTC
|
|---|
| 113 | . S ^PRCP(445,PRCP("I"),7)=DUZ_"^"_%
|
|---|
| 114 | . D EN^DDIOL("Your request to replace GIP values is now on file.")
|
|---|
| 115 | . D BLDSEG^PRCPHLQU(PRCP("I"))
|
|---|
| 116 | . D EN^DDIOL(" ")
|
|---|
| 117 | . D EN^DDIOL("Sending request for quantity information to supply station...")
|
|---|
| 118 | . D EN^DDIOL(" ")
|
|---|
| 119 | . D EN^DDIOL("The first QOH transaction time stamped by the supply station after")
|
|---|
| 120 | . S Y=% X ^DD("DD")
|
|---|
| 121 | . D EN^DDIOL(Y_" will cause the GIP values to be replaced.")
|
|---|
| 122 | . S PRCPSTOP=0
|
|---|
| 123 | ;
|
|---|
| 124 | EXIT L -^PRCP(445,PRCP("I"),7)
|
|---|
| 125 | D CLEAR^PRCPULOC(445,PRCP("I")_"-7",0)
|
|---|
| 126 | Q
|
|---|
