| 1 | PSUCP1 ;BIR/TJH,PDW - PBM - CONTROL POINT, MANUAL ENTRY ;25 AUG 1998
|
|---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | ;DBIA's
|
|---|
| 5 | ; Reference to file #4 supported by DBIA 10090
|
|---|
| 6 | ; Reference to file #4.3 supported by DBIA 10091
|
|---|
| 7 | ;
|
|---|
| 8 | EN ; start here
|
|---|
| 9 | D PSUHDR ; display option explanation
|
|---|
| 10 | S PSUERR=0
|
|---|
| 11 | S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99)
|
|---|
| 12 | ASK ; ask type of report desired
|
|---|
| 13 | S DIR("?",1)="If this is the monthly report that will be sent to the PBM section"
|
|---|
| 14 | S DIR("?",2)="for inclusion into the master file, answer with a 'Y' for YES."
|
|---|
| 15 | S DIR("?",3)="If this is not the monthly report or you want to specify a date range"
|
|---|
| 16 | S DIR("?")="then enter 'N' for NO."
|
|---|
| 17 | S DIR("A")="Is this the monthly report",DIR(0)="YO"
|
|---|
| 18 | D ^DIR K DIR W !
|
|---|
| 19 | G ERR:(Y="^")!(Y="")!($D(DTOUT))
|
|---|
| 20 | K DTOUT
|
|---|
| 21 | S PSUAM=Y,ERC=0
|
|---|
| 22 | DATES ; do this if user entered N, wants date range
|
|---|
| 23 | I 'PSUAM D
|
|---|
| 24 | .K PSUMNTH
|
|---|
| 25 | .S %DT(0)=2880000,%DT="AEPX",%DT("A")="Select Start Date: "
|
|---|
| 26 | .D ^%DT K %DT W !
|
|---|
| 27 | .I +Y'>0 S ERC=1 Q ; condition 1, exit.
|
|---|
| 28 | .S PSUSDT=+Y
|
|---|
| 29 | .S %DT(0)=2880000,%DT="AEPX",%DT("A")=" Select End Date: "
|
|---|
| 30 | .D ^%DT K %DT W !
|
|---|
| 31 | .I +Y'>0 S ERC=1 Q ; condition 1, exit.
|
|---|
| 32 | .S PSUEDT=+Y
|
|---|
| 33 | .I PSUEDT'>PSUSDT D Q
|
|---|
| 34 | ..W !!,"The end date of the search must be greater than the start date.",!
|
|---|
| 35 | ..K PSUSDT,PSUEDT
|
|---|
| 36 | ..S ERC=2 ; condition 2, ask dates again
|
|---|
| 37 | .I PSUSDT>DT!(PSUEDT>DT) D
|
|---|
| 38 | ..W !!,"Searches cannot be executed for future dates.",!
|
|---|
| 39 | ..K PSUSDT,PSUEDT
|
|---|
| 40 | ..S ERC=2 ; condition 2, ask dates again
|
|---|
| 41 | I ERC=1 G ERR
|
|---|
| 42 | I ERC=2 S ERC=0 G DATES
|
|---|
| 43 | ;
|
|---|
| 44 | PSUMON ; do this if user asked for monthly report
|
|---|
| 45 | I PSUAM D
|
|---|
| 46 | .S PSUMNTH=1
|
|---|
| 47 | .S %DT(0)=2880000,%DT="MAEP",%DT("A")="Select Month/Year: " K DTOUT,X,Y
|
|---|
| 48 | .D ^%DT K %DT W !
|
|---|
| 49 | .S ERC=$S($D(DTOUT):1,X="^":1,X="^^":3,+Y'>0:1,1:0)
|
|---|
| 50 | .Q:ERC ; check error condition
|
|---|
| 51 | .I Y>DT!($E(Y,1,5)=$E(DT,1,5)) D Q:ERC
|
|---|
| 52 | ..W !!,"PBM statistical data can only be compiled for months that have already passed.",!
|
|---|
| 53 | ..K Y
|
|---|
| 54 | ..S ERC=2 ; condition 2, ask month again
|
|---|
| 55 | .I $E(Y,4,5)="00" D Q:ERC
|
|---|
| 56 | ..W !!,"Oops, you forgot to enter a month. Try again, please."
|
|---|
| 57 | ..K Y
|
|---|
| 58 | ..S ERC=2
|
|---|
| 59 | .S PSUSDT=$E(Y,1,5)_"01",MNUM=$E(Y,4,5)
|
|---|
| 60 | .S PSUMTH=$E(Y,1,5) ;leap year correction
|
|---|
| 61 | .S PSULY=$$LEAPYR^PSUCP(PSUMTH) ;leap year correction
|
|---|
| 62 | .S PSUEDT=$E(Y,1,5)_$S(MNUM["02":$S(PSULY:"29",1:"28"),MNUM="04":"30",MNUM="06":"30",MNUM="09":"30",MNUM="11":"30",1:31) ;leap year correction
|
|---|
| 63 | .;S PSUEDT=$E(Y,1,5)_$S(MNUM="02":"29",MNUM="04":"30",MNUM="06":"30",MNUM="09":"30",MNUM="11":"30",1:31)
|
|---|
| 64 | ;
|
|---|
| 65 | ;
|
|---|
| 66 | G ERR:ERC=1,ASK:ERC=3
|
|---|
| 67 | I ERC=2 S ERC=0 G PSUMON ; erroneous input, try again
|
|---|
| 68 | S ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=$E(PSUSDT,1,5)
|
|---|
| 69 | ;
|
|---|
| 70 | SETDT ; set month name variables
|
|---|
| 71 | S X=PSUSDT D DATE S PSUMON1=Y
|
|---|
| 72 | S X=PSUEDT D DATE S PSUMON2=Y
|
|---|
| 73 | S X=$E(PSUSDT,1,5)_"00" D DATE S PSUMON=$E(PSUSDT,1,5)
|
|---|
| 74 | S ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=PSUMON
|
|---|
| 75 | K X,X1
|
|---|
| 76 | ;
|
|---|
| 77 | SELF ; include self and PSU PBM mailgroup
|
|---|
| 78 | S PSUPBMG=0
|
|---|
| 79 | S PSUDUZ=0
|
|---|
| 80 | S DIR("A")="Do you want a copy of this report sent to you in a MailMan message"
|
|---|
| 81 | S DIR("?")="Please answer with a 'Y' or 'N'."
|
|---|
| 82 | S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 83 | D ^DIR K DIR,DIRUT,DIROUT,DUOUT,DTOUT W !
|
|---|
| 84 | G ERR:Y="",ERR:Y="^",DATES:Y["^^"
|
|---|
| 85 | I Y S PSUDUZ=DUZ,^XTMP("PSU_"_PSUJOB,"PSUFLAG1")="",^XTMP("PSU_"_PSUJOB,"PSUFLAG2")="",PSUFLAG1=1,PSUFLAG2=1
|
|---|
| 86 | I 'Y S ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")="",PSUFLAG3=1
|
|---|
| 87 | I Y S PSUPBMG=1 ;Send copy to PSU PBM mail group
|
|---|
| 88 | ;
|
|---|
| 89 | MASTER ; if monthly, should it be added to master file
|
|---|
| 90 | S (PSUMASF,Y)=0
|
|---|
| 91 | I PSUAM D
|
|---|
| 92 | .S DIR("A")="Send this to the PBM section for addition to the master file"
|
|---|
| 93 | .S DIR("?")="Please answer with a 'Y' or 'N'."
|
|---|
| 94 | .S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 95 | .D ^DIR K DIR,DIRUT,DIROUT,DUOUT,DTOUT W !
|
|---|
| 96 | G ERR:Y="",ERR:Y="^",SELF:Y["^^"
|
|---|
| 97 | I Y S PSUMASF=1
|
|---|
| 98 | ;
|
|---|
| 99 | MODULE ; display and select module(s)
|
|---|
| 100 | D OPTS^PSUCP ; set up PSUA array with option info
|
|---|
| 101 | W !!,"Select one or more of the following:",!
|
|---|
| 102 | F I=1:1:12 W !,I,".",?5,PSUA(I,"M")
|
|---|
| 103 | W !!,"Laboratory data and a Patient Demographic summary report will be automatically"
|
|---|
| 104 | W !,"generated if IVs, Unit Dose, or Prescription extracts are chosen."
|
|---|
| 105 | W !,"You may select all of the modules by entering 'A' for ALL or by using '1:12'."
|
|---|
| 106 | W !!,"The Provider Data report may take an extended amount of time to run."
|
|---|
| 107 | W !,"It is recommended that it be run during off peak hours."
|
|---|
| 108 | MODP ; module selection prompt
|
|---|
| 109 | W !!,"Select the code(s) associated with the data requested: "
|
|---|
| 110 | R X:DTIME E G ERR
|
|---|
| 111 | I X["^" G ERR:X="^",MASTER:PSUAM,SELF
|
|---|
| 112 | I X="" W " <??>",$C(7) S X="?"
|
|---|
| 113 | ;
|
|---|
| 114 | ;
|
|---|
| 115 | ;I X["7" D G MODULE
|
|---|
| 116 | ;.W !!,"Lab may not be selected directly. It will be automatically included when"
|
|---|
| 117 | ;.W !,"options 1, 2 or 4 are part of the selection."
|
|---|
| 118 | S:"Aa"[$E(X) X="1:12"
|
|---|
| 119 | MODHLP I X["?" D G MODULE:X["??",MODP
|
|---|
| 120 | .W !!,"Enter: A single code number to print just that report."
|
|---|
| 121 | .W !,?8,"A range of code numbers. Example: 1:3"
|
|---|
| 122 | .W !,?8,"Multiple code numbers separated by commas. Example: 2,4,5"
|
|---|
| 123 | .W !,?8,"The letter A to select ALL reports."
|
|---|
| 124 | .W !,?8,"A single up-arrow ( ^ ) to exit now without running any reports."
|
|---|
| 125 | .W !,?8,"Double up-arrow ( ^^ ) to go back to a previous prompt.",!
|
|---|
| 126 | S X=$TR(X,"-;_><.A","::::::")
|
|---|
| 127 | K PSUMOD
|
|---|
| 128 | F PII=1:1:$L(X,",") D
|
|---|
| 129 | .S X1=$P(X,",",PII)
|
|---|
| 130 | .Q:X1=""
|
|---|
| 131 | .I X1[":" D Q
|
|---|
| 132 | ..S XBEG=$P(X1,":",1),XEND=$P(X1,":",2)
|
|---|
| 133 | ..I (XBEG="")!(XEND="") Q
|
|---|
| 134 | ..F PJJ=XBEG:1:XEND S PSUMOD(PJJ)=""
|
|---|
| 135 | ..K PJJ,XBEG,XEND
|
|---|
| 136 | .S PSUMOD(X1)=""
|
|---|
| 137 | S (X,ERC)=0 F S X=$O(PSUMOD(X)) Q:X="" I '$D(PSUA(X)) S ERC=1 Q
|
|---|
| 138 | I ERC W !!,"<INVALID CHOICE - ",X,", TRY AGAIN>",$C(7) G MODP
|
|---|
| 139 | I '$D(PSUMOD) W !!,"No choices were made." S X="?" G MODHLP
|
|---|
| 140 | ;
|
|---|
| 141 | F PII=1,2,4 I $D(PSUMOD(PII)) S PSUMOD(13)="" ; add Lab if IV,UD or OP
|
|---|
| 142 | ;
|
|---|
| 143 | W !!,"You have selected: "
|
|---|
| 144 | S X="",PSUOPTS="" F S X=$O(PSUMOD(X)) Q:X="" W ?20,X," - ",PSUA(X,"M"),! S PSUOPTS=PSUOPTS_X_","
|
|---|
| 145 | I $D(PSUMOD(1))!$D(PSUMOD(2))!$D(PSUMOD(4)) D
|
|---|
| 146 | . W ?20,"Patient Demographic Summary" W !
|
|---|
| 147 | S PSUOPTS=$E(PSUOPTS,1,$L(PSUOPTS)-1) ; remove trailing comma
|
|---|
| 148 | ;
|
|---|
| 149 | ;Set flag for combined AMIS summary report.
|
|---|
| 150 | I (PSUOPTS["1,2,3,4")&(PSUOPTS[6) S ^XTMP("PSU_"_PSUJOB,"CBAMIS")=""
|
|---|
| 151 | ;
|
|---|
| 152 | RPT ; select report type - full report or summary only
|
|---|
| 153 | D:PSUOPTS'=11&(PSUOPTS'=12) ; no summary for VITALS/IMMS OR AA**
|
|---|
| 154 | . S DIR("A")="Print Summary Only"
|
|---|
| 155 | . S DIR("?",1)="Please answer with a 'Y' or 'N'."
|
|---|
| 156 | . S DIR("?")="Answer Yes and only the summary report will be generated."
|
|---|
| 157 | . S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 158 | . D ^DIR K DIR,DIRUT,DIROUT,DUOUT,DTOUT W !
|
|---|
| 159 | . G ERR:Y="",ERR:Y="^",MODULE:Y["^^"
|
|---|
| 160 | . S PSUSMRY=$S(Y:1,1:0)
|
|---|
| 161 | S:PSUOPTS=11!(PSUOPTS=12) PSUSMRY=0
|
|---|
| 162 | ;
|
|---|
| 163 | ;
|
|---|
| 164 | BCKGND ; always run as a background job
|
|---|
| 165 | W !!,"This report will automatically run as a background job."
|
|---|
| 166 | ; ask time to queue
|
|---|
| 167 | S DIR("?",1)="You can start the program now or queue it to start later."
|
|---|
| 168 | S DIR("?",2)="Past date/time is not allowed. Future dates up to 10 days are allowed."
|
|---|
| 169 | S DIR("?")="Enter an appropriate date and time or press <Enter> to start now."
|
|---|
| 170 | S %DT="RX",X="NOW+10" D ^%DT
|
|---|
| 171 | S DIR("A")="REQUESTED TIME TO RUN: ",DIR(0)="DAO^NOW:"_Y_":EFRX"
|
|---|
| 172 | S DIR("B")="NOW"
|
|---|
| 173 | D ^DIR K DIR W !
|
|---|
| 174 | G ERR:(Y="^")!(Y="")!($D(DTOUT))
|
|---|
| 175 | K DTOUT
|
|---|
| 176 | S PSUDTH=Y
|
|---|
| 177 | ;
|
|---|
| 178 | DEVICE ;
|
|---|
| 179 | S PSUIOP="",PSUPOP=1
|
|---|
| 180 | I 'PSUDUZ D G ERR:POP
|
|---|
| 181 | . I PSUOPTS=11!(PSUOPTS=12) W !,"HARDCOPIES NOT AVAILABLE FOR THIS OPTION" S POP=1 Q
|
|---|
| 182 | .S PSUIO=ION_";"_IOST_";"_IOM_";"_IOSL
|
|---|
| 183 | .S %ZIS="N0",%ZIS("B")="",%ZIS("A")="Select 132 column device: "
|
|---|
| 184 | .D ^%ZIS K %ZIS
|
|---|
| 185 | .I POP!($E(IOST)="C"),$G(PSUFQ) D I PSUPOP S POP=1 Q
|
|---|
| 186 | ..W !!,"You have not selected an appropriate print device."
|
|---|
| 187 | ..W !,"Enter 'C' to continue data compilation and send mail messages"
|
|---|
| 188 | ..W !," but not print any hardcopy."
|
|---|
| 189 | ..W !,"Enter '^' to abort this whole option now."
|
|---|
| 190 | ..F R !,"-> ",PSUX:DTIME Q:"C^"[$E(PSUX) W " ??"
|
|---|
| 191 | ..S PSUPOP=$S(PSUX="C":0,1:1)
|
|---|
| 192 | .S PSUIOP=$S('PSUPOP:"",1:ION_";"_IOST_";"_IOM_";"_IOSL) ; save printer parameters
|
|---|
| 193 | .D RESETVAR^%ZIS ; restore terminal parameters
|
|---|
| 194 | EXIT ; exit point for normal finish
|
|---|
| 195 | ;
|
|---|
| 196 | Q ; return to calling routine, ^PSUCP
|
|---|
| 197 | ;
|
|---|
| 198 | PSUHDR ;Display header
|
|---|
| 199 | W !!,"The Pharmacy Benefits Management (PBM) report will extract"
|
|---|
| 200 | W !,"statistics from one or more of the following files:",!
|
|---|
| 201 | W !,"1. Pharmacy Patient IV Sub-file File # 55.01"
|
|---|
| 202 | W !,"2. Pharmacy Patient UD Sub-file File # 55.06"
|
|---|
| 203 | W !,"3. AR/WS Stats File # 58.5"
|
|---|
| 204 | W !,"4. Prescription File # 52"
|
|---|
| 205 | W !,"5. Procurement File # 58.811,# 58.81"
|
|---|
| 206 | W !,"6. Controlled Substances File # 58.81"
|
|---|
| 207 | W !,"7. Patient Demographics File # 2"
|
|---|
| 208 | W !,"8. Outpatient Visits File # 9000010,# 9000010.07"
|
|---|
| 209 | W !,"9. Inpatient PTF Record File # 45"
|
|---|
| 210 | W !,"10. Provider Data File # 200,# 7,# 49,# 8932.1"
|
|---|
| 211 | W !,"11. Allergy/Adverse Event File # 120.8,# 120.85"
|
|---|
| 212 | W !,"12. Vitals/Immunization Record File # 120.5,# 9999999.14"
|
|---|
| 213 | W !,"13. Laboratory File # 60,# 63"
|
|---|
| 214 | ;
|
|---|
| 215 | W !!,"This data can be collected for ALL of the files listed or for one or"
|
|---|
| 216 | W !,"more specific files. A summary of data or a detailed report by drug"
|
|---|
| 217 | W !,"can be delivered to you in a mail message or in a hard copy report.",!!
|
|---|
| 218 | Q
|
|---|
| 219 | ;
|
|---|
| 220 | DATE ;Date conversion
|
|---|
| 221 | S Y=X X ^DD("DD") S:Y="" Y="Unknown"
|
|---|
| 222 | Q
|
|---|
| 223 | ;
|
|---|
| 224 | ERR ; Exit point following erroneous input or ^
|
|---|
| 225 | K ERC,MNUM,MOD,PII,PSUA,PSUAM,PSUDUZ,PSUEDT,PSUPBMG,PSUMASF,PSUPBMG,PSUMNTH,PSUMOD
|
|---|
| 226 | ;K PSUMON,PSUMON1,PSUMON2,PSUOPTS,PSUSDT,PSUSMRY,X1
|
|---|
| 227 | K PSUMON1,PSUMON2,PSUOPTS,PSUSDT,PSUSMRY,X1
|
|---|
| 228 | S PSUERR=1
|
|---|
| 229 | Q
|
|---|
| 230 | ;
|
|---|
