source: FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSURT1.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA

File size: 3.8 KB
Line 
1PSURT1 ;BIR/RDC - PATIENT DEMOGRAPHIC RETRANSMITION; 31 MAR 2004
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ; THIS PROGRAM WILL ALLOW THE RETRANSMITION OF THE PATIENT
5 ; DEMOGRAPHIC DATA FOR THE PBM EXTRACT USING THE DATA
6 ; FROM ^PSUDEM (59.9) FOR RUN TIME OPTIMIZATION
7 ;
8EN ; ENTRY POINT
9 NEW P,SDT,EDT,WHEN,NOGOOD,TMON,RMONTH,PMON,SMON,EMON,RTYPE,SRANGE,ERANGE
10 S P=""
11 D CLEANUP^PSUHL
12 S SDT=$O(^PSUDEM("B",P))
13 I 'SDT W !,"NO DATA AVAILABLE - NOTIFY YOUR SUPERVISOR" Q
14 S EDT=$O(^PSUDEM("B",P),-1)
15 S Y=SDT X ^DD("DD") S START=Y
16 S Y=EDT-1 X ^DD("DD") S STOP=Y
17 W !,"This option will allow the retransmission of Patient Demographic and Outpatient Visit data stored in the PBM PATIENT DEMOGRAPHICS FILE. Statistical data starting from "
18 W START
19 W " through "
20 W STOP
21 W " is available for retransmission."
22 W !
23 ;
24 ; let fileman get response
25 S DIR("A")="Is this a monthly report",DIR(0)="YO"
26 D ^DIR K DIR
27 ;
28 S NOGOOD=1
29 I Y=1 S NOGOOD=0 D MONTH
30 I Y=0 S NOGOOD=0 D RANGE
31 Q:NOGOOD
32 D PROCESS ; *** process the extract ***
33 Q
34 ;
35MONTH ; *** allow only whole months to be processed ***
36 W !
37 S TMON=$E(DT,4,5)
38 S DIR("A")="Select Month/Year",DIR(0)="F" D ^DIR
39 K DIR,DIR("A")
40 I $D(DIRUT) S NOGOOD=1 Q
41 S %DT="MP" D ^%DT K %DT
42 I Y=-1 W !!,"Invalid Month/Year. Please Reenter a month and year." G MONTH
43 S RMONTH=$$FMTE^XLFDT(Y) W " ("_RMONTH_")"
44 ; S %DT(0)=SDT,%DT="MP"
45 ; S X=Y
46 ; D ^%DT K %DT
47 I $E(Y,4,5)=TMON S Y=-1
48 I Y=-1 W !!,"Data for the entire month of "_RMONTH_" is not available. Please reenter a month/year." G MONTH
49 I Y>DT W !!,"You may not select a date from the future. Please reenter a month/year within the valid parameters." G MONTH
50 ;
51 S PSURMON=Y
52 S SMON=$E(PSURMON,1,5)_"00"
53 S EMON=$E(PSURMON,1,5)_"99"
54 S RTYPE="M"
55 Q
56 ;
57RANGE ; *** process a range of dates from within file #59.9 ***
58 S %DT(0)=SDT
59 ;
60BGNRNG ;
61 W !
62 S %DT="PAE",%DT("A")="Select start date: " D ^%DT K %DT,%DT("A")
63 I X="^"!($G(DTOUT)) S NOGOOD=1 Q
64 I Y=-1 W !!,"Invalid date. Please reenter a start date." G BGNRNG
65 I Y=DT W !!,"Today is not a valid start date. Please reenter a start date." G BGNRNG
66 ;
67 I Y>DT W !!,"You may not select a date in the future. Please reenter a start date." G BGNRNG
68 ;
69 S SRANGE=Y ; * start with this date ***
70 ;
71ENDRNG ;
72 W !
73 S %DT="PAE",%DT("A")="Select stop date: " D ^%DT K %DT,%DT("A")
74 I X="^"!($G(DTOUT)) S NOGOOD=1 Q
75 I Y=-1 W !!,"Invalid date. Please reenter a stop date." G ENDRNG
76 I Y=DT W !!,"Statistical data has not been compiled for current date. Please reenter a stop date." G ENDRNG
77 ;
78 I Y<SRANGE W !!,"You need to select a stop date greater than your start date. Please reenter your start/stop dates." G BGNRNG
79 ;
80 I Y>DT W !!,"You may not select a date in the future. Please reenter a stop date." G ENDRNG
81 ;
82 S ERANGE=Y ; * end at this date ***
83 ;
84 S RTYPE="R"
85 K %DT(0)
86 ;
87 Q
88PROCESS ;
89 I RTYPE="R" S (START,PSUSRNG)=SRANGE,(LAST,PSUERNG)=ERANGE
90 I RTYPE="M" S START=SMON,LAST=EMON
91 ;
92 S PSUSMRY=0
93 W !!
94 S DIR("A")="Do you want a copy of this report sent to you in a MailMan message?"
95 S DIR(0)="YO"
96 S DIR("B")="NO"
97 D ^DIR K DIR,DIR(0)
98 I Y="^" Q
99 I Y=1 S PSUMME=1,PSUDUZ=DUZ
100 ;
101 I RTYPE="M" D
102 . W !!
103 . S DIR("A")="Send this to the PBM section for addition to the master file?"
104 . S DIR(0)="YO"
105 . S DIR("B")="NO"
106 . D ^DIR K DIR,DIR(0)
107 . I Y=1 S PSUMSTR=1
108 ;
109 I Y="^" Q
110 S PSUSTART=START,PSULAST=LAST
111 K %DT,PSUWHEN
112 D NOW^%DTC S %DT="REAX",%DT(0)="A",%DT("B")="NOW",%DT("A")="Queue to run at what time: " D ^%DT
113 S PSUWHEN=Y
114 S ZTRTN="EN^PSURT2",ZTIO="",ZTDESC="RETRASMISSION OF PT DEMOGRAPHICS",ZTDTH=PSUWHEN
115 S ZTSAVE("PSUSTART")=""
116 S ZTSAVE("PSULAST")=""
117 S ZTSAVE("PSUMME")=""
118 S ZTSAVE("PSUMSTR")=""
119 S ZTSAVE("PSURMON")=""
120 S ZTSAVE("PSUSRNG")=""
121 S ZTSAVE("PSUERNG")=""
122 S ZTSAVE("PSUDUZ")=""
123 S ZTSAVE("PSUSMRY")=""
124 ;
125 ; D ^PSURT2
126 ; Q
127 ;
128 D ^%ZTLOAD
129 Q
130 ;
Note: See TracBrowser for help on using the repository browser.