95 lines
3.6 KiB
Mathematica
95 lines
3.6 KiB
Mathematica
PRCHQPST ;(WASH IRMFO)/LKG-Post Init routine for RFQ install ;10/24/96 16:31
|
|
;;5.0;IFCAP;**68**;4/21/95
|
|
Q
|
|
EN N X,PRCX,DA,DIC,DIE,DLAYGO,DR,Y
|
|
S X="PRCHQ RFQ",DIC=3.8,DIC(0)="LX",DLAYGO=3.8 D ^DIC K DIC,DLAYGO
|
|
I $P(Y,U,3)=1 D
|
|
. N %,%H,%I
|
|
. S DA=+Y,DIE=3.8,DR="4////PU" D ^DIE
|
|
. S DR="5////.5" D ^DIE
|
|
. S DR="7////n" D ^DIE
|
|
. S DR="10////0" D ^DIE
|
|
. D NOW^%DTC S ^XMB(3.8,DA,2,0)="^^1^1^"_X_"^"
|
|
. S ^XMB(3.8,DA,2,1,0)="This Mail Group gets bulletins sent from vendors and filing errors."
|
|
. I $G(XPDQUES("POS001"))>0 D
|
|
. . S X=+XPDQUES("POS001")
|
|
. . Q:$D(^XMB(3.8,DA,1,"B",X))
|
|
. . S Y=DA K DA S DA(1)=Y,DIC="^XMB(3.8,DA(1),1,",DIC(0)="LX",DLAYGO=3.81
|
|
. . S DIC("P")=$P(^DD(3.8,2,0),U,2) K DD,DO D FILE^DICN K DIC,DLAYGO,DA
|
|
S X="RFQ",DIC=420.4,DIC(0)="LX",DLAYGO=420.4 D ^DIC K DIC,DLAYGO
|
|
I +Y>0 D
|
|
. S DA=+Y,DIE=420.4,PRCX="Transmit 840 - Request for Quotation"
|
|
. S DR="2///^S X=PRCX" D ^DIE
|
|
. S PRCX="PHA",DR=".7///^S X=PRCX" D ^DIE
|
|
. S DR="1////Y" D ^DIE
|
|
. S DR="3////PHA" D ^DIE
|
|
. K DA,DR,DIE
|
|
S X="TXT",DIC=420.4,DIC(0)="LX",DLAYGO=420.4 D ^DIC K DIC,DLAYGO
|
|
I +Y>0 D
|
|
. S DA=+Y,DIE=420.4,PRCX="Transmit 864 Text Message"
|
|
. S DR="2///^S X=PRCX" D ^DIE
|
|
. S PRCX="PHA",DR=".7///^S X=PRCX" D ^DIE
|
|
. S DR="1////Y" D ^DIE
|
|
. S DR="3////PHA" D ^DIE
|
|
. K DA,DR,DIE
|
|
S X="ISM-TXT",DIC=423.5,DIC(0)="LX",DLAYGO=423.5 D ^DIC K DIC,DLAYGO
|
|
I +Y>0 D
|
|
. S DA=+Y,DIE=423.5
|
|
. S PRCX="PRCHQ RFQ",DR="1///^S X=PRCX" D ^DIE
|
|
. S PRCX="IN",DR="2///^S X=PRCX" D ^DIE
|
|
. S PRCX="PRCHQ7",DR="3///^S X=PRCX" D ^DIE
|
|
. K DA,DIE,DR
|
|
S X="ISM-VQT",DIC=423.5,DIC(0)="LX",DLAYGO=423.5 D ^DIC K DIC,DLAYGO
|
|
I +Y>0 D
|
|
. S DA=+Y,DIE=423.5
|
|
. S PRCX="PRCHQ RFQ",DR="1///^S X=PRCX" D ^DIE
|
|
. S PRCX="IN",DR="2///^S X=PRCX" D ^DIE
|
|
. S PRCX="PRCHQ6",DR="3///^S X=PRCX" D ^DIE
|
|
. K DA,DIE,DR
|
|
S X="ISM-ACT",DIC=423.5,DIC(0)="LX",DLAYGO=423.5 D ^DIC K DIC,DLAYGO
|
|
I +Y>0,$P(Y,U,3)=1 D
|
|
. S DA=+Y,DIE=423.5
|
|
. S PRCX="EDP",DR="1///^S X=PRCX" D ^DIE
|
|
. S PRCX="START",DR="2///^S X=PRCX" D ^DIE
|
|
. S PRCX="PRCOACT",DR="3///^S X=PRCX" D ^DIE
|
|
. K DA,DIE,DR
|
|
;
|
|
S X="ISM-PRJ",DIC=423.5,DIC(0)="LX",DLAYGO=423.5 D ^DIC K DIC,DLAYGO
|
|
I +Y>0,$P(Y,U,3)=1 D
|
|
. S DA=+Y,DIE=423.5
|
|
. S PRCX="EDP",DR="1///^S X=PRCX" D ^DIE
|
|
. S PRCX="START",DR="2///^S X=PRCX" D ^DIE
|
|
. S PRCX="PRCOACT",DR="3///^S X=PRCX" D ^DIE
|
|
. K DA,DIE,DR
|
|
K DIC,DA
|
|
F PRCX="PRCHQ 843 UPDATE VENDOR INFO","PRCHQ 864 ERROR","PRCHQ 864 NORMAL" D
|
|
. S X=PRCX,DIC="^XMB(3.6,",DIC(0)="X" D ^DIC K DIC
|
|
. Q:+Y<1
|
|
. S DA(1)=+Y,DIC="^XMB(3.6,DA(1),2,",DIC(0)="LX",DLAYGO=3.62
|
|
. S DIC("P")=$P(^DD(3.6,4,0),U,2),X="PRCHQ RFQ" D ^DIC K DA,DIC,DLAYGO
|
|
S X="PRCOEDI ACKNOWLEDGE",DIC="^XMB(3.6,",DIC(0)="X" D ^DIC K DIC
|
|
I +Y>0 D
|
|
. S DA(1)=+Y,DIC="^XMB(3.6,DA(1),2,",DIC(0)="LX",DLAYGO=3.62
|
|
. S DIC("P")=$P(^DD(3.6,4,0),U,2),X="EDP" D ^DIC K DA,DIC,DLAYGO
|
|
IND L +^PRC(440) N DIK S DIK="^PRC(440,",DIK(1)="18.3^DB" D ENALL^DIK K DIK L -^PRC(440)
|
|
OPT ;Add options to menu
|
|
K DA S DA(1)=$O(^DIC(19,"B","PRCHQ REPORTS",""))
|
|
I DA(1)]"" D
|
|
. K DIC,DIE,DR N PRCI,PRCX,X,Y
|
|
. F PRCI=1:1:3 D
|
|
. . S PRCX=$P("PRCHPC VEN EDIT~10^PRCHPC ITEM EDIT~11^PRCHPC PO EDIT~12","^",PRCI)
|
|
. . S X=$P(PRCX,"~"),PRCX=$P(PRCX,"~",2),X=$O(^DIC(19,"B",X,"")) Q:X=""
|
|
. . Q:$D(^DIC(19,DA(1),10,"B",X)) K DD,DO
|
|
. . S DIC="^DIC(19,DA(1),10,",DIC(0)="LX",DIC("P")=$P(^DD(19,10,0),U,2)
|
|
. . D FILE^DICN K DIC
|
|
. . I Y>0 D
|
|
. . . S DA=+Y,DIE="^DIC(19,DA(1),10,",DR="3///^S X=PRCX" D ^DIE K DIE,DR
|
|
K DA S DA(1)=$O(^DIC(19,"B","PRCHUSER PA",""))
|
|
I DA(1)]"" D
|
|
. K DIC,DIE,DR
|
|
. S X=$O(^DIC(19,"B","PRCHQM","")) Q:X=""
|
|
. Q:$D(^DIC(19,DA(1),10,"B",X)) K DD,DO
|
|
. S DIC="^DIC(19,DA(1),10,",DIC(0)="LX",DIC("P")=$P(^DD(19,10,0),U,2)
|
|
. D FILE^DICN K DIC
|
|
Q
|