| 1 | PRCHAMYD ;WISC/DJM/DXH - BULLETINS AND UPDATING FILE 441 ; 2/10/00 9:27am
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | OTHER ;NOW TO UPDATE OTHER FILES WITH THE NEW P.O. INFORMATION.
|
|---|
| 6 | ;
|
|---|
| 7 | N AUTH,TEST,PONO,VIP,XMB,XMDUZ,USR,XMY,IMF,IMFA,IMF1,IMF2
|
|---|
| 8 | N OK,TITEM,EE,LL,LOOP,MGR,IP,XMTEXT,PRCPXMY
|
|---|
| 9 | S IMF=0
|
|---|
| 10 | F S IMF=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",21,1.5,IMF)) Q:IMF="" D
|
|---|
| 11 | . S IMF1=$P($G(^PRC(442,PRCHPO,6,PRCHAM,3,IMF,0)),U,4)
|
|---|
| 12 | . S IMF2=$P($G(^PRC(442,PRCHPO,2,IMF1,0)),U,5)
|
|---|
| 13 | . ;
|
|---|
| 14 | . ; OK, HERE IS THE ITEM MASTER FILE ENTRY FOR THIS
|
|---|
| 15 | . ; ADDED ITEM. NOW UPDATE ALL THE FIELDS IN THE IMF
|
|---|
| 16 | . ; ENTRY FOR THIS ITEM THAT FIELD 1.5 BRINGS OVER.
|
|---|
| 17 | . ;
|
|---|
| 18 | . D EN3^PRCHCRD3
|
|---|
| 19 | . Q
|
|---|
| 20 | K TITEM
|
|---|
| 21 | S IMF=0
|
|---|
| 22 | F S IMF=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",23,IMF)) Q:IMF="" D
|
|---|
| 23 | . S IMFA=0
|
|---|
| 24 | . F S IMFA=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",23,IMF,IMFA)) Q:IMFA="" D
|
|---|
| 25 | . . S IMF1=$P($G(^PRC(442,PRCHPO,6,PRCHAM,3,IMFA,0)),U,4)
|
|---|
| 26 | . . Q:$G(TITEM(IMF1))=1
|
|---|
| 27 | . . S TITEM(IMF1)=1
|
|---|
| 28 | . . Q:+$P($G(^PRC(442,PRCHPO,2,IMF1,0)),U,5)=0
|
|---|
| 29 | . . ;
|
|---|
| 30 | . . ; NOW, THIS IS AN ITEM THAT HAS BEEN EDITED.
|
|---|
| 31 | . . ; THE ITEM HASN'T BEEN UPDATED YET AND IT HAS
|
|---|
| 32 | . . ; AN ITEM MASTER FILE POINTER. LETS UPDATE
|
|---|
| 33 | . . ; FILE 441 FOR THE ITEM MASTER FILE ENTRY
|
|---|
| 34 | . . ; FOUND IN THIS ITEM.
|
|---|
| 35 | . . ;
|
|---|
| 36 | . . D EN3^PRCHCRD3
|
|---|
| 37 | . . Q
|
|---|
| 38 | . Q
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | LOOKUP ; SEARCH THROUGH FILE 442, NODE 13 FOR 2237s
|
|---|
| 42 | ;
|
|---|
| 43 | ; IS THERE ANY 2237s ENTERED FOR THIS P.O.
|
|---|
| 44 | ;
|
|---|
| 45 | S LOOP=$G(^PRC(442,PRCHPO,13,0))
|
|---|
| 46 | Q:LOOP=""
|
|---|
| 47 | ;
|
|---|
| 48 | ; NOW FIND OUT IF THERE IS AN INVENTORY POINT IN ANY 2237s
|
|---|
| 49 | ;
|
|---|
| 50 | S VIP=0
|
|---|
| 51 | S LOOP=0
|
|---|
| 52 | F S LOOP=$O(^PRC(442,PRCHPO,13,LOOP)) Q:LOOP'>0 D
|
|---|
| 53 | . S IP=$P($G(^PRC(442,PRCHPO,13,LOOP,0)),U,11)
|
|---|
| 54 | . Q:IP=""
|
|---|
| 55 | . Q:$$CHECK^PRCPCUT1(IP,1)
|
|---|
| 56 | . S VIP=1
|
|---|
| 57 | . D GETUSER^PRCPXTRM(IP)
|
|---|
| 58 | . Q:$D(PRCPXMY)=0
|
|---|
| 59 | . S MGR=""
|
|---|
| 60 | . S USR=0
|
|---|
| 61 | . F S USR=$O(PRCPXMY(USR)) Q:USR'>0 S:PRCPXMY(USR)=1 XMY(USR)="",MGR=1
|
|---|
| 62 | . ;
|
|---|
| 63 | . ; FOUND CONTROL POINT MANAGER/S NOW STOP SEARCHING
|
|---|
| 64 | . ;
|
|---|
| 65 | . Q:MGR=1
|
|---|
| 66 | . ;
|
|---|
| 67 | . ; LETS SEND TO ALL USERS IN CONTROL POINT THAT CAN USE
|
|---|
| 68 | . ; INVENTORY POINT
|
|---|
| 69 | . ;
|
|---|
| 70 | . S USR=0
|
|---|
| 71 | . F S USR=$O(PRCPXMY(USR)) Q:USR'>0 S XMY(USR)=""
|
|---|
| 72 | . Q
|
|---|
| 73 | ; IF THERE IS A VALID INVENTORY POINT UPDATE ITS DUEINS
|
|---|
| 74 | ;
|
|---|
| 75 | I VIP=1 D
|
|---|
| 76 | . S DA=PRCHPO
|
|---|
| 77 | . D UPDATE^PRCPWIU
|
|---|
| 78 | . Q
|
|---|
| 79 | ;
|
|---|
| 80 | ; SEE IF THERE ARE ANY USERS LISTED
|
|---|
| 81 | ;
|
|---|
| 82 | Q:$O(XMY(0))=""
|
|---|
| 83 | ;
|
|---|
| 84 | ; NOW LETS SET UP THE DISPLAY
|
|---|
| 85 | ;
|
|---|
| 86 | K ^TMP($J,"AMD"),LINE
|
|---|
| 87 | ;
|
|---|
| 88 | ; THIS CALL SETS UP THE DISPLAYED TEXT FOR ANY KIND OF AMENDMENT
|
|---|
| 89 | ;
|
|---|
| 90 | D START^PRCHAMY1(PRCHPO,PRCHAM)
|
|---|
| 91 | ;
|
|---|
| 92 | ; NOW COMBINE TEXT FROM BULLETIN AND TEXT FROM START^PRCHAMY1
|
|---|
| 93 | ;
|
|---|
| 94 | S PONO=$P($G(^PRC(442,PRCHPO,0)),U,1)
|
|---|
| 95 | S ^TMP($J,"AMD",1,0)=""
|
|---|
| 96 | S XMTEXT="^TMP($J,""AMD"",1,"
|
|---|
| 97 | S XMB(1)=PONO
|
|---|
| 98 | S:$G(IP)>0 XMB(2)=$P(^PRCP(445,IP,0),U)
|
|---|
| 99 | S XMB="PRC_IFCAP_CHANGE"
|
|---|
| 100 | S XMDUZ="IFCAP AMENDMENT CHANGE"
|
|---|
| 101 | W ! ;SPACE FOLLOWING MESSAGE FROM LAST MESSAGE
|
|---|
| 102 | D EN^XMB
|
|---|
| 103 | K ^TMP($J,"AMD"),LINE
|
|---|
| 104 | Q
|
|---|
