VistA-WorldVistAEHR/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQPST.m

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