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