- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCP.m
r613 r623 1 PSUCP ;BIR/TJH,PDW - PBM CONTROL POINT ; 06/08/07 2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19 3 ; Reference to File #4 supported by DBIA 10090 4 ; Reference to File #4.3 supported by DBIA 10091 5 ; Reference to File #40.8 supported by DBIA 2438 6 ; Reference to File #59.7 supported by DBIA 2854 7 ; move CLEANUP^PSUHL from PSURT1, delete calls to PSUCP3 (PSU*4*12) 8 MANUAL ; entry point for manual option 9 S PSUALERT=0 D MANUAL^PSUALERT 10 I PSUALERT K PSUALERT Q 11 K PSUALERT 12 S PSUFQ=1 13 I $D(^XTMP("PSUJFLG")) D Q:Y=0 Q:Y="^" 14 .W !!,"NOTE: A PREVIOUS JOB HAS NOT COMPLETED DUE TO AN ERROR" 15 .W !!,"PLEASE ALERT YOUR IRM." 16 .W !!,"RESPOND 'YES' TO CONTINUE, OR 'NO' TO EXIT" 17 .S DIR(0)="Y",DIR("B")="NO" 18 .S DIR("A")="Do you wish to continue" 19 .D ^DIR 20 D CLEANUP^PSUHL 21 S PSUJOB=$J_"_"_$P($H,",",2) 22 S ^XTMP("PSUMANL")="" 23 D EN^PSUCP1 ; prompt for report choices 24 I PSUERR G EXIT 25 D XMY^PSUTL1 ; Setup for mail groups according to choices 26 S ^XTMP("PSUJFLG")="",PSUAUTO=0,^XTMP("PSU_"_PSUJOB,"PSUJOB")=PSUJOB 27 D PUT 28 S PSUTITLE="PSU PBM MANUAL",PSURC="RUN^PSUCP" 29 S PSURP=$S('$L(PSUIOP):"",1:"PRINT^PSUCP") 30 S PSURX="EXIT^PSUCP",PSUNS="PS" 31 S ^XTMP("PSU","RUNNING")=$G(ZTSK) 32 K PSUALERT,XAQ,SQAFLG,SQAID,XQAMSG,XQMSG,ZTSK 33 D ^PSUDBQUE 34 MANUALQ Q 35 ; 36 AUTO ; set variables for Auto-report option and task to background 37 S PSUALERT=0 D AUTO^PSUALERT 38 I PSUALERT K PSUALERT Q 39 I $D(^XTMP("PSU","RUNNING")) D Q 40 .S XQA(DUZ)="",XQA("G.PSU PBM")="",XQMSG="An ERROR has occurred. Please contact IRM for assistance." 41 .S XQAID="PSU",XQAFLG="D" D SETUP^XQALERT 42 D CLEANUP^PSUHL 43 S PSUJOB=$J_"_"_$P($H,",",2) 44 S ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")="" ;flag for mail patient summary reports 45 S ^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG")=1 ;Set 'auto' flag 46 S ^XTMP("PSUJFLG")="" ;FLAG to avoid concurrent jobs running 47 D ; schedule job completion check 48 .S PSURC="AUTO^PSUCP2",PSUTITLE="PSU PBM JOB CHECK",PSUFQ=1 49 .S (PSURP,PSURX,PSUIOP)="" 50 .D NOW^%DTC S X1=%,X2=6 D C^%DTC S PSUDTH=X ; LIVE MODE, wait 6 days (72 hours) 51 .D ^PSUDBQUE 52 .S ^XTMP("PSU","RUNNING")=$G(ZTSK) 53 D NOW^%DTC S PSUMON=$S('$D(DT):X,1:DT),PSUMON=$E(PSUMON,1,5)-1 ; get previous month 54 I $E(PSUMON,4,5)="00" S PSUMON=($E(PSUMON,1,3)-1)_"12" ; set to Dec. of previous year if this month is Jan. 55 S ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=PSUMON,PSUSDT=PSUMON_"01" 56 S PSULY=$$LEAPYR(PSUMON),X=U_$E(PSUMON,4,5)_U 57 S PSUEDT=PSUMON_$S(X["02":$S(PSULY:"29",1:"28"),"^04^06^09^11^"[X:"30",1:"31") 58 S PSUDUZ=$S(DUZ=0:.5,1:DUZ),PSUMASF=1,PSUSMRY=0,PSUPBMG=1 59 S ^XTMP("PSU_"_PSUJOB,"PSUPDFLAG")=1 ;Flag-detailed PD won't go to user auto extract 60 S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99) 61 S PSUOPTS="1,2,3,4,5,6,7,8,9,10,11,12,13",PSUAUTO=1,PSUIOP="" D 62 .S ^XTMP("PSU_"_PSUJOB,"CBAMIS")="" 63 S ^XTMP("PSU_"_PSUJOB,"PSUJOB")=PSUJOB 64 D PUT 65 S PSUTITLE="PSU PBM AUTO",PSURC="RUN^PSUCP",PSURX="EXIT^PSUCP",PSURP="",PSUNS="PS",PSUFQ=1 66 D NOW^%DTC S PSUDTH=% 67 D ^PSUDBQUE 68 K PSUALERT,XQA,XQAID,XQAFLG,XQA,ZTSK 69 AUTOQ Q ; exit from AUTO 70 ; 71 RUN ; run each selected module 72 L ^XTMP("PSU","RUNNING"):1 I '$T Q 73 D PULL,OPTS 74 K PSUMOD,PSUFDA 75 I PSUAUTO S PSUFDA(59.7,"1,",90)="@" D FILE^DIE("","PSUFDA","") 76 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))="" 77 S PSUOPTN="" 78 F S PSUOPTN=$O(PSUMOD(PSUOPTN)) Q:PSUOPTN="" D 79 .K PSUMSGT 80 .D PULL 81 .I PSUAUTO S PSUPBMG=1 82 .D XMY^PSUTL1 83 .S PSURTN=PSUA(PSUOPTN,"R") 84 .D NOW^%DTC 85 .S ^XTMP("PSU_"_PSUJOB,"STATUS",PSUOPTN,"START")=% 86 .D @PSURTN,PULL,NOW^%DTC 87 .S ^XTMP("PSU_"_PSUJOB,"STATUS",PSUOPTN,"STOP")=% 88 D DT^DILF("E",PSUSDT,.EXTD) 89 S PSURP("START")=EXTD(0) 90 D DT^DILF("E",PSUEDT,.EXTD) 91 S PSURP("END")=EXTD(0),PSUSUB="PSU_"_PSUJOB 92 D MMNOMAP^PSUCP2 ; MM send regarding PBM locations not mapped 93 D TIMING ; send a report of how long each module took to complete 94 I PSUMASF!PSUPBMG D CONFIRM ;Confirmation message sent only if data went to Master File 95 I PSUAUTO D 96 .D NOW^%DTC 97 .S PSUFDA(59.7,"1,",90)=% K %,%H,%I,X 98 .D FILE^DIE("","PSUFDA","") ; file the completion date in 59.7,90;1 99 L 100 ; 101 Q 102 PRINT ; print hard copy if requested 103 Q:'$L(PSUIOP) ; no printer selected, stop right here. 104 D PULL,OPTS 105 K PSUMOD 106 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))="" 107 S PSUOPTN="" 108 F S PSUOPTN=$O(PSUMOD(PSUOPTN)) Q:PSUOPTN="" D 109 .D PULL 110 .S PSURTN=PSUA(PSUOPTN,"P") 111 .D @PSURTN 112 L 113 K ^XTMP("PSU","RUNNING") 114 PRINTQ Q 115 EXIT ; exit point 116 K ^XTMP("PSU","RUNNING") 117 K ^XTMP("PSUJFLG") ;Remove flag to prevent concurrent jobs 118 Q 119 PUT ; put variables in ^XTMP so modules can retrieve them 120 S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUIOP,PSUSNDR,PSUOPTS,PSUAUTO" 121 S PSUVSTR="" 122 F I=1:1:$L(PSUVARS,",") S $P(PSUVSTR,U,I)=@$P(PSUVARS,",",I) 123 S X1=DT,X2=6 D C^%DTC 124 S ^XTMP("PSU_"_PSUJOB,0)=X_U_DT_U_"Control data for PSU PBM individual modules" 125 S ^XTMP("PSU_"_PSUJOB,1)=PSUVSTR 126 K PSUVARS,PSUVSTR,X,X1 127 PUTQ Q 128 PULL ; pull variables from ^XTMP 129 ; PSUJOB must exist and must be the job number used to store the data desired for this session. 130 N I 131 S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUIOP,PSUSNDR,PSUOPTS,PSUAUTO" 132 F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P($G(^XTMP("PSU_"_PSUJOB,1)),U,I) 133 PULLQ Q 134 ; 135 OPTS ; set option array 136 S PSUA(1,"M")="IVs",PSUA(1,"R")="EN^PSUV0",PSUA(1,"P")="PRINT^PSUV0",PSUA(1,"C")="IV" 137 S PSUA(2,"M")="Unit Dose",PSUA(2,"R")="EN^PSUUD0",PSUA(2,"P")="PRINT^PSUUD0",PSUA(2,"C")="UD" 138 S PSUA(3,"M")="AR/WS",PSUA(3,"R")="EN^PSUAR0",PSUA(3,"P")="PRINT^PSUAR0",PSUA(3,"C")="AR" 139 S PSUA(4,"M")="Prescription",PSUA(4,"R")="EN^PSUOP0",PSUA(4,"P")="PRINT^PSUOP0",PSUA(4,"C")="OP" 140 S PSUA(5,"M")="Procurement",PSUA(5,"R")="EN^PSUPR0",PSUA(5,"P")="PRINT^PSUPR0",PSUA(5,"C")="PR" 141 S PSUA(6,"M")="Controlled Substances",PSUA(6,"R")="EN^PSUCS0",PSUA(6,"P")="PRINT^PSUCS0",PSUA(6,"C")="CS" 142 S PSUA(7,"M")="Patient Demographics",PSUA(7,"R")="EN^PSUDEM1",PSUA(7,"P")="PRINT^PSUDEM0",PSUA(7,"C")="PD" 143 S PSUA(8,"M")="Outpatient Visits",PSUA(8,"R")="EN^PSUDEM2",PSUA(8,"P")="OPV^PSUDEM0",PSUA(8,"C")="OV" 144 S PSUA(9,"M")="Inpatient PTF Records",PSUA(9,"R")="EN^PSUDEM7",PSUA(9,"P")="PTF^PSUDEM0",PSUA(9,"C")="PTF" 145 S PSUA(10,"M")="Provider Data",PSUA(10,"R")="EN^PSUDEM4",PSUA(10,"P")="PRO^PSUDEM0",PSUA(10,"C")="PRO" 146 S PSUA(11,"M")="Allergies/Adverse Events",PSUA(11,"R")="EN^PSUAA1",PSUA(11,"P")="PRINT^PSUAA1",PSUA(11,"C")="AA" 147 S PSUA(12,"M")="Vitals/Immunizations Information",PSUA(12,"R")="EN^PSUVIT1",PSUA(12,"P")="EN^PSUVIT0",PSUA(12,"C")="VI" 148 S PSUA(13,"M")="Laboratory Results",PSUA(13,"R")="EN^PSULR0",PSUA(13,"P")="PRINT^PSULR0",PSUA(13,"C")="LR" 149 S PSUA("A")="" 150 OPTSQ Q 151 ; 152 CONFIRM ;Send confirmation by Division(s) 153 K PSUCONF 154 S PSUDIV=0,$P(PSUDASH,"-",81)="" 155 D OPTS 156 S PSUCONF(1)="The chart below shows the package(s) whose dispensing statistics were extracted" 157 S PSUCONF(2)="by the PBM "_$S($G(PSUAUTO):"Automatic",$G(PSURXMT):"RETRANSMISSION",1:"Manual")_" Pharmacy Statistics option." 158 ; S PSUCONF(2)="by the PBM "_$S(PSUAUTO:"Automatic",1:"Manual")_" Pharmacy Statistics option." 159 S PSUCONF(3)=" " 160 S PSUCONF(4)="PACKAGE"_$J("# Line items",35)_$J("# MailMan msgs",19) 161 S PSUCONF(5)=$E(PSUDASH,1,79) 162 F S PSUDIV=$O(^XTMP(PSUSUB,"CONFIRM",PSUDIV)) Q:PSUDIV'?1N.E D 163 .K ^XTMP(PSUSUB,"XMD") 164 .M ^XTMP(PSUSUB,"XMD")=PSUCONF 165 .S PSUOPT=0,PSULCT=5 166 .F S PSUOPT=$O(^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT)) Q:PSUOPT'?1.N D 167 ..S PSULCT=PSULCT+1 168 ..S PSUPKG=PSUA(PSUOPT,"M") 169 ..S PSULIN=^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT,"L") 170 ..S PSUMSG=^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT,"M") 171 ..S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUPKG_$J(PSULIN,37-$L(PSUPKG))_$J(PSUMSG,12) 172 ..Q:PSUPKG'="Prescription" ;* 173 .. ; process Prescription MultiDose 174 ..S PSULCT=PSULCT+1 175 ..S PSUPKG="Prescription MultiDose" 176 ..S PSULIN=+$G(^XTMP(PSUSUB,"CONFIRMD",PSUDIV,PSUOPT,"L")) 177 ..S PSUMSG=+$G(^XTMP(PSUSUB,"CONFIRMD",PSUDIV,PSUOPT,"M")) 178 ..S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUPKG_$J(PSULIN,37-$L(PSUPKG))_$J(PSUMSG,12) ;* 179 .S PSUSUBJ="PBM Stats for " 180 .I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D XMD 181 CONFIRMQ Q 182 ; 183 XMD ;Email 184 ; 185 S XMDUZ=DUZ 186 D XMY^PSUTL1 187 M XMY=PSUXMYS1 188 I $G(PSUMASF)!$G(PSUPBMG) M XMY=PSUXMYH 189 S X=PSUDIV,DIC=40.8,DIC(0)="XM" D ^DIC 190 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01) 191 S XMSUB=PSUSUBJ_PSURP("START")_" to "_PSURP("END")_" from "_PSUDIV_" "_PSUDIVNM 192 S XMTEXT="^XTMP(PSUSUB,""XMD""," 193 S XMCHAN=1 194 D ^XMD 195 XMDQ Q 196 ; 197 TIMING ; Timing report 198 K ^XTMP(PSUSUB,"XMD") 199 S $P(PSUSPACE," ",41)="" 200 S PSUX=0,PSULCT=0 201 F S PSUX=$O(^XTMP(PSUSUB,"STATUS",PSUX)) Q:PSUX="" D 202 .S (X,Y)=^XTMP(PSUSUB,"STATUS",PSUX,"START") X ^DD("DD") D 203 ..I $E(Y,17)=":" S PSUT1=$E(Y,1,16) 204 ..I $E(Y,17)'=":" S PSUT1=$E(Y,1,17) 205 .S (X1,Y)=^XTMP(PSUSUB,"STATUS",PSUX,"STOP") X ^DD("DD") D 206 ..I $E(Y,17)=":" S PSUT2=$E(Y,1,16) 207 ..I $E(Y,17)'=":" S PSUT2=$E(Y,1,17) 208 .S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1) 209 .D ^%DTC:X S X=X*1440+Y 210 .S PSULCT=PSULCT+1 211 .S PSUREC=$E(PSUA(PSUX,"M")_PSUSPACE,1,20)_$J(PSUT1,20)_$J(PSUT2,20)_$J(X\60,4)_" hrs,"_$J(X#60,3)_" min" 212 .S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUREC 213 S PSULCT=PSULCT+1 214 S $P(^XTMP(PSUSUB,"XMD",PSULCT),"-",80)="" S PSULCT=PSULCT+1 215 S ^XTMP(PSUSUB,"XMD",PSULCT)="" S PSULCT=PSULCT+1 216 S ^XTMP(PSUSUB,"XMD",PSULCT)="**NOTE: Timing for the Provider Data extract is not recorded when" S PSULCT=PSULCT+1 217 S ^XTMP(PSUSUB,"XMD",PSULCT)=" the IV, Unit Dose, Prescription, and Patient Demographics extracts" S PSULCT=PSULCT+1 218 S ^XTMP(PSUSUB,"XMD",PSULCT)=" are run concurrently." 219 S PSUDIV=PSUSNDR 220 S PSUSUBJ="PBM TIMING for report " 221 D XMD 222 TIMINGQ Q 223 ; 224 LEAPYR(FMYR) ; Check to see if year is a leap year: 1=leap year, 0=not leap year 225 N YYYY 226 S YYYY=1700+$E(FMYR,1,3) 227 Q (((YYYY#4=0)&(YYYY#100'=0))!((YYYY#100=0)&(YYYY#400=0))) 1 PSUCP ;BIR/TJH,PDW - PBM CONTROL POINT ;25 AUG 1998 2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005 3 ; Reference to File #4 supported by DBIA 10090 4 ; Reference to File #4.3 supported by DBIA 10091 5 ; Reference to File #40.8 supported by DBIA 2438 6 ; Reference to File #59.7 supported by DBIA 2854 7 MANUAL ; entry point for manual option 8 S PSUALERT=0 D MANUAL^PSUALERT 9 I PSUALERT K PSUALERT Q 10 K PSUALERT 11 S PSUFQ=1 12 I $D(^XTMP("PSUJFLG")) D Q:Y=0 Q:Y="^" 13 .W !!,"NOTE: A PREVIOUS JOB HAS NOT COMPLETED DUE TO AN ERROR" 14 .W !!,"PLEASE ALERT YOUR IRM." 15 .W !!,"RESPOND 'YES' TO CONTINUE, OR 'NO' TO EXIT" 16 .S DIR(0)="Y",DIR("B")="NO" 17 .S DIR("A")="Do you wish to continue" 18 .D ^DIR 19 D ^PSUCP3 20 S PSUJOB=$J_"_"_$P($H,",",2) 21 S ^XTMP("PSUMANL")="" 22 D EN^PSUCP1 ; prompt for report choices 23 I PSUERR G EXIT 24 D XMY^PSUTL1 ; Setup for mail groups according to choices 25 S ^XTMP("PSUJFLG")="",PSUAUTO=0,^XTMP("PSU_"_PSUJOB,"PSUJOB")=PSUJOB 26 D PUT 27 S PSUTITLE="PSU PBM MANUAL",PSURC="RUN^PSUCP" 28 S PSURP=$S('$L(PSUIOP):"",1:"PRINT^PSUCP") 29 S PSURX="EXIT^PSUCP",PSUNS="PS" 30 S ^XTMP("PSU","RUNNING")=$G(ZTSK) 31 K PSUALERT,XAQ,SQAFLG,SQAID,XQAMSG,XQMSG,ZTSK 32 D ^PSUDBQUE 33 MANUALQ Q 34 ; 35 AUTO ; set variables for Auto-report option and task to background 36 S PSUALERT=0 D AUTO^PSUALERT 37 I PSUALERT K PSUALERT Q 38 I $G(^XTMP("PSU","RUNNING")) D Q 39 .S XQA(DUZ)="",XQA("G.PSU PBM")="",XQMSG="An ERROR has occurred. Please contact IRM for assistance." 40 .S XQAID="PSU",XQAFLG="D" D SETUP^XQALERT 41 D ^PSUCP3 ;Clear trash globals 42 S PSUJOB=$J_"_"_$P($H,",",2) 43 S ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")="" ;flag for mail patient summary reports 44 S ^XTMP("PSU_"_PSUJOB,"PSUPSUMFLAG")=1 ;Set 'auto' flag 45 S ^XTMP("PSUJFLG")="" ;FLAG to avoid concurrent jobs running 46 D ; schedule job completion check 47 .S PSURC="AUTO^PSUCP2",PSUTITLE="PSU PBM JOB CHECK",PSUFQ=1 48 .S (PSURP,PSURX,PSUIOP)="" 49 .D NOW^%DTC S X1=%,X2=6 D C^%DTC S PSUDTH=X ; LIVE MODE, wait 6 days (72 hours) 50 .D ^PSUDBQUE 51 .S ^XTMP("PSU","RUNNING")=$G(ZTSK) 52 D NOW^%DTC S PSUMON=$S('$D(DT):X,1:DT),PSUMON=$E(PSUMON,1,5)-1 ; get previous month 53 I $E(PSUMON,4,5)="00" S PSUMON=($E(PSUMON,1,3)-1)_"12" ; set to Dec. of previous year if this month is Jan. 54 S ^XTMP("PSU_"_PSUJOB,"PSUMONTH")=PSUMON,PSUSDT=PSUMON_"01" 55 S PSULY=$$LEAPYR(PSUMON),X=U_$E(PSUMON,4,5)_U 56 S PSUEDT=PSUMON_$S(X["02":$S(PSULY:"29",1:"28"),"^04^06^09^11^"[X:"30",1:"31") 57 S PSUDUZ=$S(DUZ=0:.5,1:DUZ),PSUMASF=1,PSUSMRY=0,PSUPBMG=1 58 S ^XTMP("PSU_"_PSUJOB,"PSUPDFLAG")=1 ;Flag-detailed PD won't go to user auto extract 59 S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99) 60 S PSUOPTS="1,2,3,4,5,6,7,8,9,10,11,12,13",PSUAUTO=1,PSUIOP="" D 61 .S ^XTMP("PSU_"_PSUJOB,"CBAMIS")="" 62 S ^XTMP("PSU_"_PSUJOB,"PSUJOB")=PSUJOB 63 D PUT 64 S PSUTITLE="PSU PBM AUTO",PSURC="RUN^PSUCP",PSURX="EXIT^PSUCP",PSURP="",PSUNS="PS",PSUFQ=1 65 D NOW^%DTC S PSUDTH=% 66 D ^PSUDBQUE 67 K PSUALERT,XQA,XQAID,XQAFLG,XQA,ZTSK 68 AUTOQ D EXIT Q ; exit from AUTO 69 ; 70 RUN ; run each selected module 71 L ^XTMP("PSU","RUNNING"):1 I '$T Q 72 D PULL,OPTS 73 K PSUMOD,PSUFDA 74 I PSUAUTO S PSUFDA(59.7,"1,",90)="@" D FILE^DIE("","PSUFDA","") 75 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))="" 76 S PSUOPTN="" 77 F S PSUOPTN=$O(PSUMOD(PSUOPTN)) Q:PSUOPTN="" D 78 .K PSUMSGT 79 .D PULL 80 .I PSUAUTO S PSUPBMG=1 81 .D XMY^PSUTL1 82 .S PSURTN=PSUA(PSUOPTN,"R") 83 .D NOW^%DTC 84 .S ^XTMP("PSU_"_PSUJOB,"STATUS",PSUOPTN,"START")=% 85 .D @PSURTN,PULL,NOW^%DTC 86 .S ^XTMP("PSU_"_PSUJOB,"STATUS",PSUOPTN,"STOP")=% 87 D DT^DILF("E",PSUSDT,.EXTD) 88 S PSURP("START")=EXTD(0) 89 D DT^DILF("E",PSUEDT,.EXTD) 90 S PSURP("END")=EXTD(0),PSUSUB="PSU_"_PSUJOB 91 D MMNOMAP^PSUCP2 ; MM send regarding PBM locations not mapped 92 D TIMING ; send a report of how long each module took to complete 93 I PSUMASF!PSUPBMG D CONFIRM ;Confirmation message sent only if data went to Master File 94 I PSUAUTO D 95 .D NOW^%DTC 96 .S PSUFDA(59.7,"1,",90)=% K %,%H,%I,X 97 .D FILE^DIE("","PSUFDA","") ; file the completion date in 59.7,90;1 98 L 99 ; 100 Q 101 PRINT ; print hard copy if requested 102 Q:'$L(PSUIOP) ; no printer selected, stop right here. 103 D PULL,OPTS 104 K PSUMOD 105 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))="" 106 S PSUOPTN="" 107 F S PSUOPTN=$O(PSUMOD(PSUOPTN)) Q:PSUOPTN="" D 108 .D PULL 109 .S PSURTN=PSUA(PSUOPTN,"P") 110 .D @PSURTN 111 L 112 K ^XTMP("PSU","RUNNING") 113 PRINTQ Q 114 EXIT ; exit point 115 K ^XTMP("PSU","RUNNING") 116 K ^XTMP("PSUJFLG") ;Remove flag to prevent concurrent jobs 117 Q 118 PUT ; put variables in ^XTMP so modules can retrieve them 119 S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUIOP,PSUSNDR,PSUOPTS,PSUAUTO" 120 S PSUVSTR="" 121 F I=1:1:$L(PSUVARS,",") S $P(PSUVSTR,U,I)=@$P(PSUVARS,",",I) 122 S X1=DT,X2=6 D C^%DTC 123 S ^XTMP("PSU_"_PSUJOB,0)=X_U_DT_U_"Control data for PSU PBM individual modules" 124 S ^XTMP("PSU_"_PSUJOB,1)=PSUVSTR 125 K PSUVARS,PSUVSTR,X,X1 126 PUTQ Q 127 PULL ; pull variables from ^XTMP 128 ; PSUJOB must exist and must be the job number used to store the data desired for this session. 129 N I 130 S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUIOP,PSUSNDR,PSUOPTS,PSUAUTO" 131 F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P($G(^XTMP("PSU_"_PSUJOB,1)),U,I) 132 PULLQ Q 133 ; 134 OPTS ; set option array 135 S PSUA(1,"M")="IVs",PSUA(1,"R")="EN^PSUV0",PSUA(1,"P")="PRINT^PSUV0",PSUA(1,"C")="IV" 136 S PSUA(2,"M")="Unit Dose",PSUA(2,"R")="EN^PSUUD0",PSUA(2,"P")="PRINT^PSUUD0",PSUA(2,"C")="UD" 137 S PSUA(3,"M")="AR/WS",PSUA(3,"R")="EN^PSUAR0",PSUA(3,"P")="PRINT^PSUAR0",PSUA(3,"C")="AR" 138 S PSUA(4,"M")="Prescription",PSUA(4,"R")="EN^PSUOP0",PSUA(4,"P")="PRINT^PSUOP0",PSUA(4,"C")="OP" 139 S PSUA(5,"M")="Procurement",PSUA(5,"R")="EN^PSUPR0",PSUA(5,"P")="PRINT^PSUPR0",PSUA(5,"C")="PR" 140 S PSUA(6,"M")="Controlled Substances",PSUA(6,"R")="EN^PSUCS0",PSUA(6,"P")="PRINT^PSUCS0",PSUA(6,"C")="CS" 141 S PSUA(7,"M")="Patient Demographics",PSUA(7,"R")="EN^PSUDEM1",PSUA(7,"P")="PRINT^PSUDEM0",PSUA(7,"C")="PD" 142 S PSUA(8,"M")="Outpatient Visits",PSUA(8,"R")="EN^PSUDEM2",PSUA(8,"P")="OPV^PSUDEM0",PSUA(8,"C")="OV" 143 S PSUA(9,"M")="Inpatient PTF Records",PSUA(9,"R")="EN^PSUDEM7",PSUA(9,"P")="PTF^PSUDEM0",PSUA(9,"C")="PTF" 144 S PSUA(10,"M")="Provider Data",PSUA(10,"R")="EN^PSUDEM4",PSUA(10,"P")="PRO^PSUDEM0",PSUA(10,"C")="PRO" 145 S PSUA(11,"M")="Allergies/Adverse Events",PSUA(11,"R")="EN^PSUAA1",PSUA(11,"P")="PRINT^PSUAA1",PSUA(11,"C")="AA" 146 S PSUA(12,"M")="Vitals/Immunizations Information",PSUA(12,"R")="EN^PSUVIT1",PSUA(12,"P")="EN^PSUVIT0",PSUA(12,"C")="VI" 147 S PSUA(13,"M")="Laboratory Results",PSUA(13,"R")="EN^PSULR0",PSUA(13,"P")="PRINT^PSULR0",PSUA(13,"C")="LR" 148 S PSUA("A")="" 149 OPTSQ Q 150 ; 151 CONFIRM ;Send confirmation by Division(s) 152 K PSUCONF 153 S PSUDIV=0,$P(PSUDASH,"-",81)="" 154 D OPTS 155 S PSUCONF(1)="The chart below shows the package(s) whose dispensing statistics were extracted" 156 S PSUCONF(2)="by the PBM "_$S($G(PSUAUTO):"Automatic",$G(PSURXMT):"RETRANSMISSION",1:"Manual")_" Pharmacy Statistics option." 157 ; S PSUCONF(2)="by the PBM "_$S(PSUAUTO:"Automatic",1:"Manual")_" Pharmacy Statistics option." 158 S PSUCONF(3)=" " 159 S PSUCONF(4)="PACKAGE"_$J("# Line items",35)_$J("# MailMan msgs",19) 160 S PSUCONF(5)=$E(PSUDASH,1,79) 161 F S PSUDIV=$O(^XTMP(PSUSUB,"CONFIRM",PSUDIV)) Q:PSUDIV'?1N.E D 162 .K ^XTMP(PSUSUB,"XMD") 163 .M ^XTMP(PSUSUB,"XMD")=PSUCONF 164 .S PSUOPT=0,PSULCT=5 165 .F S PSUOPT=$O(^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT)) Q:PSUOPT'?1.N D 166 ..S PSULCT=PSULCT+1 167 ..S PSUPKG=PSUA(PSUOPT,"M") 168 ..S PSULIN=^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT,"L") 169 ..S PSUMSG=^XTMP(PSUSUB,"CONFIRM",PSUDIV,PSUOPT,"M") 170 ..S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUPKG_$J(PSULIN,37-$L(PSUPKG))_$J(PSUMSG,12) 171 ..Q:PSUPKG'="Prescription" ;* 172 .. ; process Prescription MultiDose 173 ..S PSULCT=PSULCT+1 174 ..S PSUPKG="Prescription MultiDose" 175 ..S PSULIN=+$G(^XTMP(PSUSUB,"CONFIRMD",PSUDIV,PSUOPT,"L")) 176 ..S PSUMSG=+$G(^XTMP(PSUSUB,"CONFIRMD",PSUDIV,PSUOPT,"M")) 177 ..S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUPKG_$J(PSULIN,37-$L(PSUPKG))_$J(PSUMSG,12) ;* 178 .S PSUSUBJ="PBM Stats for " 179 .I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D XMD 180 CONFIRMQ Q 181 ; 182 XMD ;Email 183 ; 184 S XMDUZ=DUZ 185 D XMY^PSUTL1 186 M XMY=PSUXMYS1 187 I $G(PSUMASF)!$G(PSUPBMG) M XMY=PSUXMYH 188 S X=PSUDIV,DIC=40.8,DIC(0)="XM" D ^DIC 189 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01) 190 S XMSUB=PSUSUBJ_PSURP("START")_" to "_PSURP("END")_" from "_PSUDIV_" "_PSUDIVNM 191 S XMTEXT="^XTMP(PSUSUB,""XMD""," 192 S XMCHAN=1 193 D ^XMD 194 XMDQ Q 195 ; 196 TIMING ; Timing report 197 K ^XTMP(PSUSUB,"XMD") 198 S $P(PSUSPACE," ",41)="" 199 S PSUX=0,PSULCT=0 200 F S PSUX=$O(^XTMP(PSUSUB,"STATUS",PSUX)) Q:PSUX="" D 201 .S (X,Y)=^XTMP(PSUSUB,"STATUS",PSUX,"START") X ^DD("DD") D 202 ..I $E(Y,17)=":" S PSUT1=$E(Y,1,16) 203 ..I $E(Y,17)'=":" S PSUT1=$E(Y,1,17) 204 .S (X1,Y)=^XTMP(PSUSUB,"STATUS",PSUX,"STOP") X ^DD("DD") D 205 ..I $E(Y,17)=":" S PSUT2=$E(Y,1,16) 206 ..I $E(Y,17)'=":" S PSUT2=$E(Y,1,17) 207 .S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1) 208 .D ^%DTC:X S X=X*1440+Y 209 .S PSULCT=PSULCT+1 210 .S PSUREC=$E(PSUA(PSUX,"M")_PSUSPACE,1,20)_$J(PSUT1,20)_$J(PSUT2,20)_$J(X\60,4)_" hrs,"_$J(X#60,3)_" min" 211 .S ^XTMP(PSUSUB,"XMD",PSULCT)=PSUREC 212 S PSULCT=PSULCT+1 213 S $P(^XTMP(PSUSUB,"XMD",PSULCT),"-",80)="" S PSULCT=PSULCT+1 214 S ^XTMP(PSUSUB,"XMD",PSULCT)="" S PSULCT=PSULCT+1 215 S ^XTMP(PSUSUB,"XMD",PSULCT)="**NOTE: Timing for the Provider Data extract is not recorded when" S PSULCT=PSULCT+1 216 S ^XTMP(PSUSUB,"XMD",PSULCT)=" the IV, Unit Dose, Prescription, and Patient Demographics extracts" S PSULCT=PSULCT+1 217 S ^XTMP(PSUSUB,"XMD",PSULCT)=" are run concurrently." 218 S PSUDIV=PSUSNDR 219 S PSUSUBJ="PBM TIMING for report " 220 D XMD 221 TIMINGQ Q 222 ; 223 LEAPYR(FMYR) ; Check to see if year is a leap year: 1=leap year, 0=not leap year 224 N YYYY 225 S YYYY=1700+$E(FMYR,1,3) 226 Q (((YYYY#4=0)&(YYYY#100'=0))!((YYYY#100=0)&(YYYY#400=0)))
Note:
See TracChangeset
for help on using the changeset viewer.
