| 1 | PRCFACS2 ;WISC/PL-BULLETIN FOR CHANGED DELIVERY DATE FOR P.O. ;1/4/94
 | 
|---|
| 2 |  ;;5.1;IFCAP;;Oct 20, 2000
 | 
|---|
| 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  K ^UTILITY($J),MSG S DIWL=0,DIWR=79,DIWF=""
 | 
|---|
| 6 |  S PRCHDT=$E(PRCHDT,4,5)_"/"_$E(PRCHDT,6,7)_"/"_$E(PRCHDT,2,3)
 | 
|---|
| 7 |  S PRCHDTT=$E(PRCHDTT,4,5)_"/"_$E(PRCHDTT,6,7)_"/"_$E(PRCHDTT,2,3)
 | 
|---|
| 8 |  S PRCHPOEX=$P(^PRC(442,PRCHPO,0),U,1)
 | 
|---|
| 9 |  S PRCHPOTY=$S($P(^PRC(442,PRCHPO,0),U,2)=8:"Requisition # ",1:"P.O # ")
 | 
|---|
| 10 |  S PRCFCP=+($P(^PRC(442,PRCHPO,0),U,3))
 | 
|---|
| 11 |  S PRCSRV=$P($G(^PRC(420,PRC("SITE"),1,PRCFCP,0)),U,10)
 | 
|---|
| 12 |  I PRCSRV]"" S PRCSRV=$P($G(^DIC(49,PRCSRV,0)),U,1)
 | 
|---|
| 13 |  S MSG(1,0)="The delivery date for "_PRCHPOTY_PRCHPOEX
 | 
|---|
| 14 |  S MSG(2,0)="has been changed from "_PRCHDT_" to "_PRCHDTT
 | 
|---|
| 15 |  I PRCFCP]"" S MSG(3,0)="by the above Purchasing Agent for control point "_PRCFCP_$S(PRCSRV="":".",1:"")
 | 
|---|
| 16 |  I PRCSRV]"" S MSG(4,0)="for "_PRCSRV_" Service."
 | 
|---|
| 17 |  S MSG(5,0)="Please note this change."
 | 
|---|
| 18 |  S XMSUB="Notification for delivery date change on a P.O."
 | 
|---|
| 19 |  D MSG S X="Delivery date changed ! Bulletin transmitted.*" D MSG^PRCFQ
 | 
|---|
| 20 | EXIT ;
 | 
|---|
| 21 |  K DIWF,DIWL,DIWR,X,M,N,PRCHPOEX,PRCHPOTY,PRCHDT,PRCHDTT,PRCFCP,PRCFCPN,PRCFCPM,PRCSRV,XMDUZ,XMSUB,XMTEXT,XMY
 | 
|---|
| 22 |  Q
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 | MSG ;SET VARIABLES AND CALL XMD
 | 
|---|
| 25 |  ; sent to members of mail group "FISCAL NOTIFICATION"
 | 
|---|
| 26 |  S N=$O(^XMB(3.8,"B","FISCAL NOTIFICATION","")) Q:N=""
 | 
|---|
| 27 |  S M="" F  S M=$O(^XMB(3.8,N,1,"B",M)) Q:M=""  S XMY(+M)=""
 | 
|---|
| 28 |  Q:'$O(XMY(""))  S XMDUZ=DUZ,XMTEXT="MSG("
 | 
|---|
| 29 |  D WAIT^PRCFYN,^XMD
 | 
|---|
| 30 |  Q
 | 
|---|