source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQPST.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1PRCHQPST ;(WASH IRMFO)/LKG-Post Init routine for RFQ install ;10/24/96 16:31
2 ;;5.0;IFCAP;**68**;4/21/95
3 Q
4EN N X,PRCX,DA,DIC,DIE,DLAYGO,DR,Y
5 S X="PRCHQ RFQ",DIC=3.8,DIC(0)="LX",DLAYGO=3.8 D ^DIC K DIC,DLAYGO
6 I $P(Y,U,3)=1 D
7 . N %,%H,%I
8 . S DA=+Y,DIE=3.8,DR="4////PU" D ^DIE
9 . S DR="5////.5" D ^DIE
10 . S DR="7////n" D ^DIE
11 . S DR="10////0" D ^DIE
12 . D NOW^%DTC S ^XMB(3.8,DA,2,0)="^^1^1^"_X_"^"
13 . S ^XMB(3.8,DA,2,1,0)="This Mail Group gets bulletins sent from vendors and filing errors."
14 . I $G(XPDQUES("POS001"))>0 D
15 . . S X=+XPDQUES("POS001")
16 . . Q:$D(^XMB(3.8,DA,1,"B",X))
17 . . S Y=DA K DA S DA(1)=Y,DIC="^XMB(3.8,DA(1),1,",DIC(0)="LX",DLAYGO=3.81
18 . . S DIC("P")=$P(^DD(3.8,2,0),U,2) K DD,DO D FILE^DICN K DIC,DLAYGO,DA
19 S X="RFQ",DIC=420.4,DIC(0)="LX",DLAYGO=420.4 D ^DIC K DIC,DLAYGO
20 I +Y>0 D
21 . S DA=+Y,DIE=420.4,PRCX="Transmit 840 - Request for Quotation"
22 . S DR="2///^S X=PRCX" D ^DIE
23 . S PRCX="PHA",DR=".7///^S X=PRCX" D ^DIE
24 . S DR="1////Y" D ^DIE
25 . S DR="3////PHA" D ^DIE
26 . K DA,DR,DIE
27 S X="TXT",DIC=420.4,DIC(0)="LX",DLAYGO=420.4 D ^DIC K DIC,DLAYGO
28 I +Y>0 D
29 . S DA=+Y,DIE=420.4,PRCX="Transmit 864 Text Message"
30 . S DR="2///^S X=PRCX" D ^DIE
31 . S PRCX="PHA",DR=".7///^S X=PRCX" D ^DIE
32 . S DR="1////Y" D ^DIE
33 . S DR="3////PHA" D ^DIE
34 . K DA,DR,DIE
35 S X="ISM-TXT",DIC=423.5,DIC(0)="LX",DLAYGO=423.5 D ^DIC K DIC,DLAYGO
36 I +Y>0 D
37 . S DA=+Y,DIE=423.5
38 . S PRCX="PRCHQ RFQ",DR="1///^S X=PRCX" D ^DIE
39 . S PRCX="IN",DR="2///^S X=PRCX" D ^DIE
40 . S PRCX="PRCHQ7",DR="3///^S X=PRCX" D ^DIE
41 . K DA,DIE,DR
42 S X="ISM-VQT",DIC=423.5,DIC(0)="LX",DLAYGO=423.5 D ^DIC K DIC,DLAYGO
43 I +Y>0 D
44 . S DA=+Y,DIE=423.5
45 . S PRCX="PRCHQ RFQ",DR="1///^S X=PRCX" D ^DIE
46 . S PRCX="IN",DR="2///^S X=PRCX" D ^DIE
47 . S PRCX="PRCHQ6",DR="3///^S X=PRCX" D ^DIE
48 . K DA,DIE,DR
49 S X="ISM-ACT",DIC=423.5,DIC(0)="LX",DLAYGO=423.5 D ^DIC K DIC,DLAYGO
50 I +Y>0,$P(Y,U,3)=1 D
51 . S DA=+Y,DIE=423.5
52 . S PRCX="EDP",DR="1///^S X=PRCX" D ^DIE
53 . S PRCX="START",DR="2///^S X=PRCX" D ^DIE
54 . S PRCX="PRCOACT",DR="3///^S X=PRCX" D ^DIE
55 . K DA,DIE,DR
56 ;
57 S X="ISM-PRJ",DIC=423.5,DIC(0)="LX",DLAYGO=423.5 D ^DIC K DIC,DLAYGO
58 I +Y>0,$P(Y,U,3)=1 D
59 . S DA=+Y,DIE=423.5
60 . S PRCX="EDP",DR="1///^S X=PRCX" D ^DIE
61 . S PRCX="START",DR="2///^S X=PRCX" D ^DIE
62 . S PRCX="PRCOACT",DR="3///^S X=PRCX" D ^DIE
63 . K DA,DIE,DR
64 K DIC,DA
65 F PRCX="PRCHQ 843 UPDATE VENDOR INFO","PRCHQ 864 ERROR","PRCHQ 864 NORMAL" D
66 . S X=PRCX,DIC="^XMB(3.6,",DIC(0)="X" D ^DIC K DIC
67 . Q:+Y<1
68 . S DA(1)=+Y,DIC="^XMB(3.6,DA(1),2,",DIC(0)="LX",DLAYGO=3.62
69 . S DIC("P")=$P(^DD(3.6,4,0),U,2),X="PRCHQ RFQ" D ^DIC K DA,DIC,DLAYGO
70 S X="PRCOEDI ACKNOWLEDGE",DIC="^XMB(3.6,",DIC(0)="X" D ^DIC K DIC
71 I +Y>0 D
72 . S DA(1)=+Y,DIC="^XMB(3.6,DA(1),2,",DIC(0)="LX",DLAYGO=3.62
73 . S DIC("P")=$P(^DD(3.6,4,0),U,2),X="EDP" D ^DIC K DA,DIC,DLAYGO
74IND L +^PRC(440) N DIK S DIK="^PRC(440,",DIK(1)="18.3^DB" D ENALL^DIK K DIK L -^PRC(440)
75OPT ;Add options to menu
76 K DA S DA(1)=$O(^DIC(19,"B","PRCHQ REPORTS",""))
77 I DA(1)]"" D
78 . K DIC,DIE,DR N PRCI,PRCX,X,Y
79 . F PRCI=1:1:3 D
80 . . S PRCX=$P("PRCHPC VEN EDIT~10^PRCHPC ITEM EDIT~11^PRCHPC PO EDIT~12","^",PRCI)
81 . . S X=$P(PRCX,"~"),PRCX=$P(PRCX,"~",2),X=$O(^DIC(19,"B",X,"")) Q:X=""
82 . . Q:$D(^DIC(19,DA(1),10,"B",X)) K DD,DO
83 . . S DIC="^DIC(19,DA(1),10,",DIC(0)="LX",DIC("P")=$P(^DD(19,10,0),U,2)
84 . . D FILE^DICN K DIC
85 . . I Y>0 D
86 . . . S DA=+Y,DIE="^DIC(19,DA(1),10,",DR="3///^S X=PRCX" D ^DIE K DIE,DR
87 K DA S DA(1)=$O(^DIC(19,"B","PRCHUSER PA",""))
88 I DA(1)]"" D
89 . K DIC,DIE,DR
90 . S X=$O(^DIC(19,"B","PRCHQM","")) Q:X=""
91 . Q:$D(^DIC(19,DA(1),10,"B",X)) K DD,DO
92 . S DIC="^DIC(19,DA(1),10,",DIC(0)="LX",DIC("P")=$P(^DD(19,10,0),U,2)
93 . D FILE^DICN K DIC
94 Q
Note: See TracBrowser for help on using the repository browser.