source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHAMYD.m

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