| 1 | PSXBPSRP ;BHAM ISC/MFR - CMOP/ECME ACTIVITY REPORT ;09/01/2006
|
---|
| 2 | ;;2.0;CMOP;**63**;11 Apr 97;Build 8
|
---|
| 3 | ;External reference to ^PSRX( supported by IA #1221
|
---|
| 4 | ;External reference to ^PS(59 supported by IA #1976
|
---|
| 5 | ;External reference to ^PSOBPSUT supported by IA #4701
|
---|
| 6 | ;External reference to ^BPSUTIL supported by IA #4410
|
---|
| 7 | ;External reference to ^IBNCPDPI supported by IA #4729
|
---|
| 8 | ;
|
---|
| 9 | EN ; Entry Point
|
---|
| 10 | N %,%ZIS,EXCEL,STDT,TERM,ENDT,DIVDA,DIVNM,DTOUT,I,LINE,POP,VA,VAERR
|
---|
| 11 | N X,Y,ZTDESC,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
|
---|
| 12 | ;
|
---|
| 13 | BDT ; - Prompt to select Date Range (Return: Start Date^End Date)
|
---|
| 14 | S X=$$SELDATE() I X="^" S POP=1 G EXIT
|
---|
| 15 | S STDT=$P(X,U),ENDT=$P(X,U,2)
|
---|
| 16 | ;
|
---|
| 17 | DIV ; - Get Division(s) (Return: DIVDA and DIVNM arrays)
|
---|
| 18 | D SELDIV I '$D(DIVNM) S POP=1 G EXIT
|
---|
| 19 | ;
|
---|
| 20 | EXC ;- Prompt for Excel Capture
|
---|
| 21 | S EXCEL=$$EXCEL^PSXBPSUT() I EXCEL="^" S POP=1 G EXIT
|
---|
| 22 | ;
|
---|
| 23 | DEV ; - Prompt for Device
|
---|
| 24 | W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
|
---|
| 25 | D ^%ZIS I POP S POP=1 G EXIT
|
---|
| 26 | S TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
|
---|
| 27 | I '$D(IO("Q")) G START
|
---|
| 28 | ;
|
---|
| 29 | QUE ; - Process queue device
|
---|
| 30 | S ZTSAVE("*")=""
|
---|
| 31 | S ZTRTN="START^PSXBPSRP"
|
---|
| 32 | S ZTDESC="CMOP/ECME Activity Report"
|
---|
| 33 | D ^%ZTLOAD
|
---|
| 34 | W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
|
---|
| 35 | D HOME^%ZIS
|
---|
| 36 | S TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
|
---|
| 37 | G EXIT
|
---|
| 38 | ;
|
---|
| 39 | ;Report Processing Tag
|
---|
| 40 | ;
|
---|
| 41 | START N BPFND,STDTE,ENDTE,LINE,POP,Y
|
---|
| 42 | S BPFND=0,LINE="W ! F I=1:1:80 W ""="""
|
---|
| 43 | U IO
|
---|
| 44 | ;
|
---|
| 45 | ;Excel Display - Print Header Record
|
---|
| 46 | I EXCEL D PLINEX
|
---|
| 47 | ;
|
---|
| 48 | S Y=STDT X ^DD("DD") S STDTE=Y
|
---|
| 49 | S Y=ENDT X ^DD("DD") S ENDTE=Y
|
---|
| 50 | ;
|
---|
| 51 | ;Loop through divisions and display
|
---|
| 52 | S DIVDA=0 F S DIVDA=$O(DIVDA(DIVDA)) Q:DIVDA'>0 D ONEDIV(.BPFND,STDTE,ENDTE) Q:$G(POP)
|
---|
| 53 | ;
|
---|
| 54 | ;Make sure a record was printed
|
---|
| 55 | I '$G(POP),BPFND=0 D
|
---|
| 56 | .I 'EXCEL D TITLE
|
---|
| 57 | .W !,"NO DATA FOUND FOR CHOSEN PARAMETERS"
|
---|
| 58 | .I TERM,'EXCEL D PAUSE2
|
---|
| 59 | ;
|
---|
| 60 | I '$G(POP),'EXCEL S POP=2
|
---|
| 61 | G EXIT
|
---|
| 62 | ;
|
---|
| 63 | ONEDIV(BPFND,STDTE,ENDTE) ; - Display information for one division
|
---|
| 64 | N %,PSXDT,TRX,PS,Y
|
---|
| 65 | S PSXDT=STDT-.1
|
---|
| 66 | F S PSXDT=$O(^PSX(550.2,"D",PSXDT)) Q:'PSXDT!(PSXDT>(ENDT+.24)) D Q:$G(POP)
|
---|
| 67 | .S (PS,TRX)=0 F S TRX=$O(^PSX(550.2,"D",PSXDT,TRX)) Q:'TRX D Q:$G(POP)
|
---|
| 68 | . . N TEMP,DATA
|
---|
| 69 | . . D GETS^DIQ(550.2,TRX,".01;1;2;3;5;6;7;8;9;10;13;14","","TEMP")
|
---|
| 70 | . . M DATA=TEMP(550.2,TRX_",")
|
---|
| 71 | . . I $G(DATA(.01))="" Q
|
---|
| 72 | ..I '$D(DIVNM(DATA(2))) Q
|
---|
| 73 | ..I DATA(2)'=DIVDA(DIVDA) Q
|
---|
| 74 | ..;
|
---|
| 75 | ..;Set flag that at least one record was found
|
---|
| 76 | ..S BPFND=1
|
---|
| 77 | ..;
|
---|
| 78 | ..;Display Transmission Information - Normal Display Only
|
---|
| 79 | ..I 'EXCEL D
|
---|
| 80 | ...D TITLE
|
---|
| 81 | ...W !!,?7,"TRANSMISSION:",?35,DATA(.01)
|
---|
| 82 | ...W !,?7,"STATUS:",?35,DATA(1)
|
---|
| 83 | ...W !,?7,"DIVISION:",?35,DATA(2)
|
---|
| 84 | ...W !,?7,"CMOP SYSTEM:",?35,DATA(3)
|
---|
| 85 | ...W !,?7,"TRANSMISSION DATE/TIME:",?35,DATA(5)
|
---|
| 86 | ...I DATA(6) W !,?7,"CREATED DATE/TIME:",?35,DATA(6)
|
---|
| 87 | ...I DATA(7) W !,?7,"RECEIVED DATE/TIME:",?35,DATA(7)
|
---|
| 88 | ...I DATA(8) W !,?7,"RETRANSMISSION #:",?35,DATA(8)
|
---|
| 89 | ...I DATA(9) W !,?7,"ORIGINAL TRANS.:",?35,DATA(9)
|
---|
| 90 | ...I DATA(10) W !,?7,"CLOSED DATE/TIME:",?35,DATA(10)
|
---|
| 91 | ...W !,?7,"TOTAL PATIENTS:",?35,DATA(13)
|
---|
| 92 | ...W !,?7,"TOTAL RXS:",?35,DATA(14)
|
---|
| 93 | ..;
|
---|
| 94 | ..;Display Records in Normal Format
|
---|
| 95 | ..I 'EXCEL D Q
|
---|
| 96 | ...S PS=$$PDET(TRX) Q:$G(POP)
|
---|
| 97 | ...I 'PS D CHKP(3) Q:$G(POP) D NDAT
|
---|
| 98 | ...I TERM,'EXCEL D PAUSE Q:$G(POP)
|
---|
| 99 | ..;
|
---|
| 100 | ..;Display Records in Excel Format
|
---|
| 101 | ..D PDETEX(TRX)
|
---|
| 102 | Q
|
---|
| 103 | ;
|
---|
| 104 | ;Display Record(s) - Normal Format
|
---|
| 105 | PDET(TRX) N BIEN,DFN,RFL,M,N,NDCR,NDCS,RXS,PS,RDT,RXI,VA
|
---|
| 106 | D PLINE
|
---|
| 107 | S (PS,RXS)=0 F S RXS=$O(^PSX(550.2,TRX,15,RXS)) Q:'RXS D Q:$G(POP)
|
---|
| 108 | .S RXI=+$$GET1^DIQ(550.215,RXS_","_TRX,".01","I")
|
---|
| 109 | .S RFL=+$$GET1^DIQ(550.215,RXS_","_TRX,".02","I")
|
---|
| 110 | .S DFN=+$$GET1^DIQ(550.215,RXS_","_TRX,".03","I")
|
---|
| 111 | .Q:$$STATUS^PSOBPSUT(RXI,RFL)=""
|
---|
| 112 | .D CHKP(2) Q:$G(POP)
|
---|
| 113 | .S PS=1 D PID^VADPT
|
---|
| 114 | .S BIEN=RXI_"."_$E($TR($J("",4-$L(RFL))," ","0")_RFL,1,4)_1
|
---|
| 115 | .S RDT=$S(RFL=0:$$GET1^DIQ(52,RXI,31,"I"),1:$$GET1^DIQ(52.1,RFL_","_RXI_",",17,"I"))
|
---|
| 116 | .W !,$E($$GET1^DIQ(2,DFN,.01),1,14)_" ("_$G(VA("BID"))_")"
|
---|
| 117 | .W ?22,RXI_"/"_$$GET1^DIQ(52,RXI,.01)_$S($G(^PSRX(RXI,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXI)_"/"_RFL
|
---|
| 118 | .S (NDCS,NDCR)="",(M,N)=0
|
---|
| 119 | .F S M=$O(^PSRX(RXI,4,M)) Q:'M S N=^(M,0) I $P(N,"^",3)=RFL S NDCR=$P(N,"^",8),NDCS=$P(N,"^",9)
|
---|
| 120 | .W ?45,$E(NDCS,1,13),?59,$E(NDCR,1,13),?73,$S(RDT:"DISPENS",1:"TRANSMI")
|
---|
| 121 | .W !,?3,$E($$GET1^DIQ(52,RXI,6),1,18),?22,$$BPSPLN^BPSUTIL(RXI,RFL)
|
---|
| 122 | .W ?38,$E($$STATUS^PSOBPSUT(RXI,RFL),1,7),?48,$P($$BILLINFO^IBNCPDPI(RXI,RFL),"^",1)
|
---|
| 123 | .W ?58,$S(RDT:$E(RDT,4,5)_"/"_$E(RDT,6,7)_"/"_$E(RDT,2,3),1:"")
|
---|
| 124 | Q PS
|
---|
| 125 | ;
|
---|
| 126 | ;Display Record(s) - Excel Format
|
---|
| 127 | PDETEX(TRX) N BIEN,DFN,RFL,M,N,NDCR,NDCS,RXS,PS,RDT,RXI,VA
|
---|
| 128 | S RXS=0 F S RXS=$O(^PSX(550.2,TRX,15,RXS)) Q:'RXS D
|
---|
| 129 | .S RXI=+$$GET1^DIQ(550.215,RXS_","_TRX,".01","I")
|
---|
| 130 | .S RFL=+$$GET1^DIQ(550.215,RXS_","_TRX,".02","I")
|
---|
| 131 | .S DFN=+$$GET1^DIQ(550.215,RXS_","_TRX,".03","I")
|
---|
| 132 | .Q:$$STATUS^PSOBPSUT(RXI,RFL)=""
|
---|
| 133 | .S PS=1 D PID^VADPT
|
---|
| 134 | .S BIEN=RXI_"."_$E($TR($J("",4-$L(RFL))," ","0")_RFL,1,4)_1
|
---|
| 135 | .S RDT=$S(RFL=0:$$GET1^DIQ(52,RXI,31,"I"),1:$$GET1^DIQ(52.1,RFL_","_RXI_",",17,"I"))
|
---|
| 136 | .W !,DATA(.01),U ;Transmission
|
---|
| 137 | .W DATA(1),U ;Status
|
---|
| 138 | .W DATA(2),U ;Division
|
---|
| 139 | .W DATA(3),U ;CMOP System
|
---|
| 140 | .W DATA(5),U ;Transmission Date/Time
|
---|
| 141 | .W $E($$GET1^DIQ(2,DFN,.01),1,14),U ;Name
|
---|
| 142 | .W "("_$G(VA("BID"))_")",U ;Pt.ID
|
---|
| 143 | .W RXI,U ;ECME#
|
---|
| 144 | .W $$GET1^DIQ(52,RXI,.01)_$S($G(^PSRX(RXI,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXI),U ;RX#
|
---|
| 145 | .W RFL,U ;RFL#
|
---|
| 146 | .N NDCS,NDCR,M,N S (NDCS,NDCR)="",(M,N)=0
|
---|
| 147 | .F S M=$O(^PSRX(RXI,4,M)) Q:'M S N=^(M,0) I $P(N,"^",3)=RFL S NDCR=$P(N,"^",8),NDCS=$P(N,"^",9)
|
---|
| 148 | .W $E(NDCS,1,13),U ;NDC SENT
|
---|
| 149 | .W $E(NDCR,1,13),U ;NDC RECVD
|
---|
| 150 | .W $S(RDT:"DISPENS",1:"TRANSMI"),U ;CMOP-STAT
|
---|
| 151 | .W $E($$GET1^DIQ(52,RXI,6),1,18),U ;DRUG
|
---|
| 152 | .W $$BPSPLN^BPSUTIL(RXI,RFL),U ;INSURANCE
|
---|
| 153 | .W $E($$STATUS^PSOBPSUT(RXI,RFL),1,7),U ;PAY-STAT
|
---|
| 154 | .W $P($$BILLINFO^IBNCPDPI(RXI,RFL),"^"),U ;BILL#
|
---|
| 155 | .W $S(RDT:$E(RDT,4,5)_"/"_$E(RDT,6,7)_"/"_$E(RDT,2,3),1:"") ;REL-DATE
|
---|
| 156 | Q
|
---|
| 157 | ;
|
---|
| 158 | ;- Display Header - Normal
|
---|
| 159 | PLINE W !,"NAME",?22,"ECME#/RX#/FL#",?45,"NDC SENT",?59,"NDC RECVD",?71,"CMOP-STAT"
|
---|
| 160 | W !," DRUG",?22,"INSURANCE",?38,"PAY-STAT",?48,"BILL#",?58,"REL-DATE"
|
---|
| 161 | X LINE
|
---|
| 162 | Q
|
---|
| 163 | ;
|
---|
| 164 | ;- Display Header - Excel
|
---|
| 165 | PLINEX W !,"TRANSMISSION",U,"STATUS",U,"DIVISION",U,"CMOP SYSTEM",U,"TRANSMISSION DATE/TIME",U
|
---|
| 166 | W "NAME",U,"Pt.ID",U,"ECME#",U,"RX#",U,"FL#",U,"NDC SENT",U,"NDC RECVD",U,"CMOP-STAT",U
|
---|
| 167 | W "DRUG",U,"INSURANCE",U,"PAY-STAT",U,"BILL#",U,"REL-DATE"
|
---|
| 168 | Q
|
---|
| 169 | ;
|
---|
| 170 | EXIT I '$G(POP) D PAUSE2
|
---|
| 171 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
---|
| 172 | I $G(POP)'=1 D ^%ZISC
|
---|
| 173 | Q
|
---|
| 174 | ;
|
---|
| 175 | ;- Print message if no billable prescriptions
|
---|
| 176 | NDAT W !!,"********* BATCH HAS NO ECME BILLABLE PRESCRIPTIONS *******",!
|
---|
| 177 | Q
|
---|
| 178 | ;
|
---|
| 179 | TITLE W @IOF
|
---|
| 180 | W !,?25,"CMOP/ECME ACTIVITY REPORT "_$S($G(BPFND)=1:"for "_$E(DIVDA(DIVDA),1,24),1:"")
|
---|
| 181 | W !,"For ",STDTE," thru ",$P(ENDTE,"@"),?40,"Printed: ",$$FMTE^XLFDT($$NOW^XLFDT())
|
---|
| 182 | X LINE
|
---|
| 183 | Q
|
---|
| 184 | ;
|
---|
| 185 | CHKP(BPLINES) Q:$G(EXCEL)
|
---|
| 186 | S BPLINES=BPLINES+1
|
---|
| 187 | I $G(TERM) S BPLINES=BPLINES+2
|
---|
| 188 | I $Y>(IOSL-BPLINES) D:$G(TERM) PAUSE Q:$G(POP) D TITLE,PLINE Q
|
---|
| 189 | Q
|
---|
| 190 | ;
|
---|
| 191 | ; Enter Date Range
|
---|
| 192 | ;
|
---|
| 193 | ; Return Value -> P1^P2
|
---|
| 194 | ;
|
---|
| 195 | ; where P1 = From Date
|
---|
| 196 | ; = ^ Exit
|
---|
| 197 | ; P2 = To Date
|
---|
| 198 | ; = blank for Exit
|
---|
| 199 | ;
|
---|
| 200 | SELDATE() N DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
|
---|
| 201 | S VAL=""
|
---|
| 202 | S DIR(0)="DA",DIR("A")="ENTER BEGINNING TRANSMISSION DATE: "
|
---|
| 203 | D ^DIR
|
---|
| 204 | ;
|
---|
| 205 | ;Check for "^", timeout, or blank entry
|
---|
| 206 | I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^"
|
---|
| 207 | ;
|
---|
| 208 | I VAL="" D
|
---|
| 209 | .S $P(VAL,U)=Y
|
---|
| 210 | .S DIR(0)="DA^"_VAL,DIR("A")="ENTER ENDING TRANSMISSION DATE: "
|
---|
| 211 | .D ^DIR
|
---|
| 212 | .;
|
---|
| 213 | .;Check for "^", timeout, or blank entry
|
---|
| 214 | .I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" Q
|
---|
| 215 | .;
|
---|
| 216 | .;Define Entry
|
---|
| 217 | .S $P(VAL,U,2)=Y
|
---|
| 218 | ;
|
---|
| 219 | Q VAL
|
---|
| 220 | ;
|
---|
| 221 | ;Select Divisions
|
---|
| 222 | ;
|
---|
| 223 | ; Returns Arrays -> DIVNM("names of divisions") = selection number
|
---|
| 224 | ; DIVDA("iens of divisions") = name of division
|
---|
| 225 | SELDIV N DIR,DIV,DIVX,DIRUT,DUOUT,DTOUT,I,X,Y
|
---|
| 226 | W !!,"SELECTION OF DIVISION(S)",!
|
---|
| 227 | S DIV="" F I=1:1 S DIV=$O(^PS(59,"B",DIV)) Q:DIV="" S DIVNM(I)=DIV,DIVNM(DIV)=I,DIVDA=$O(^PS(59,"B",DIV,0)),DIVNM(I,"I")=DIVDA
|
---|
| 228 | S I=I-1
|
---|
| 229 | K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
|
---|
| 230 | ;
|
---|
| 231 | D ^DIR
|
---|
| 232 | ;
|
---|
| 233 | ;Check for "^", timeout, or blank entry
|
---|
| 234 | I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="^") K DIVNM Q
|
---|
| 235 | ;
|
---|
| 236 | ;All Divisions
|
---|
| 237 | I Y="A" D ALL Q
|
---|
| 238 | ;
|
---|
| 239 | ;Select Divisions
|
---|
| 240 | I Y="S" D SELECT(I),ALL
|
---|
| 241 | Q
|
---|
| 242 | ;
|
---|
| 243 | ;Select which divisions to display
|
---|
| 244 | SELECT(I) N C,DIR,DIVX,DIRUT,DUOUT,DTOUT,X,Y
|
---|
| 245 | F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
|
---|
| 246 | S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
|
---|
| 247 | D ^DIR
|
---|
| 248 | ;
|
---|
| 249 | ;Check for "^", timeout, or blank entry
|
---|
| 250 | I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="^")!('+Y) K DIVNM Q
|
---|
| 251 | ;
|
---|
| 252 | M DIVX=DIVNM K DIVNM
|
---|
| 253 | F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
|
---|
| 254 | Q
|
---|
| 255 | ;
|
---|
| 256 | ;Display selected divisions
|
---|
| 257 | ALL N DA,DIR,DIV,DIRUT,DUOUT,DTOUT,X,Y
|
---|
| 258 | Q:'$D(DIVNM)
|
---|
| 259 | W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
|
---|
| 260 | S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="YES" D ^DIR
|
---|
| 261 | K DIR
|
---|
| 262 | I Y=1 S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
|
---|
| 263 | ;
|
---|
| 264 | ;Check for "^", timeout, or non-yes entry
|
---|
| 265 | I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)'=1) K DIVNM
|
---|
| 266 | Q
|
---|
| 267 | ;
|
---|
| 268 | ;Screen Pause 2
|
---|
| 269 | PAUSE2 Q:'$G(TERM)
|
---|
| 270 | N X
|
---|
| 271 | U IO(0) W !!,"Press RETURN to continue:"
|
---|
| 272 | R X:$G(DTIME)
|
---|
| 273 | U IO
|
---|
| 274 | Q
|
---|
| 275 | ;
|
---|
| 276 | ;Screen Pause 1
|
---|
| 277 | ;
|
---|
| 278 | ; Return variable - BPQ = 0 Continue
|
---|
| 279 | ; 2 Quit
|
---|
| 280 | PAUSE N X
|
---|
| 281 | U IO(0) W !!,"Press RETURN to continue, '^' to exit:"
|
---|
| 282 | R X:$G(DTIME) S:'$T X="^" S:X["^" POP=2
|
---|
| 283 | U IO
|
---|
| 284 | Q
|
---|