source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUPR0.m@ 1540

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1PSUPR0 ;BIR/PDW - PROCUREMENT EXTRACT ENTRY ROUTINE ;25 AUG 1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA's
5 ; Reference to file 4.3 supported by DBIA 10091
6 ; Reference to file 4 supported by DBIA 10090
7 ;
8EN ;EP from PSUCP
9 ;
10 ; pull variables from ^XTMP
11 ; PSUJOB must exist and must be the job number used to store the data desired for this session.
12 I '$D(PSUJOB) S PSUJOB=$J
13 S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"
14 F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P(^XTMP("PSU_"_PSUJOB,1),U,I)
15PULLQ ;Q
16 S PSUPRJOB=PSUJOB
17 S PSUPRSUB="PSUPR_"_PSUPRJOB
18 ; Setup ^XTMP
19 S X1=DT,X2=6 D C^%DTC
20 K ^XTMP(PSUPRSUB)
21 S ^XTMP(PSUPRSUB,0)=X_U_DT_"^ PBM Extract - Procurement Module "
22 ;
23 ; Store Important variables
24 K X
25 S X="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUSNDR,PSUPRSUB,PSUJOB,PSURTN,PSUOPTN"
26 F I=1:1 S Y=$P(X,",",I) Q:Y="" I $D(@Y) S X(Y)=@Y
27 M ^XTMP(PSUPRSUB,"SAVE")=X
28 K X
29 ; Process the Procurement Files
30 ; Code for CoreFLS * NOTE: This will be commented out as of 7/1/04
31 ;until such time as CoreFLS code is released.
32 ;S X="PSAFLS" X ^%ZOSF("TEST")
33 ;I $T D
34 ;.S PSUPRSUB="PSUPR_"_$J
35 ;.S PSUFLSFG="" ;FLAG TO SIGNAL COREFLS IN EFFECT
36 ;.D EN^PSUPR2
37 ;.D EN^PSUPR3
38 ;.K PSUFLSFG
39 ;I '$T D ;CoreFLS code. Commented out. When CoreFLS code is
40 ;released put the next 3 lines inside a dot structure.
41 D EN^PSUPR1 ; file 442
42 D EN^PSUPR2 ; file 58.811
43 D EN^PSUPR3 ; file 58.81
44 K PSUMSG
45 D EN^PSUPR4(.PSUMSG) ; detailed mail message to Hines
46 D EN^PSUPR5 ;Summary Mail Routines
47 ;
48 ; return counters to master routine
49 S PSUSUB="PSU_"_PSUJOB
50 I $D(^XTMP(PSUSUB)),PSUDUZ,PSUPBMG M ^XTMP(PSUSUB,"CONFIRM")=PSUMSG
51 ;D EN^PSUPR5 ; Summary Mail Routines
52 Q
53PRINT ;EP Tasking Entry Point for PRINT REPORT
54 D EN^PSUPR6
55 Q
56EXIT ;EP Tasking Entry Point for Cleaning out XTMP and Variables
57 ; Restore Important Variables
58 K X
59 M X=^XTMP(PSUPRSUB,"SAVE")
60 K ^XTMP(PSUPRSUB)
61 D VARKILL^PSUTL
62 ; Restore Important Variables CONTINUED
63 S Y="" F S Y=$O(X(Y)) Q:Y="" S @Y=X(Y)
64 K X
65 Q
66 ;
67CLEAR ;EP clear ^XTMP of PSUPR nodes
68 S X="PSUPR"
69 F S X=$O(^XTMP(X)) Q:X="" Q:$E(X,1,5)'="PSUPR" W !,X K ^XTMP(X)
70 Q
71MANUAL ;EP Manual entry point for Running Procurement Module to
72 ; exercise detailed message, summary messages, & Reports
73 ; Some startup code borrowed from PSUCP for dates
74 W !,"Mail messages are sent to the user only at this time",!
75 S PSUMON=$E(DT,1,5),(PSUSMRY,PSUMASF,PSUPBMG)=1,PSUDUZ=DUZ
76 S X=$P($G(^XMB(1,1,"XUS")),U,17),PSUSNDR=+$P(^DIC(4,X,99),U)
77 K %DT
78 S %DT="AEX",%DT(0)="-NOW",%DT("A")="STARTING Procurement Extract Date or ""^"" to quit : " D ^%DT
79 I X["^" Q
80 I 'Y Q
81 S PSUSDT=+Y
82 K %DT W !
83 S %DT="AEX",%DT(0)=PSUSDT,%DT("A")="ENDING Procurement Extract Date or ""^"" to restart: " D ^%DT
84 I X["^" G MANUAL
85 I 'Y G MANUAL
86 S PSUEDT=+Y
87 W !
88 S Y=PSUSDT D DD^%DT W !,"Starting Procurement Date",?30,Y
89 S Y=PSUEDT D DD^%DT W !,"Ending Procurement Date:",?30,Y
90 K DIR W !
91 S DIR(0)="Y",DIR("A")="Correct ? ",DIR("B")="YES" D ^DIR
92 I 'Y G MANUAL
93 K DIR W !
94 W !,"You can not queue to your terminal",!
95 W !,"You can queue to a host file",!
96 S DIR(0)="Y",DIR("A")="Do yo want reports printed ? ",DIR("B")="YES" D ^DIR
97 K DIR W !
98 S PSURP=+Y
99 S PSURC="COMPUTE^PSUPR0"
100 I PSURP S PSURP="PRINT^PSUPR0" K PSUIOP
101 E K PSURP S PSUIOP="" ; MAIL MESSAGES ONLY
102 S PSURX="EXIT^PSUPR0"
103 S PSUNS="PSUPR*,PSUSDT,PSUEDT,PSU*"
104 D EN^PSUDBQUE
105 Q
Note: See TracBrowser for help on using the repository browser.