- 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 Feb 18, 2025@23:28:38 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