105 lines
2.8 KiB
Mathematica
105 lines
2.8 KiB
Mathematica
PRCHAMYD ;WISC/DJM/DXH - BULLETINS AND UPDATING FILE 441 ; 2/10/00 9:27am
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
OTHER ;NOW TO UPDATE OTHER FILES WITH THE NEW P.O. INFORMATION.
|
|
;
|
|
N AUTH,TEST,PONO,VIP,XMB,XMDUZ,USR,XMY,IMF,IMFA,IMF1,IMF2
|
|
N OK,TITEM,EE,LL,LOOP,MGR,IP,XMTEXT,PRCPXMY
|
|
S IMF=0
|
|
F S IMF=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",21,1.5,IMF)) Q:IMF="" D
|
|
. S IMF1=$P($G(^PRC(442,PRCHPO,6,PRCHAM,3,IMF,0)),U,4)
|
|
. S IMF2=$P($G(^PRC(442,PRCHPO,2,IMF1,0)),U,5)
|
|
. ;
|
|
. ; OK, HERE IS THE ITEM MASTER FILE ENTRY FOR THIS
|
|
. ; ADDED ITEM. NOW UPDATE ALL THE FIELDS IN THE IMF
|
|
. ; ENTRY FOR THIS ITEM THAT FIELD 1.5 BRINGS OVER.
|
|
. ;
|
|
. D EN3^PRCHCRD3
|
|
. Q
|
|
K TITEM
|
|
S IMF=0
|
|
F S IMF=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",23,IMF)) Q:IMF="" D
|
|
. S IMFA=0
|
|
. F S IMFA=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",23,IMF,IMFA)) Q:IMFA="" D
|
|
. . S IMF1=$P($G(^PRC(442,PRCHPO,6,PRCHAM,3,IMFA,0)),U,4)
|
|
. . Q:$G(TITEM(IMF1))=1
|
|
. . S TITEM(IMF1)=1
|
|
. . Q:+$P($G(^PRC(442,PRCHPO,2,IMF1,0)),U,5)=0
|
|
. . ;
|
|
. . ; NOW, THIS IS AN ITEM THAT HAS BEEN EDITED.
|
|
. . ; THE ITEM HASN'T BEEN UPDATED YET AND IT HAS
|
|
. . ; AN ITEM MASTER FILE POINTER. LETS UPDATE
|
|
. . ; FILE 441 FOR THE ITEM MASTER FILE ENTRY
|
|
. . ; FOUND IN THIS ITEM.
|
|
. . ;
|
|
. . D EN3^PRCHCRD3
|
|
. . Q
|
|
. Q
|
|
;
|
|
;
|
|
LOOKUP ; SEARCH THROUGH FILE 442, NODE 13 FOR 2237s
|
|
;
|
|
; IS THERE ANY 2237s ENTERED FOR THIS P.O.
|
|
;
|
|
S LOOP=$G(^PRC(442,PRCHPO,13,0))
|
|
Q:LOOP=""
|
|
;
|
|
; NOW FIND OUT IF THERE IS AN INVENTORY POINT IN ANY 2237s
|
|
;
|
|
S VIP=0
|
|
S LOOP=0
|
|
F S LOOP=$O(^PRC(442,PRCHPO,13,LOOP)) Q:LOOP'>0 D
|
|
. S IP=$P($G(^PRC(442,PRCHPO,13,LOOP,0)),U,11)
|
|
. Q:IP=""
|
|
. Q:$$CHECK^PRCPCUT1(IP,1)
|
|
. S VIP=1
|
|
. D GETUSER^PRCPXTRM(IP)
|
|
. Q:$D(PRCPXMY)=0
|
|
. S MGR=""
|
|
. S USR=0
|
|
. F S USR=$O(PRCPXMY(USR)) Q:USR'>0 S:PRCPXMY(USR)=1 XMY(USR)="",MGR=1
|
|
. ;
|
|
. ; FOUND CONTROL POINT MANAGER/S NOW STOP SEARCHING
|
|
. ;
|
|
. Q:MGR=1
|
|
. ;
|
|
. ; LETS SEND TO ALL USERS IN CONTROL POINT THAT CAN USE
|
|
. ; INVENTORY POINT
|
|
. ;
|
|
. S USR=0
|
|
. F S USR=$O(PRCPXMY(USR)) Q:USR'>0 S XMY(USR)=""
|
|
. Q
|
|
; IF THERE IS A VALID INVENTORY POINT UPDATE ITS DUEINS
|
|
;
|
|
I VIP=1 D
|
|
. S DA=PRCHPO
|
|
. D UPDATE^PRCPWIU
|
|
. Q
|
|
;
|
|
; SEE IF THERE ARE ANY USERS LISTED
|
|
;
|
|
Q:$O(XMY(0))=""
|
|
;
|
|
; NOW LETS SET UP THE DISPLAY
|
|
;
|
|
K ^TMP($J,"AMD"),LINE
|
|
;
|
|
; THIS CALL SETS UP THE DISPLAYED TEXT FOR ANY KIND OF AMENDMENT
|
|
;
|
|
D START^PRCHAMY1(PRCHPO,PRCHAM)
|
|
;
|
|
; NOW COMBINE TEXT FROM BULLETIN AND TEXT FROM START^PRCHAMY1
|
|
;
|
|
S PONO=$P($G(^PRC(442,PRCHPO,0)),U,1)
|
|
S ^TMP($J,"AMD",1,0)=""
|
|
S XMTEXT="^TMP($J,""AMD"",1,"
|
|
S XMB(1)=PONO
|
|
S:$G(IP)>0 XMB(2)=$P(^PRCP(445,IP,0),U)
|
|
S XMB="PRC_IFCAP_CHANGE"
|
|
S XMDUZ="IFCAP AMENDMENT CHANGE"
|
|
W ! ;SPACE FOLLOWING MESSAGE FROM LAST MESSAGE
|
|
D EN^XMB
|
|
K ^TMP($J,"AMD"),LINE
|
|
Q
|