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
|
---|