source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHAMYD.m@ 1806

Last change on this file since 1806 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.8 KB
Line 
1PRCHAMYD ;WISC/DJM/DXH - BULLETINS AND UPDATING FILE 441 ; 2/10/00 9:27am
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5OTHER ;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 ;
41LOOKUP ; 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
Note: See TracBrowser for help on using the repository browser.