- PSOREJP0 ;BIRM/MFR - Third Party Rejects Processing Screen ;04/28/05
- ;;7.0;OUTPATIENT PHARMACY;**148,260,287,289,385,421,427,448,549,562,704**;DEC 1997;Build 16
- ; Reference to ^BPSVRX in ICR #5723
- ;
- N PSOREJST,PSORJSRT,PSORJASC,PSOSTFLT,PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT,PSOINGRP,PSOTRITG
- N INSLN,HIGHLN,LASTLN,PSOEKEY,PSOCVATG,PSORCFLT
- ;
- ; - Division/Site selection
- D SEL^PSOREJU1("DIVISION","^PS(59,",.PSOREJST,$$GET1^DIQ(59,+$G(PSOSITE),.01)) I $G(PSOREJST)="^" G EXIT
- ;
- ; - Initializing global variables
- S PSORJSRT="PA",PSORJASC=1,PSOSTFLT="U",(PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT,PSORCFLT)="ALL"
- S PSOINGRP=0,PSOTRITG=1,PSOCVATG=1
- ;
- D LST("W")
- G EXIT
- ;
- LST(PSOMENU) ; - Invokes Listmanager
- W !,"Please wait..."
- I PSOMENU="W" D EN^VALM("PSO REJECTS WORKLIST")
- I PSOMENU="VP" D EN^VALM("PSO REJECTS VIEW/PROCESS")
- D FULL^VALM1
- Q
- ;
- HDR ; - Header code
- N LINE1,LINE2,LINE3
- S LINE1=$$SITES() I $L(LINE1)>80 S $E(LINE1,78,999)="..."
- ;
- S LINE2="Selection : ALL "_$S(PSOSTFLT="U":"UNRESOLVED ",PSOSTFLT="R":"RESOLVED ",1:"")_"REJECTS"
- I $G(PSOPTFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("P")
- I $G(PSODRFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("D")
- I $G(PSOINFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("I")
- I $G(PSORCFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("C")
- I $G(PSOINGRP) S LINE2=LINE2_" GROUPED BY INSURANCE"
- S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2
- I PSOMENU="VP" D
- . I $G(PSORXFLT) S LINE3="Rx# : "_$$NAME("R")
- . E D
- . . S LINE3="Date Range: "_$$FMTE^XLFDT(+PSODTRNG,2)
- . . I +PSODTRNG'=$P(PSODTRNG,"^",2) S LINE3=LINE3_" THRU "_$$FMTE^XLFDT($P(PSODTRNG,"^",2),2)
- . S VALMHDR(3)=LINE3
- ;
- D SETHDR()
- Q
- ;
- SETHDR() ; - Displays the Header Line
- N HDR,ORD
- ;
- S HDR=" #",$E(HDR,5)="Rx#",$E(HDR,18)="PATIENT(ID)",$E(HDR,43)="DRUG",$E(HDR,64)="REASON"
- S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,$S(PSOMENU="W":4,1:5))
- S ORD=$S(PSORJASC=1:"[^]",1:"[v]")
- S:PSORJSRT="RX" POS=9 S:PSORJSRT="PA" POS=30 S:PSORJSRT="DR" POS=48 S:PSORJSRT="RE" POS=71
- D INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,$S(PSOMENU="W":4,1:5))
- Q
- ;
- INIT ; - Populates the Body section for ListMan
- K ^TMP("PSOREJP0",$J)
- D SETSORT(PSORJSRT),SETLINE
- S VALMSG="Select the entry # to view or ?? for more actions"
- Q
- ;
- SETLINE ; - Sets the line to be displayed in ListMan
- N INS,SUB,SEQ,SORTA,LINE,Z,I,X,X1,X2
- I '$D(^TMP("PSOREJSR",$J)) D Q
- . F I=1:1:7 S ^TMP("PSOREJP0",$J,I,0)=""
- . S ^TMP("PSOREJP0",$J,8,0)=" No Clinical Third Party Payer Rejects found."
- . S VALMCNT=1
- ;
- F I=1:1:$G(LASTLN) D RESTORE^VALM10(I)
- K INSLN,HIGHLN
- ;
- S (SORTA,INS,SUB)="",LINE=0 K ^TMP("PSOREJP0",$J)
- F S SORTA=$O(^TMP("PSOREJSR",$J,SORTA)) Q:SORTA="" D
- . F S INS=$O(^TMP("PSOREJSR",$J,SORTA,INS)) Q:INS="" D
- . . I INS'="<NULL>" D
- . . . D GROUP(INS,.LINE)
- . . F S SUB=$O(^TMP("PSOREJSR",$J,SORTA,INS,SUB),PSORJASC) Q:SUB="" D
- . . . S Z=$G(^TMP("PSOREJSR",$J,SORTA,INS,SUB))
- . . . S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3)
- . . . S $E(X1,5)=$P(Z,"^",3),$E(X1,18)=$P(Z,"^",4),$E(X1,43)=$P(Z,"^",5),$E(X1,64)=$P(Z,"^",6)
- . . . S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X1,HIGHLN(LINE)=""
- . . . S X2="",$E(X2,5)="Payer Message: "_$P(Z,"^",7)
- . . . S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X2
- . . . S ^TMP("PSOREJP0",$J,SEQ,"RX")=$P(Z,"^",1,2)
- ;
- I LINE>$G(LASTLN) D
- . F I=($G(LASTLN)+1):1:LINE D SAVE^VALM10(I)
- . S LASTLN=LINE
- ;
- ; - Highlighting the prescription/insurance line
- F LN=1:1:LINE D
- . I $D(HIGHLN(LN)) D Q
- . . D CNTRL^VALM10(LN,1,80,IOINHI,IOINORM)
- . . D CNTRL^VALM10(LN,64,3,IOUON,IOINORM)
- . . D CNTRL^VALM10(LN,67,80,IOINHI,IOINORM)
- . I $D(INSLN(LN)) D
- . . S LBL=INSLN(LN),POS=41-($L(LBL)/2+.5\1)
- . . D CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
- . . D CNTRL^VALM10(LN,POS,$L(LBL),IORVON_IOINHI,IORVOFF_IOINORM)
- . . D CNTRL^VALM10(LN,POS+$L(LBL),(81-POS-$L(LBL)),IOUON_IOINHI,IOINORM)
- ;
- S VALMCNT=+$G(LINE)
- Q
- ;
- GROUP(LBL,LINE) ; Sets an insurance delimiter line
- N X,POS
- S POS=41-($L(LBL)/2+.5\1)
- S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
- S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X,INSLN(LINE)=LBL
- Q
- ;
- SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified
- N RX,REJ,STS,DAT
- K ^TMP("PSOREJSR",$J)
- ;
- ; - Worklist
- I PSOMENU="W" D
- . S RX=0 F S RX=$O(^PSRX("REJSTS",0,RX)) Q:'RX D
- . . S REJ=0 F S REJ=$O(^PSRX("REJSTS",0,RX,REJ)) Q:'REJ D
- . . . D SETTMP(RX,REJ,FIELD)
- ;
- ; - View/Process
- I PSOMENU="VP" D
- . I $G(PSORXFLT)'="ALL" D Q
- . . S REJ=0 F S REJ=$O(^PSRX(+PSORXFLT,"REJ",REJ)) Q:'REJ D
- . . . I $$FLTSTS(+PSORXFLT,REJ) Q
- . . . D SETTMP(+PSORXFLT,REJ,FIELD)
- . S DAT=$P(PSODTRNG,"^")-0.0000001,(RX,REJ)=0
- . F S DAT=$O(^PSRX("REJDAT",DAT)) Q:'DAT!(DAT>$$ENDT()) D
- . . F S RX=$O(^PSRX("REJDAT",DAT,RX)) Q:'RX D
- . . . I $$FILTER(RX) Q
- . . . F S REJ=$O(^PSRX("REJDAT",DAT,RX,REJ)) Q:'REJ D
- . . . . I $$FLTSTS(RX,REJ) Q
- . . . . I $G(PSORCFLT)'="ALL",$$FLTRC(RX,REJ) Q
- . . . . D SETTMP(RX,REJ,FIELD)
- Q
- ;
- SETTMP(RX,REJ,FIELD) ; - Sets ^TMP global that will be displayed in the body section
- N CODE,DRNAME,FILL,I,INS,MSG,OREJ,PSOCOB,PSOTRIC,PTNAME,REASON,REJLST,RXNUM,SORT,SORTA,X,Z
- I $G(PSORXFLT)="ALL",$$CLOSED^PSOREJP1(RX,REJ),$$REOPN^PSOREJP1(RX,REJ) Q
- S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5),SORTA=1
- I '$$DIV(RX,FILL) Q
- K REJLST D GET^PSOREJU2(RX,FILL,.REJLST,,1) I '$D(REJLST) Q
- I $$FILTER(,REJLST(REJ,"INSURANCE POINTER")) Q
- S CODE=$G(REJLST(REJ,"CODE"))
- S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,FILL,PSOTRIC)
- Q:$G(PSOTRIC)=1&('$G(PSOTRITG))&(CODE'="79")&(CODE'="88")&(CODE'="943") ;show/hide non-DUR/RTS TRICARE
- Q:$G(PSOTRIC)=2&('$G(PSOCVATG))&(CODE'="79")&(CODE'="88")&(CODE'="943") ;show/hide non-DUR/RTS CHAMPVA
- S PTNAME=$$PTNAME(RX)
- S DRNAME=$$GET1^DIQ(52,RX,6)
- S RXNUM=$$GET1^DIQ(52,RX,.01)
- S MSG=$G(REJLST(REJ,"PAYER MESSAGE")) I $L(MSG)>60 S MSG=$E(MSG,1,58)_"..."
- S PSOCOB=$S(REJLST(REJ,"COB")="SECONDARY":2,1:1)
- I $$STATUS^PSOBPSUT(RX,FILL,PSOCOB)="E PAYABLE" D
- . I MSG["Not ECME Billable" S MSG=""
- S REASON=$S(CODE=88!(CODE=943):"DUR:"_$G(REJLST(REJ,"REASON")),CODE=79:"79 :REFILL TOO SOON",1:CODE)
- I CODE'=79&(CODE'=88)&(CODE'=943) S REASON=CODE_" :"_$$EXP^PSOREJP1(CODE)
- S Z="",$P(Z,"^")=RX,$P(Z,"^",2)=REJ,$P(Z,"^",3)=RXNUM,$P(Z,"^",4)=PTNAME
- S $P(Z,"^",5)=$E(DRNAME,1,20),$P(Z,"^",6)=$E(REASON,1,17),$P(Z,"^",7)=MSG
- S SORT=$S(FIELD="PA":PTNAME,FIELD="DR":DRNAME,FIELD="RX":RXNUM_" ",1:REASON)_RX_REJ
- S INS="<NULL>"
- I $G(PSOINGRP) S INS=REJLST(REJ,"INSURANCE NAME") S:INS="" INS="***UNKNOWN***"
- ; Separate Veteran RRR
- S:$G(PSOTRIC)&(CODE'=79)&(CODE'=88)&(CODE'=943) INS=$$ELIGDISP^PSOREJP1(RX,FILL)_" - Non-DUR/RTS",SORTA=3
- I '$G(PSOTRIC)&(CODE'=79)&(CODE'=88)&(CODE'=943) D
- . I $G(REJLST(REJ,"RRR FLAG"))="YES" S INS="REJECT RESOLUTION REQUIRED",SORTA=2 Q
- . S INS="OTHER REJECTS",SORTA=4
- S ^TMP("PSOREJSR",$J,SORTA,INS,SORT)=Z
- Q
- ;
- PAT ; - Sort by Patient
- D SORT("PA")
- Q
- DRG ; - Sort by Drug
- D SORT("DR")
- Q
- RX ; - Sort by Rx
- D SORT("RX")
- Q
- REA ; - Sort by Reason
- D SORT("RE")
- Q
- SORT(FIELD) ; - Sort entries by FIELD
- I PSORJSRT=FIELD S PSORJASC=$S(PSORJASC=1:-1,1:1)
- E S PSORJSRT=FIELD,PSORJASC=1
- D REF
- Q
- ;
- REF ; - Screen Refresh
- W ?52,"Please wait..." D INIT S VALMBCK="R"
- Q
- GI ; - Group by Insurance
- W ?52,"Please wait..." S PSOINGRP=$S($G(PSOINGRP):0,1:1) D INIT,HDR S VALMBCK="R"
- Q
- TRICTOG ; - Toggle TRICARE display
- W ?52,"Please wait..." S PSOTRITG=$S($G(PSOTRITG):0,1:1) D INIT,HDR S VALMBCK="R"
- Q
- ;
- CVATOG ; - Toggle CHAMPVA display
- W ?52,"Please wait..." S PSOCVATG=$S($G(PSOCVATG):0,1:1) D INIT,HDR S VALMBCK="R"
- Q
- ;
- SEL ; - Process selection of one entry
- N PSOSEL,XQORM,Z,RX,REJ,PSOCHNG
- S PSOSEL=+$P($P(Y(1),"^",4),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q
- S Z=$G(^TMP("PSOREJP0",$J,PSOSEL,"RX"))
- S RX=$P(Z,"^"),REJ=$P(Z,"^",2) I 'RX!'REJ S VALMSG="Invalid selection!",VALMBCK="R" Q
- S PSOCHNG=0 D EN^PSOREJP1(RX,REJ,.PSOCHNG) I $G(PSOCHNG) D REF
- Q
- ;
- EXIT ;
- K ^TMP("PSOREJP0",$J),^TMP("PSOREJSR",$J)
- Q
- ;
- HELP Q
- ;
- SITES() ; - Returns the list of sites along with their NCPDP #s
- N CNT,SITE,SITES,NAME
- I '$D(PSOREJST) Q ""
- I $G(PSOREJST)="ALL" Q "Divisions : ALL"
- S SITE=0 F S SITE=$O(PSOREJST(SITE)) Q:'SITE D
- . S NAME=$$GET1^DIQ(59,SITE,.01)
- . S SITES=$G(SITES)_", "_NAME
- S $E(SITES,1,2)="",SITES="Division"_$S($L(SITES,",")>1:"s",1:" ")_" : "_SITES
- Q SITES
- ;
- DIV(RX,FILL) ; - Check if the Division for the Prescription/Fill was selected by the user
- ;
- I $G(PSOREJST)="ALL" Q 1
- I $D(PSOREJST($$RXSITE^PSOBPSUT(RX,FILL))) Q 1
- Q 0
- ;
- PTNAME(RX) ; - Returns header displayable - Patient Name (Last 4 SSN)
- N DFN,VADM,PTNAME
- S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT
- S PTNAME=$E($G(VADM(1)),1,18)_"("_$P($P($G(VADM(2)),"^",2),"-",3)_")"
- Q PTNAME
- ;
- FILTER(RX,INS) ; - Filter entries based on user's selection
- N FILTER
- S FILTER=1
- I $G(PSOPTFLT)'="ALL",$D(RX),'$D(PSOPTFLT($$GET1^DIQ(52,RX,2,"I"))) Q FILTER
- I $G(PSODRFLT)'="ALL",$D(RX),'$D(PSODRFLT($$GET1^DIQ(52,RX,6,"I"))) Q FILTER
- I $G(PSOINFLT)'="ALL",$D(INS),'$D(PSOINFLT(+INS)) Q FILTER
- Q 0
- ;
- FLTSTS(RX,REJ) ; - Filter for the Reject Status
- N STS
- S STS=$$GET1^DIQ(52.25,REJ_","_RX,9,"I")
- I PSOSTFLT="U",STS=1 Q 1
- I PSOSTFLT="R",STS=0 Q 1
- Q 0
- ;
- FLTRC(RX,REJ) ; - Filter for user selected Reject Codes
- N REJCD
- S REJCD=$$GET1^DIQ(52.25,REJ_","_RX,.01)
- S REJCD=$O(^BPSF(9002313.93,"B",REJCD,""))
- I '$D(PSORCFLT(REJCD)) Q 1
- Q 0
- ;
- NAME(TYPE) ; - Returns the name if ONE was selected or "MULTIPLE ..."
- N I,CNT,RC01,RC02,RC
- ;
- I TYPE="P",$O(PSOPTFLT($O(PSOPTFLT(""))))="" Q $$GET1^DIQ(2,$O(PSOPTFLT("")),.01)
- I TYPE="D",$O(PSODRFLT($O(PSODRFLT(""))))="" Q $$GET1^DIQ(50,$O(PSODRFLT("")),.01)
- I TYPE="I",$O(PSOINFLT($O(PSOINFLT(""))))="" Q $O(PSOINFLT(""))
- I TYPE="R" Q $$GET1^DIQ(52,PSORXFLT,.01)
- I TYPE="C",$O(PSORCFLT($O(PSORCFLT(""))))="" D Q RC
- . S RC01=$$GET1^DIQ(9002313.93,$O(PSORCFLT("")),.01)
- . S RC02=$$GET1^DIQ(9002313.93,$O(PSORCFLT("")),.02)
- . S RC=RC01_" - "_RC02
- Q "MULTIPLE "_$S(TYPE="P":"PATIENTS",TYPE="D":"DRUGS",TYPE="C":"REJECT CODES",1:"INSURANCE COMPANIES")
- ;
- ENDT() ; Returns the upper limit for the date range
- N ENDT
- S ENDT=$P(PSODTRNG,"^",2)
- I '$E(ENDT,4,7) Q (ENDT+10000)
- I '$E(ENDT,6,7) Q (ENDT+100)
- I $P(ENDT,"^",2) Q (ENDT+0.0000001)
- Q (ENDT+.25)
- VER ;Do VER Hidden Action in Rejects Worklist
- N BPSVRX
- D FULL^VALM1
- D ^BPSVRX ;DBIA #5723
- S VALMBCK="R"
- Q
- ;
- PRTEXCL ;
- ; Protocol to Print to Excel
- ;
- ; Use full screen
- D FULL^VALM1
- ;
- ; Prompt to see if the user wants to print to Excel
- N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- S DIR(0)="Y"
- S DIR("A")="Do you want to capture report data for an Excel document",DIR("B")="NO"
- D ^DIR
- I Y'=1 G PEXIT
- ;
- ; Display Warning Message
- W !!?5,"Before continuing, please set up your terminal to capture the"
- W !?5,"detail report data. On some terminals, this can be done by"
- W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
- W !?5,"Incoming Data' to save to Desktop"
- W !!?5,"Note: To avoid undesired wrapping of the data saved to the"
- W !?10,"file, please enter '0;256;999' at the 'DEVICE:' prompt."
- ;
- ; Prompt for device
- N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP,OK
- S OK=0
- F D I POP!OK Q
- . S %ZIS="QM"
- . D ^%ZIS
- . I POP Q
- . I '$D(IO("Q")) S OK=1 Q
- . I $D(IO("Q")) D
- . . K IO("Q")
- . . D HOME^%ZIS
- . . W !,"Sorry, the output for this action cannot be queued. Please select a device that"
- . . W !,"does not requiring queuing."
- I POP G PEXIT
- ;
- ; If not queued, run the process directly
- D RUN
- ;
- PEXIT ;
- ; Reset before going back to ListMan
- S VALMBCK="R"
- Q
- ;
- ; Run the Report
- RUN ;
- N SORTA,INS,SORT,RX,REJ,FILL,PTNAME,DRNAME,RXNUM,REJLST,CODE,REASON,MSG
- U IO
- ; Write Header
- W !,"Section/Insurance^RX#^Patient(ID)^Drug^Reason^Payer Message"
- ;
- ; Loop through temp array and output
- S SORTA="" F S SORTA=$O(^TMP("PSOREJSR",$J,SORTA)) Q:'SORTA D
- . S INS="" F S INS=$O(^TMP("PSOREJSR",$J,SORTA,INS)) Q:INS="" D
- . . S SORT="" F S SORT=$O(^TMP("PSOREJSR",$J,SORTA,INS,SORT)) Q:SORT="" D
- . . . W !,$S(INS'="<NULL>":INS,1:"Refill Too Soon/DUR Rejects")_U
- . . . S RX=$P(^TMP("PSOREJSR",$J,SORTA,INS,SORT),"^",1),REJ=$P(^TMP("PSOREJSR",$J,SORTA,INS,SORT),"^",2)
- . . . S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
- . . . S PTNAME=$$PTNAME(RX)
- . . . S DRNAME=$$GET1^DIQ(52,RX,6)
- . . . S RXNUM=$$GET1^DIQ(52,RX,.01)
- . . . K REJLST D GET^PSOREJU2(RX,FILL,.REJLST,,1)
- . . . S CODE=$G(REJLST(REJ,"CODE"))
- . . . S REASON=$S(CODE=88!(CODE=943):"DUR:"_$G(REJLST(REJ,"REASON")),CODE=79:"79 :REFILL TOO SOON",1:CODE_" :"_$$EXP^PSOREJP1(CODE))
- . . . S MSG=$G(REJLST(REJ,"PAYER MESSAGE"))
- . . . W RXNUM_U_PTNAME_U_DRNAME_U_REASON_U_MSG
- ;
- ; Cleanup
- I $E($G(IOST),1,2)'="C-" W !,@IOF
- I $E($G(IOST),1,2)="C-" D
- . N DIR,DTOUT,DUOUT,DIROUT,DIRUT
- . S DIR(0)="E"
- . D ^DIR
- I $D(ZTQUEUED) S ZTREQ="@" Q
- D ^%ZISC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREJP0 13120 printed Feb 18, 2025@23:59:56 Page 2
- PSOREJP0 ;BIRM/MFR - Third Party Rejects Processing Screen ;04/28/05
- +1 ;;7.0;OUTPATIENT PHARMACY;**148,260,287,289,385,421,427,448,549,562,704**;DEC 1997;Build 16
- +2 ; Reference to ^BPSVRX in ICR #5723
- +3 ;
- +4 NEW PSOREJST,PSORJSRT,PSORJASC,PSOSTFLT,PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT,PSOINGRP,PSOTRITG
- +5 NEW INSLN,HIGHLN,LASTLN,PSOEKEY,PSOCVATG,PSORCFLT
- +6 ;
- +7 ; - Division/Site selection
- +8 DO SEL^PSOREJU1("DIVISION","^PS(59,",.PSOREJST,$$GET1^DIQ(59,+$GET(PSOSITE),.01))
- IF $GET(PSOREJST)="^"
- GOTO EXIT
- +9 ;
- +10 ; - Initializing global variables
- +11 SET PSORJSRT="PA"
- SET PSORJASC=1
- SET PSOSTFLT="U"
- SET (PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT,PSORCFLT)="ALL"
- +12 SET PSOINGRP=0
- SET PSOTRITG=1
- SET PSOCVATG=1
- +13 ;
- +14 DO LST("W")
- +15 GOTO EXIT
- +16 ;
- LST(PSOMENU) ; - Invokes Listmanager
- +1 WRITE !,"Please wait..."
- +2 IF PSOMENU="W"
- DO EN^VALM("PSO REJECTS WORKLIST")
- +3 IF PSOMENU="VP"
- DO EN^VALM("PSO REJECTS VIEW/PROCESS")
- +4 DO FULL^VALM1
- +5 QUIT
- +6 ;
- HDR ; - Header code
- +1 NEW LINE1,LINE2,LINE3
- +2 SET LINE1=$$SITES()
- IF $LENGTH(LINE1)>80
- SET $EXTRACT(LINE1,78,999)="..."
- +3 ;
- +4 SET LINE2="Selection : ALL "_$SELECT(PSOSTFLT="U":"UNRESOLVED ",PSOSTFLT="R":"RESOLVED ",1:"")_"REJECTS"
- +5 IF $GET(PSOPTFLT)'="ALL"
- SET LINE2=LINE2_" FOR "_$$NAME("P")
- +6 IF $GET(PSODRFLT)'="ALL"
- SET LINE2=LINE2_" FOR "_$$NAME("D")
- +7 IF $GET(PSOINFLT)'="ALL"
- SET LINE2=LINE2_" FOR "_$$NAME("I")
- +8 IF $GET(PSORCFLT)'="ALL"
- SET LINE2=LINE2_" FOR "_$$NAME("C")
- +9 IF $GET(PSOINGRP)
- SET LINE2=LINE2_" GROUPED BY INSURANCE"
- +10 SET VALMHDR(1)=LINE1
- SET VALMHDR(2)=LINE2
- +11 IF PSOMENU="VP"
- Begin DoDot:1
- +12 IF $GET(PSORXFLT)
- SET LINE3="Rx# : "_$$NAME("R")
- +13 IF '$TEST
- Begin DoDot:2
- +14 SET LINE3="Date Range: "_$$FMTE^XLFDT(+PSODTRNG,2)
- +15 IF +PSODTRNG'=$PIECE(PSODTRNG,"^",2)
- SET LINE3=LINE3_" THRU "_$$FMTE^XLFDT($PIECE(PSODTRNG,"^",2),2)
- End DoDot:2
- +16 SET VALMHDR(3)=LINE3
- End DoDot:1
- +17 ;
- +18 DO SETHDR()
- +19 QUIT
- +20 ;
- SETHDR() ; - Displays the Header Line
- +1 NEW HDR,ORD
- +2 ;
- +3 SET HDR=" #"
- SET $EXTRACT(HDR,5)="Rx#"
- SET $EXTRACT(HDR,18)="PATIENT(ID)"
- SET $EXTRACT(HDR,43)="DRUG"
- SET $EXTRACT(HDR,64)="REASON"
- +4 SET $EXTRACT(HDR,81)=""
- DO INSTR^VALM1(IORVON_HDR_IOINORM,1,$SELECT(PSOMENU="W":4,1:5))
- +5 SET ORD=$SELECT(PSORJASC=1:"[^]",1:"[v]")
- +6 if PSORJSRT="RX"
- SET POS=9
- if PSORJSRT="PA"
- SET POS=30
- if PSORJSRT="DR"
- SET POS=48
- if PSORJSRT="RE"
- SET POS=71
- +7 DO INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,$SELECT(PSOMENU="W":4,1:5))
- +8 QUIT
- +9 ;
- INIT ; - Populates the Body section for ListMan
- +1 KILL ^TMP("PSOREJP0",$JOB)
- +2 DO SETSORT(PSORJSRT)
- DO SETLINE
- +3 SET VALMSG="Select the entry # to view or ?? for more actions"
- +4 QUIT
- +5 ;
- SETLINE ; - Sets the line to be displayed in ListMan
- +1 NEW INS,SUB,SEQ,SORTA,LINE,Z,I,X,X1,X2
- +2 IF '$DATA(^TMP("PSOREJSR",$JOB))
- Begin DoDot:1
- +3 FOR I=1:1:7
- SET ^TMP("PSOREJP0",$JOB,I,0)=""
- +4 SET ^TMP("PSOREJP0",$JOB,8,0)=" No Clinical Third Party Payer Rejects found."
- +5 SET VALMCNT=1
- End DoDot:1
- QUIT
- +6 ;
- +7 FOR I=1:1:$GET(LASTLN)
- DO RESTORE^VALM10(I)
- +8 KILL INSLN,HIGHLN
- +9 ;
- +10 SET (SORTA,INS,SUB)=""
- SET LINE=0
- KILL ^TMP("PSOREJP0",$JOB)
- +11 FOR
- SET SORTA=$ORDER(^TMP("PSOREJSR",$JOB,SORTA))
- if SORTA=""
- QUIT
- Begin DoDot:1
- +12 FOR
- SET INS=$ORDER(^TMP("PSOREJSR",$JOB,SORTA,INS))
- if INS=""
- QUIT
- Begin DoDot:2
- +13 IF INS'="<NULL>"
- Begin DoDot:3
- +14 DO GROUP(INS,.LINE)
- End DoDot:3
- +15 FOR
- SET SUB=$ORDER(^TMP("PSOREJSR",$JOB,SORTA,INS,SUB),PSORJASC)
- if SUB=""
- QUIT
- Begin DoDot:3
- +16 SET Z=$GET(^TMP("PSOREJSR",$JOB,SORTA,INS,SUB))
- +17 SET X1=""
- SET SEQ=$GET(SEQ)+1
- SET X1=$JUSTIFY(SEQ,3)
- +18 SET $EXTRACT(X1,5)=$PIECE(Z,"^",3)
- SET $EXTRACT(X1,18)=$PIECE(Z,"^",4)
- SET $EXTRACT(X1,43)=$PIECE(Z,"^",5)
- SET $EXTRACT(X1,64)=$PIECE(Z,"^",6)
- +19 SET LINE=LINE+1
- SET ^TMP("PSOREJP0",$JOB,LINE,0)=X1
- SET HIGHLN(LINE)=""
- +20 SET X2=""
- SET $EXTRACT(X2,5)="Payer Message: "_$PIECE(Z,"^",7)
- +21 SET LINE=LINE+1
- SET ^TMP("PSOREJP0",$JOB,LINE,0)=X2
- +22 SET ^TMP("PSOREJP0",$JOB,SEQ,"RX")=$PIECE(Z,"^",1,2)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 ;
- +24 IF LINE>$GET(LASTLN)
- Begin DoDot:1
- +25 FOR I=($GET(LASTLN)+1):1:LINE
- DO SAVE^VALM10(I)
- +26 SET LASTLN=LINE
- End DoDot:1
- +27 ;
- +28 ; - Highlighting the prescription/insurance line
- +29 FOR LN=1:1:LINE
- Begin DoDot:1
- +30 IF $DATA(HIGHLN(LN))
- Begin DoDot:2
- +31 DO CNTRL^VALM10(LN,1,80,IOINHI,IOINORM)
- +32 DO CNTRL^VALM10(LN,64,3,IOUON,IOINORM)
- +33 DO CNTRL^VALM10(LN,67,80,IOINHI,IOINORM)
- End DoDot:2
- QUIT
- +34 IF $DATA(INSLN(LN))
- Begin DoDot:2
- +35 SET LBL=INSLN(LN)
- SET POS=41-($LENGTH(LBL)/2+.5\1)
- +36 DO CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
- +37 DO CNTRL^VALM10(LN,POS,$LENGTH(LBL),IORVON_IOINHI,IORVOFF_IOINORM)
- +38 DO CNTRL^VALM10(LN,POS+$LENGTH(LBL),(81-POS-$LENGTH(LBL)),IOUON_IOINHI,IOINORM)
- End DoDot:2
- End DoDot:1
- +39 ;
- +40 SET VALMCNT=+$GET(LINE)
- +41 QUIT
- +42 ;
- GROUP(LBL,LINE) ; Sets an insurance delimiter line
- +1 NEW X,POS
- +2 SET POS=41-($LENGTH(LBL)/2+.5\1)
- +3 SET X=""
- SET $PIECE(X," ",81)=""
- SET $EXTRACT(X,POS,POS-1+$LENGTH(LBL))=LBL
- +4 SET LINE=LINE+1
- SET ^TMP("PSOREJP0",$JOB,LINE,0)=X
- SET INSLN(LINE)=LBL
- +5 QUIT
- +6 ;
- SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified
- +1 NEW RX,REJ,STS,DAT
- +2 KILL ^TMP("PSOREJSR",$JOB)
- +3 ;
- +4 ; - Worklist
- +5 IF PSOMENU="W"
- Begin DoDot:1
- +6 SET RX=0
- FOR
- SET RX=$ORDER(^PSRX("REJSTS",0,RX))
- if 'RX
- QUIT
- Begin DoDot:2
- +7 SET REJ=0
- FOR
- SET REJ=$ORDER(^PSRX("REJSTS",0,RX,REJ))
- if 'REJ
- QUIT
- Begin DoDot:3
- +8 DO SETTMP(RX,REJ,FIELD)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 ;
- +10 ; - View/Process
- +11 IF PSOMENU="VP"
- Begin DoDot:1
- +12 IF $GET(PSORXFLT)'="ALL"
- Begin DoDot:2
- +13 SET REJ=0
- FOR
- SET REJ=$ORDER(^PSRX(+PSORXFLT,"REJ",REJ))
- if 'REJ
- QUIT
- Begin DoDot:3
- +14 IF $$FLTSTS(+PSORXFLT,REJ)
- QUIT
- +15 DO SETTMP(+PSORXFLT,REJ,FIELD)
- End DoDot:3
- End DoDot:2
- QUIT
- +16 SET DAT=$PIECE(PSODTRNG,"^")-0.0000001
- SET (RX,REJ)=0
- +17 FOR
- SET DAT=$ORDER(^PSRX("REJDAT",DAT))
- if 'DAT!(DAT>$$ENDT())
- QUIT
- Begin DoDot:2
- +18 FOR
- SET RX=$ORDER(^PSRX("REJDAT",DAT,RX))
- if 'RX
- QUIT
- Begin DoDot:3
- +19 IF $$FILTER(RX)
- QUIT
- +20 FOR
- SET REJ=$ORDER(^PSRX("REJDAT",DAT,RX,REJ))
- if 'REJ
- QUIT
- Begin DoDot:4
- +21 IF $$FLTSTS(RX,REJ)
- QUIT
- +22 IF $GET(PSORCFLT)'="ALL"
- IF $$FLTRC(RX,REJ)
- QUIT
- +23 DO SETTMP(RX,REJ,FIELD)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 QUIT
- +25 ;
- SETTMP(RX,REJ,FIELD) ; - Sets ^TMP global that will be displayed in the body section
- +1 NEW CODE,DRNAME,FILL,I,INS,MSG,OREJ,PSOCOB,PSOTRIC,PTNAME,REASON,REJLST,RXNUM,SORT,SORTA,X,Z
- +2 IF $GET(PSORXFLT)="ALL"
- IF $$CLOSED^PSOREJP1(RX,REJ)
- IF $$REOPN^PSOREJP1(RX,REJ)
- QUIT
- +3 SET FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
- SET SORTA=1
- +4 IF '$$DIV(RX,FILL)
- QUIT
- +5 KILL REJLST
- DO GET^PSOREJU2(RX,FILL,.REJLST,,1)
- IF '$DATA(REJLST)
- QUIT
- +6 IF $$FILTER(,REJLST(REJ,"INSURANCE POINTER"))
- QUIT
- +7 SET CODE=$GET(REJLST(REJ,"CODE"))
- +8 SET PSOTRIC=""
- SET PSOTRIC=$$TRIC^PSOREJP1(RX,FILL,PSOTRIC)
- +9 ;show/hide non-DUR/RTS TRICARE
- if $GET(PSOTRIC)=1&('$GET(PSOTRITG))&(CODE'="79")&(CODE'="88")&(CODE'="943")
- QUIT
- +10 ;show/hide non-DUR/RTS CHAMPVA
- if $GET(PSOTRIC)=2&('$GET(PSOCVATG))&(CODE'="79")&(CODE'="88")&(CODE'="943")
- QUIT
- +11 SET PTNAME=$$PTNAME(RX)
- +12 SET DRNAME=$$GET1^DIQ(52,RX,6)
- +13 SET RXNUM=$$GET1^DIQ(52,RX,.01)
- +14 SET MSG=$GET(REJLST(REJ,"PAYER MESSAGE"))
- IF $LENGTH(MSG)>60
- SET MSG=$EXTRACT(MSG,1,58)_"..."
- +15 SET PSOCOB=$SELECT(REJLST(REJ,"COB")="SECONDARY":2,1:1)
- +16 IF $$STATUS^PSOBPSUT(RX,FILL,PSOCOB)="E PAYABLE"
- Begin DoDot:1
- +17 IF MSG["Not ECME Billable"
- SET MSG=""
- End DoDot:1
- +18 SET REASON=$SELECT(CODE=88!(CODE=943):"DUR:"_$GET(REJLST(REJ,"REASON")),CODE=79:"79 :REFILL TOO SOON",1:CODE)
- +19 IF CODE'=79&(CODE'=88)&(CODE'=943)
- SET REASON=CODE_" :"_$$EXP^PSOREJP1(CODE)
- +20 SET Z=""
- SET $PIECE(Z,"^")=RX
- SET $PIECE(Z,"^",2)=REJ
- SET $PIECE(Z,"^",3)=RXNUM
- SET $PIECE(Z,"^",4)=PTNAME
- +21 SET $PIECE(Z,"^",5)=$EXTRACT(DRNAME,1,20)
- SET $PIECE(Z,"^",6)=$EXTRACT(REASON,1,17)
- SET $PIECE(Z,"^",7)=MSG
- +22 SET SORT=$SELECT(FIELD="PA":PTNAME,FIELD="DR":DRNAME,FIELD="RX":RXNUM_" ",1:REASON)_RX_REJ
- +23 SET INS="<NULL>"
- +24 IF $GET(PSOINGRP)
- SET INS=REJLST(REJ,"INSURANCE NAME")
- if INS=""
- SET INS="***UNKNOWN***"
- +25 ; Separate Veteran RRR
- +26 if $GET(PSOTRIC)&(CODE'=79)&(CODE'=88)&(CODE'=943)
- SET INS=$$ELIGDISP^PSOREJP1(RX,FILL)_" - Non-DUR/RTS"
- SET SORTA=3
- +27 IF '$GET(PSOTRIC)&(CODE'=79)&(CODE'=88)&(CODE'=943)
- Begin DoDot:1
- +28 IF $GET(REJLST(REJ,"RRR FLAG"))="YES"
- SET INS="REJECT RESOLUTION REQUIRED"
- SET SORTA=2
- QUIT
- +29 SET INS="OTHER REJECTS"
- SET SORTA=4
- End DoDot:1
- +30 SET ^TMP("PSOREJSR",$JOB,SORTA,INS,SORT)=Z
- +31 QUIT
- +32 ;
- PAT ; - Sort by Patient
- +1 DO SORT("PA")
- +2 QUIT
- DRG ; - Sort by Drug
- +1 DO SORT("DR")
- +2 QUIT
- RX ; - Sort by Rx
- +1 DO SORT("RX")
- +2 QUIT
- REA ; - Sort by Reason
- +1 DO SORT("RE")
- +2 QUIT
- SORT(FIELD) ; - Sort entries by FIELD
- +1 IF PSORJSRT=FIELD
- SET PSORJASC=$SELECT(PSORJASC=1:-1,1:1)
- +2 IF '$TEST
- SET PSORJSRT=FIELD
- SET PSORJASC=1
- +3 DO REF
- +4 QUIT
- +5 ;
- REF ; - Screen Refresh
- +1 WRITE ?52,"Please wait..."
- DO INIT
- SET VALMBCK="R"
- +2 QUIT
- GI ; - Group by Insurance
- +1 WRITE ?52,"Please wait..."
- SET PSOINGRP=$SELECT($GET(PSOINGRP):0,1:1)
- DO INIT
- DO HDR
- SET VALMBCK="R"
- +2 QUIT
- TRICTOG ; - Toggle TRICARE display
- +1 WRITE ?52,"Please wait..."
- SET PSOTRITG=$SELECT($GET(PSOTRITG):0,1:1)
- DO INIT
- DO HDR
- SET VALMBCK="R"
- +2 QUIT
- +3 ;
- CVATOG ; - Toggle CHAMPVA display
- +1 WRITE ?52,"Please wait..."
- SET PSOCVATG=$SELECT($GET(PSOCVATG):0,1:1)
- DO INIT
- DO HDR
- SET VALMBCK="R"
- +2 QUIT
- +3 ;
- SEL ; - Process selection of one entry
- +1 NEW PSOSEL,XQORM,Z,RX,REJ,PSOCHNG
- +2 SET PSOSEL=+$PIECE($PIECE(Y(1),"^",4),"=",2)
- IF 'PSOSEL
- SET VALMSG="Invalid selection!"
- SET VALMBCK="R"
- QUIT
- +3 SET Z=$GET(^TMP("PSOREJP0",$JOB,PSOSEL,"RX"))
- +4 SET RX=$PIECE(Z,"^")
- SET REJ=$PIECE(Z,"^",2)
- IF 'RX!'REJ
- SET VALMSG="Invalid selection!"
- SET VALMBCK="R"
- QUIT
- +5 SET PSOCHNG=0
- DO EN^PSOREJP1(RX,REJ,.PSOCHNG)
- IF $GET(PSOCHNG)
- DO REF
- +6 QUIT
- +7 ;
- EXIT ;
- +1 KILL ^TMP("PSOREJP0",$JOB),^TMP("PSOREJSR",$JOB)
- +2 QUIT
- +3 ;
- HELP QUIT
- +1 ;
- SITES() ; - Returns the list of sites along with their NCPDP #s
- +1 NEW CNT,SITE,SITES,NAME
- +2 IF '$DATA(PSOREJST)
- QUIT ""
- +3 IF $GET(PSOREJST)="ALL"
- QUIT "Divisions : ALL"
- +4 SET SITE=0
- FOR
- SET SITE=$ORDER(PSOREJST(SITE))
- if 'SITE
- QUIT
- Begin DoDot:1
- +5 SET NAME=$$GET1^DIQ(59,SITE,.01)
- +6 SET SITES=$GET(SITES)_", "_NAME
- End DoDot:1
- +7 SET $EXTRACT(SITES,1,2)=""
- SET SITES="Division"_$SELECT($LENGTH(SITES,",")>1:"s",1:" ")_" : "_SITES
- +8 QUIT SITES
- +9 ;
- DIV(RX,FILL) ; - Check if the Division for the Prescription/Fill was selected by the user
- +1 ;
- +2 IF $GET(PSOREJST)="ALL"
- QUIT 1
- +3 IF $DATA(PSOREJST($$RXSITE^PSOBPSUT(RX,FILL)))
- QUIT 1
- +4 QUIT 0
- +5 ;
- PTNAME(RX) ; - Returns header displayable - Patient Name (Last 4 SSN)
- +1 NEW DFN,VADM,PTNAME
- +2 SET DFN=$$GET1^DIQ(52,RX,2,"I")
- DO DEM^VADPT
- +3 SET PTNAME=$EXTRACT($GET(VADM(1)),1,18)_"("_$PIECE($PIECE($GET(VADM(2)),"^",2),"-",3)_")"
- +4 QUIT PTNAME
- +5 ;
- FILTER(RX,INS) ; - Filter entries based on user's selection
- +1 NEW FILTER
- +2 SET FILTER=1
- +3 IF $GET(PSOPTFLT)'="ALL"
- IF $DATA(RX)
- IF '$DATA(PSOPTFLT($$GET1^DIQ(52,RX,2,"I")))
- QUIT FILTER
- +4 IF $GET(PSODRFLT)'="ALL"
- IF $DATA(RX)
- IF '$DATA(PSODRFLT($$GET1^DIQ(52,RX,6,"I")))
- QUIT FILTER
- +5 IF $GET(PSOINFLT)'="ALL"
- IF $DATA(INS)
- IF '$DATA(PSOINFLT(+INS))
- QUIT FILTER
- +6 QUIT 0
- +7 ;
- FLTSTS(RX,REJ) ; - Filter for the Reject Status
- +1 NEW STS
- +2 SET STS=$$GET1^DIQ(52.25,REJ_","_RX,9,"I")
- +3 IF PSOSTFLT="U"
- IF STS=1
- QUIT 1
- +4 IF PSOSTFLT="R"
- IF STS=0
- QUIT 1
- +5 QUIT 0
- +6 ;
- FLTRC(RX,REJ) ; - Filter for user selected Reject Codes
- +1 NEW REJCD
- +2 SET REJCD=$$GET1^DIQ(52.25,REJ_","_RX,.01)
- +3 SET REJCD=$ORDER(^BPSF(9002313.93,"B",REJCD,""))
- +4 IF '$DATA(PSORCFLT(REJCD))
- QUIT 1
- +5 QUIT 0
- +6 ;
- NAME(TYPE) ; - Returns the name if ONE was selected or "MULTIPLE ..."
- +1 NEW I,CNT,RC01,RC02,RC
- +2 ;
- +3 IF TYPE="P"
- IF $ORDER(PSOPTFLT($ORDER(PSOPTFLT(""))))=""
- QUIT $$GET1^DIQ(2,$ORDER(PSOPTFLT("")),.01)
- +4 IF TYPE="D"
- IF $ORDER(PSODRFLT($ORDER(PSODRFLT(""))))=""
- QUIT $$GET1^DIQ(50,$ORDER(PSODRFLT("")),.01)
- +5 IF TYPE="I"
- IF $ORDER(PSOINFLT($ORDER(PSOINFLT(""))))=""
- QUIT $ORDER(PSOINFLT(""))
- +6 IF TYPE="R"
- QUIT $$GET1^DIQ(52,PSORXFLT,.01)
- +7 IF TYPE="C"
- IF $ORDER(PSORCFLT($ORDER(PSORCFLT(""))))=""
- Begin DoDot:1
- +8 SET RC01=$$GET1^DIQ(9002313.93,$ORDER(PSORCFLT("")),.01)
- +9 SET RC02=$$GET1^DIQ(9002313.93,$ORDER(PSORCFLT("")),.02)
- +10 SET RC=RC01_" - "_RC02
- End DoDot:1
- QUIT RC
- +11 QUIT "MULTIPLE "_$SELECT(TYPE="P":"PATIENTS",TYPE="D":"DRUGS",TYPE="C":"REJECT CODES",1:"INSURANCE COMPANIES")
- +12 ;
- ENDT() ; Returns the upper limit for the date range
- +1 NEW ENDT
- +2 SET ENDT=$PIECE(PSODTRNG,"^",2)
- +3 IF '$EXTRACT(ENDT,4,7)
- QUIT (ENDT+10000)
- +4 IF '$EXTRACT(ENDT,6,7)
- QUIT (ENDT+100)
- +5 IF $PIECE(ENDT,"^",2)
- QUIT (ENDT+0.0000001)
- +6 QUIT (ENDT+.25)
- VER ;Do VER Hidden Action in Rejects Worklist
- +1 NEW BPSVRX
- +2 DO FULL^VALM1
- +3 ;DBIA #5723
- DO ^BPSVRX
- +4 SET VALMBCK="R"
- +5 QUIT
- +6 ;
- PRTEXCL ;
- +1 ; Protocol to Print to Excel
- +2 ;
- +3 ; Use full screen
- +4 DO FULL^VALM1
- +5 ;
- +6 ; Prompt to see if the user wants to print to Excel
- +7 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +8 SET DIR(0)="Y"
- +9 SET DIR("A")="Do you want to capture report data for an Excel document"
- SET DIR("B")="NO"
- +10 DO ^DIR
- +11 IF Y'=1
- GOTO PEXIT
- +12 ;
- +13 ; Display Warning Message
- +14 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
- +15 WRITE !?5,"detail report data. On some terminals, this can be done by"
- +16 WRITE !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
- +17 WRITE !?5,"Incoming Data' to save to Desktop"
- +18 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the"
- +19 WRITE !?10,"file, please enter '0;256;999' at the 'DEVICE:' prompt."
- +20 ;
- +21 ; Prompt for device
- +22 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP,OK
- +23 SET OK=0
- +24 FOR
- Begin DoDot:1
- +25 SET %ZIS="QM"
- +26 DO ^%ZIS
- +27 IF POP
- QUIT
- +28 IF '$DATA(IO("Q"))
- SET OK=1
- QUIT
- +29 IF $DATA(IO("Q"))
- Begin DoDot:2
- +30 KILL IO("Q")
- +31 DO HOME^%ZIS
- +32 WRITE !,"Sorry, the output for this action cannot be queued. Please select a device that"
- +33 WRITE !,"does not requiring queuing."
- End DoDot:2
- End DoDot:1
- IF POP!OK
- QUIT
- +34 IF POP
- GOTO PEXIT
- +35 ;
- +36 ; If not queued, run the process directly
- +37 DO RUN
- +38 ;
- PEXIT ;
- +1 ; Reset before going back to ListMan
- +2 SET VALMBCK="R"
- +3 QUIT
- +4 ;
- +5 ; Run the Report
- RUN ;
- +1 NEW SORTA,INS,SORT,RX,REJ,FILL,PTNAME,DRNAME,RXNUM,REJLST,CODE,REASON,MSG
- +2 USE IO
- +3 ; Write Header
- +4 WRITE !,"Section/Insurance^RX#^Patient(ID)^Drug^Reason^Payer Message"
- +5 ;
- +6 ; Loop through temp array and output
- +7 SET SORTA=""
- FOR
- SET SORTA=$ORDER(^TMP("PSOREJSR",$JOB,SORTA))
- if 'SORTA
- QUIT
- Begin DoDot:1
- +8 SET INS=""
- FOR
- SET INS=$ORDER(^TMP("PSOREJSR",$JOB,SORTA,INS))
- if INS=""
- QUIT
- Begin DoDot:2
- +9 SET SORT=""
- FOR
- SET SORT=$ORDER(^TMP("PSOREJSR",$JOB,SORTA,INS,SORT))
- if SORT=""
- QUIT
- Begin DoDot:3
- +10 WRITE !,$SELECT(INS'="<NULL>":INS,1:"Refill Too Soon/DUR Rejects")_U
- +11 SET RX=$PIECE(^TMP("PSOREJSR",$JOB,SORTA,INS,SORT),"^",1)
- SET REJ=$PIECE(^TMP("PSOREJSR",$JOB,SORTA,INS,SORT),"^",2)
- +12 SET FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
- +13 SET PTNAME=$$PTNAME(RX)
- +14 SET DRNAME=$$GET1^DIQ(52,RX,6)
- +15 SET RXNUM=$$GET1^DIQ(52,RX,.01)
- +16 KILL REJLST
- DO GET^PSOREJU2(RX,FILL,.REJLST,,1)
- +17 SET CODE=$GET(REJLST(REJ,"CODE"))
- +18 SET REASON=$SELECT(CODE=88!(CODE=943):"DUR:"_$GET(REJLST(REJ,"REASON")),CODE=79:"79 :REFILL TOO SOON",1:CODE_" :"_$$EXP^PSOREJP1(CODE))
- +19 SET MSG=$GET(REJLST(REJ,"PAYER MESSAGE"))
- +20 WRITE RXNUM_U_PTNAME_U_DRNAME_U_REASON_U_MSG
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 ;
- +22 ; Cleanup
- +23 IF $EXTRACT($GET(IOST),1,2)'="C-"
- WRITE !,@IOF
- +24 IF $EXTRACT($GET(IOST),1,2)="C-"
- Begin DoDot:1
- +25 NEW DIR,DTOUT,DUOUT,DIROUT,DIRUT
- +26 SET DIR(0)="E"
- +27 DO ^DIR
- End DoDot:1
- +28 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +29 DO ^%ZISC
- +30 QUIT