PRC5B4 ;WISC/PLT-COLLECT ACTIVE P.O. ORDER F.O.B. ; 10/14/94 12:30 PM
V ;;5.0;IFCAP;;4/21/95
QUIT ;invalid entry
;
EN ;START SENDING P.O. AND FOB TO FMS
N A,PRCDUZ
D EN^DDIOL("This task is going to send all active purchase orders dated")
D EN^DDIOL("after 12/31/1988 to FMS with F.O.B. data only.")
D EN^DDIOL("Please schedule this task one day before your site IFCAP V5 INSTALLATION")
D EN^DDIOL(" ")
S PRCDUZ=DUZ
S A=$$TASK^PRC0B2("EN1^PRC5B4~IFCAP V5 sending purchase order F.O.B. data to FMS","PRCDUZ",1)
I A<1 D EN^DDIOL("Submit to the Task Manager fails, try later!") G EXIT
D EN^DDIOL("Task number "_$P(A,"^",1)_" assigned with schedule date/time: "_$P($$DT^PRC0B2($P(A,"^",2),"H"),"^",4))
G EXIT
;
EN1 ;entry from task manager
N PRCRI,PRCA,PRCB,PRCC,PRCD,PRCFOB,PRCE,PRCRE,PRCSTN,PRCF,PRCPOD
N PRCST,PRCDT,PRCCT,PRCNT
N A
D:'$D(ZTQUEUED) EN^DDIOL("START SENDING P.O. AND F.O.B TO FMS")
S PRCNT=0,PRCSTN=$O(^PRC(411,0)),PRCSTN=$E(PRCSTN+1000,2,999)
S A=$$DT^PRC0B2("N","E","S"),A=$P(A,"^"),B=$P(A,".",2)
S PRCDT=$P(A,".",1)+17000000_"^"_$E(B+1000000,2,999)
S PRCCT="CTL^IFC^FMS^"_PRCSTN_"^FOB^^^^^"_PRCDT_"^001^001^001^~"
S $P(PRCCT,"^",6)=$J("",2),$P(PRCCT,"^",7)=$J("",4)
S $P(PRCCT,"^",8)=$J("",6),$P(PRCCT,"^",9)=$J("",11)
S PRCPOD=2890000,PRCE=0
F S PRCPOD=$O(^PRC(442,"AB",PRCPOD)) Q:PRCPOD>2999999!'PRCPOD D
. S PRCRI(442)=0
. F S PRCRI(442)=$O(^PRC(442,"AB",PRCPOD,PRCRI(442))) Q:'PRCRI(442) S A=$G(^PRC(442,PRCRI(442),0)) I A]"" D:$P(A,"^",2)'=21
.. S PRCST=$P($G(^PRC(442,PRCRI(442),7)),"^"),PRCST="/"_PRCST_"/",PRCFOB=$P($G(^(1)),"^",6)
.. QUIT:"/6/7/25/26/30/31/35/36/42/43/"'[PRCST
.. S A=$P(A,"^",1),A=$E($P(A,"-")+1000,2,999)_$P(A,"-",2,999)
.. S PRCF="FOB^"_A_"^"_PRCFOB_"^~{"
.. W:'$D(ZTQUEUED) !,PRCF," ",PRCE," ",PRCRI(442)," ",PRCPOD
.. D MM S PRCNT=PRCNT+1
.. QUIT
. QUIT
D MMEND
D:'$D(ZTQUEUED)
. D EN^DDIOL("FOB TOTAL RECORD SENT: "_PRCNT)
. D EN^DDIOL("END SENDING P.O. AND F.O.B")
. QUIT
D
. N X,Y
. S X(1)="TOTAL IFCAP V5 FOB RECORDS SENT TO FMS: "_PRCNT
. S Y(.5)="",Y(PRCDUZ)=""
. D MM^PRC0B2("IFCAP V5 INSTALLATION FOB RECORD COUNT^TASK MANAGER","X(",.Y)
. QUIT
EXIT K PRCDUZ QUIT
;
MM ;send to mailman
N A,B
I PRCE=0 D
. S XMSUB="IFCAP V5 FOB DOCUMENTS",XMDUZ="IFCAP V5 INSTALLATION"
. D XMZ^XMA2
. QUIT
S PRCE=PRCE+1
S ^XMB(3.9,XMZ,2,PRCE,0)=PRCCT
S PRCE=PRCE+1
S ^XMB(3.9,XMZ,2,PRCE,0)=PRCF
D MMEND:PRCE>500
QUIT
;
MMEND ;end of message
QUIT:'PRCE
S XMDUN="IFCAP V5 INSTALLATION"
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_PRCE_"^"_PRCE_"^"_DT
S XMY("XXX@Q-FMZ.DOMAIN.EXT")=""
D ENT1^XMD
S PRCE=0
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC5B4 2683 printed Nov 22, 2024@17:09:59 Page 2
PRC5B4 ;WISC/PLT-COLLECT ACTIVE P.O. ORDER F.O.B. ; 10/14/94 12:30 PM
V ;;5.0;IFCAP;;4/21/95
+1 ;invalid entry
QUIT
+2 ;
EN ;START SENDING P.O. AND FOB TO FMS
+1 NEW A,PRCDUZ
+2 DO EN^DDIOL("This task is going to send all active purchase orders dated")
+3 DO EN^DDIOL("after 12/31/1988 to FMS with F.O.B. data only.")
+4 DO EN^DDIOL("Please schedule this task one day before your site IFCAP V5 INSTALLATION")
+5 DO EN^DDIOL(" ")
+6 SET PRCDUZ=DUZ
+7 SET A=$$TASK^PRC0B2("EN1^PRC5B4~IFCAP V5 sending purchase order F.O.B. data to FMS","PRCDUZ",1)
+8 IF A<1
DO EN^DDIOL("Submit to the Task Manager fails, try later!")
GOTO EXIT
+9 DO EN^DDIOL("Task number "_$PIECE(A,"^",1)_" assigned with schedule date/time: "_$PIECE($$DT^PRC0B2($PIECE(A,"^",2),"H"),"^",4))
+10 GOTO EXIT
+11 ;
EN1 ;entry from task manager
+1 NEW PRCRI,PRCA,PRCB,PRCC,PRCD,PRCFOB,PRCE,PRCRE,PRCSTN,PRCF,PRCPOD
+2 NEW PRCST,PRCDT,PRCCT,PRCNT
+3 NEW A
+4 if '$DATA(ZTQUEUED)
DO EN^DDIOL("START SENDING P.O. AND F.O.B TO FMS")
+5 SET PRCNT=0
SET PRCSTN=$ORDER(^PRC(411,0))
SET PRCSTN=$EXTRACT(PRCSTN+1000,2,999)
+6 SET A=$$DT^PRC0B2("N","E","S")
SET A=$PIECE(A,"^")
SET B=$PIECE(A,".",2)
+7 SET PRCDT=$PIECE(A,".",1)+17000000_"^"_$EXTRACT(B+1000000,2,999)
+8 SET PRCCT="CTL^IFC^FMS^"_PRCSTN_"^FOB^^^^^"_PRCDT_"^001^001^001^~"
+9 SET $PIECE(PRCCT,"^",6)=$JUSTIFY("",2)
SET $PIECE(PRCCT,"^",7)=$JUSTIFY("",4)
+10 SET $PIECE(PRCCT,"^",8)=$JUSTIFY("",6)
SET $PIECE(PRCCT,"^",9)=$JUSTIFY("",11)
+11 SET PRCPOD=2890000
SET PRCE=0
+12 FOR
SET PRCPOD=$ORDER(^PRC(442,"AB",PRCPOD))
if PRCPOD>2999999!'PRCPOD
QUIT
Begin DoDot:1
+13 SET PRCRI(442)=0
+14 FOR
SET PRCRI(442)=$ORDER(^PRC(442,"AB",PRCPOD,PRCRI(442)))
if 'PRCRI(442)
QUIT
SET A=$GET(^PRC(442,PRCRI(442),0))
IF A]""
if $PIECE(A,"^",2)'=21
Begin DoDot:2
+15 SET PRCST=$PIECE($GET(^PRC(442,PRCRI(442),7)),"^")
SET PRCST="/"_PRCST_"/"
SET PRCFOB=$PIECE($GET(^(1)),"^",6)
+16 if "/6/7/25/26/30/31/35/36/42/43/"'[PRCST
QUIT
+17 SET A=$PIECE(A,"^",1)
SET A=$EXTRACT($PIECE(A,"-")+1000,2,999)_$PIECE(A,"-",2,999)
+18 SET PRCF="FOB^"_A_"^"_PRCFOB_"^~{"
+19 if '$DATA(ZTQUEUED)
WRITE !,PRCF," ",PRCE," ",PRCRI(442)," ",PRCPOD
+20 DO MM
SET PRCNT=PRCNT+1
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 DO MMEND
+24 if '$DATA(ZTQUEUED)
Begin DoDot:1
+25 DO EN^DDIOL("FOB TOTAL RECORD SENT: "_PRCNT)
+26 DO EN^DDIOL("END SENDING P.O. AND F.O.B")
+27 QUIT
End DoDot:1
+28 Begin DoDot:1
+29 NEW X,Y
+30 SET X(1)="TOTAL IFCAP V5 FOB RECORDS SENT TO FMS: "_PRCNT
+31 SET Y(.5)=""
SET Y(PRCDUZ)=""
+32 DO MM^PRC0B2("IFCAP V5 INSTALLATION FOB RECORD COUNT^TASK MANAGER","X(",.Y)
+33 QUIT
End DoDot:1
EXIT KILL PRCDUZ
QUIT
+1 ;
MM ;send to mailman
+1 NEW A,B
+2 IF PRCE=0
Begin DoDot:1
+3 SET XMSUB="IFCAP V5 FOB DOCUMENTS"
SET XMDUZ="IFCAP V5 INSTALLATION"
+4 DO XMZ^XMA2
+5 QUIT
End DoDot:1
+6 SET PRCE=PRCE+1
+7 SET ^XMB(3.9,XMZ,2,PRCE,0)=PRCCT
+8 SET PRCE=PRCE+1
+9 SET ^XMB(3.9,XMZ,2,PRCE,0)=PRCF
+10 if PRCE>500
DO MMEND
+11 QUIT
+12 ;
MMEND ;end of message
+1 if 'PRCE
QUIT
+2 SET XMDUN="IFCAP V5 INSTALLATION"
+3 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_PRCE_"^"_PRCE_"^"_DT
+4 SET XMY("XXX@Q-FMZ.DOMAIN.EXT")=""
+5 DO ENT1^XMD
+6 SET PRCE=0
+7 QUIT
+8 ;
