PSOREJP4 ;BP/CMF - Pharmacy Rejects List Mail message ;06/26/08
;;7.0;OUTPATIENT PHARMACY;**289,427,562**;DEC 1997;Build 19
;; use of ^VADPT supported by IA#10061
;@author - Chris Flegel
;@date - August 18, 2008
;@version - 1.0
Q
EN ; entry point for background option
N RESULT,C
S RESULT=0
D BEGIN
I +$$LOAD() D SORT S RESULT=$$MAIL()
D END
Q
;;
BEGIN ;
K ^TMP($J,"PSOREJP4")
Q
;;
END ;
K ^TMP($J,"PSOREJP4")
Q
;;
BUFDATE(DIVISION) ;
Q:'$G(DIVISION) ""
N RXDIVBUF,CUTDT
D:'$D(^TMP($J,"PSOREJP4","DIVISION",DIVISION))
.S RXDIVBUF=$$GET1^DIQ(52.86,DIVISION,4)
.S ^TMP($J,"PSOREJP4","DIVISION",DIVISION)=RXDIVBUF
S RXDIVBUF=+^TMP($J,"PSOREJP4","DIVISION",DIVISION)
S RXDIVBUF=$S(RXDIVBUF=""!(RXDIVBUF<1):5,1:RXDIVBUF)
S X1=DT,X2=-RXDIVBUF D C^%DTC S CUTDT=X
Q CUTDT
;
LOAD() ;;
N RXIEN,REJECT,BUFDATE,REJDATE,COMDATE,DIVISION,COUNT,RXSTAT,RXDIV
S COUNT=0
S RXIEN=0
F S RXIEN=$O(^PSRX("REJSTS",0,RXIEN)) Q:'RXIEN D
.S REJECT=0
.F S REJECT=$O(^PSRX("REJSTS",0,RXIEN,REJECT)) Q:'REJECT D
..S RXSTAT=$$GET1^DIQ(52,RXIEN,100,"I") Q:",10,12,13,14,15,"[(","_RXSTAT_",") ;quit unless active
..S RXDIV=$$GET1^DIQ(52,RXIEN,20,"I"),DIVISION="",DIVISION=$O(^PS(52.86,"B",RXDIV,DIVISION))
..Q:'DIVISION
..S BUFDATE=$$BUFDATE(DIVISION)
..S REJDATE=$P(^PSRX(RXIEN,"REJ",REJECT,0),U,2),REJDATE=$P(REJDATE,".")
..Q:REJDATE>BUFDATE ;;quit if reject date is newer than the cutoff date
..S COMDATE=""
..I $D(^PSRX(RXIEN,"REJ",REJECT,"COM")) S COMDATE=$O(^PSRX(RXIEN,"REJ",REJECT,"COM","B",COMDATE),-1),COMDATE=$P(COMDATE,".") ;Get the last comments date
..;S COMDATE=$O(^PSRX(RXIEN,"REJ",REJECT,"COM","B",BUFDATE))
..Q:COMDATE>BUFDATE ;don't put on the list if comment was defined after cutoff date
..S ^TMP($J,"PSOREJP4",DIVISION,RXIEN,REJECT)=RXSTAT
..S COUNT=COUNT+1
Q COUNT
;;
SORT ;;
N DIVISION,RXIEN,RX,DRUGNAME,PATNAME,PATSSN,PATLAST4,REJECT,DFN,RXSTAT
N ENTRYNUM,SORT,OUT,I,J,LINE,II,COMM1,COMM2,SORTA,PSOTRIC,CODE
K ^UTILITY($J,"W")
S (DIVISION,ENTRYNUM)=0
F S DIVISION=$O(^TMP($J,"PSOREJP4",DIVISION)) Q:+DIVISION=0 D
.S RXIEN=0
.F S RXIEN=$O(^TMP($J,"PSOREJP4",DIVISION,RXIEN)) Q:+RXIEN=0 D
..S REJECT=0
..F S REJECT=$O(^TMP($J,"PSOREJP4",DIVISION,RXIEN,REJECT)) Q:'REJECT D
...S DFN=$$GET1^DIQ(52,RXIEN,2,"I")
...S RXSTAT=$$GET1^DIQ(52,RXIEN,100)
...N VA,VADM,VAERR,SORT,OUT
...N RXIENS,REJIENS,REFIENS,RXNUM,RXFILL,I
...N FILLDATE,REJDATE,DETCDATE,RSNCODE,RSNTEXT
...D DEM^VADPT
...Q:+$G(VAERR)
...S PATNAME=VADM(1)
...S PATSSN=VA("PID")
...S PATLAST4=VA("BID")
...S SORT=PATNAME_U_PATSSN_U
...S RXNUM=$$GET1^DIQ(52,RXIEN,.01)
...S REJIENS=REJECT_","_RXIEN_","
...S RXFILL=$$GET1^DIQ(52.25,REJIENS,5)
...S SORT=SORT_RXNUM_U_(999-RXFILL)_U_(999-REJECT)
...S OUT=""
...S OUT=OUT_$$LJ^XLFSTR(RXNUM_"/"_RXFILL,13)
...S PATNAME=$E(PATNAME,1,12)_"("_PATLAST4_")"
...S PATNAME=$E(PATNAME,1,18)
...S OUT=OUT_$$LJ^XLFSTR(PATNAME,20)
...S DRUGNAME=$$GET1^DIQ(52,RXIEN,6)
...S DRUGNAME=$E(DRUGNAME,1,22)
...S OUT=OUT_$$LJ^XLFSTR(DRUGNAME,24)
...S REFIENS=RXFILL_","_RXIEN_","
...S FILLDATE=$S(RXFILL=0:$$GET1^DIQ(52,RXIEN,22,"I"),1:$$GET1^DIQ(52.1,REFIENS,.01,"I"))
...S FILLDATE=$$FMTE^XLFDT(FILLDATE,2)
...S OUT=OUT_$$LJ^XLFSTR(FILLDATE,10)
...S DETCDATE=$P($$GET1^DIQ(52.25,REJIENS,1,"I"),".")
...S DETCDATE=$$FMTE^XLFDT(DETCDATE,2)
...S OUT=OUT_$$LJ^XLFSTR(DETCDATE,8)
...S PSOTRIC=$$TRIC^PSOREJP1(RXIEN,RXFILL)
...S CODE=$$GET1^DIQ(52.25,REJIENS,.01)
...S SORTA=1
...I CODE'=79,CODE'=88,CODE'=943 D
....I PSOTRIC=2 S SORTA="3^CHAMPVA - Non-DUR/RTS"
....I PSOTRIC=1 S SORTA="4^TRICARE - Non-DUR/RTS"
....I 'PSOTRIC D
.....I $$GET1^DIQ(52.25,REJIENS,30,"I")=1 S SORTA="2^REJECT RESOLUTION REQUIRED" Q
.....S SORTA="5^OTHER REJECTS"
...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,0)=RXIEN_U_REJECT
...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)=OUT
...S OUT=" Rx Status: "_RXSTAT
...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,2)=OUT
...S RSNCODE=$$GET1^DIQ(52.25,REJIENS,.01)
...S OUT=" Reason: "_RSNCODE
...S RSNCODE=$$FIND1^DIC(9002313.93,,,RSNCODE)
...S RSNTEXT=$$GET1^DIQ(9002313.93,RSNCODE_",",.02,"E")
...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,3)=OUT_" :"_RSNTEXT
...S LINE=3
...D:$D(^PSRX(RXIEN,"REJ",REJECT,"COM"))
....N DIWL,DIWR,X
....S LINE=LINE+1,COMM1=1
....S II=0
....F S II=$O(^PSRX(RXIEN,"REJ",REJECT,"COM",II)) Q:'II D
.....N COMIENS,COMDATE,COMUSER,COMTEXT,TXT
.....S DIWL=1,DIWR=60
.....K ^UTILITY($J,"W")
.....S COMIENS=II_","_REJECT_","_RXIEN_","
.....S COMDATE=$$GET1^DIQ(52.2551,COMIENS,.01)
.....S X=COMDATE
.....S COMTEXT=$$GET1^DIQ(52.2551,COMIENS,2)
.....S X=X_" - "_COMTEXT
.....S COMUSER=$$GET1^DIQ(52.2551,COMIENS,1)
.....S X=X_" ("_COMUSER_")"
.....D ^DIWP
.....S COMM2=0
.....F J=1:1 Q:'$D(^UTILITY($J,"W",1,J,0)) D
......S TXT=^UTILITY($J,"W",1,J,0),COMM2=COMM2+1
......I COMM1=1 S OUT=" COMMENTS: -"_TXT
......E S OUT=" "_$S(COMM2=1:"-",1:"")_TXT
......S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,LINE)=OUT
......S LINE=LINE+1,(COMM2,COMM1)=COMM1+1
.....K ^UTILITY($J,"W")
...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,LINE+1)=""
;derive entry number for message
S DIVISION=0
F S DIVISION=$O(^TMP($J,"PSOREJP4",DIVISION)) Q:+DIVISION=0 D
.S ENTRYNUM=0
.S SORTA=""
.F S SORTA=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA)) Q:SORTA="" D
..S SORT=""
..F S SORT=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT)) Q:SORT']"" D
...S ENTRYNUM=ENTRYNUM+1
...S OUT=^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)
...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)=$$RJ^XLFSTR(ENTRYNUM,3)_" "_OUT
;;
MAIL() ;;
N DIVISION,RESULT,COUNT,REJECT,I,SORT,COUNT
S (DIVISION,RESULT)=0
F S DIVISION=$O(^TMP($J,"PSOREJP4",DIVISION)) Q:+DIVISION=0 D
.N XMSUB,XMDUZ,XMTEXT,XMY
.S XMSUB="ePharmacy - OPEN/UNRESOLVED REJECTS LIST for "_$$GET1^DIQ(52.86,DIVISION,.01)
.S XMDUZ="OUTPATIENT PHARMACY PACKAGE"
.S XMTEXT="^TMP($J,""PSOREJP4"",""MESSAGE"","
.S XMY("G.PSO REJECTS BACKGROUND MESSAGE")=""
.K ^TMP($J,"PSOREJP4","MESSAGE")
.S ^TMP($J,"PSOREJP4","MESSAGE",1)="No action has been taken within the past "_^TMP($J,"PSOREJP4","DIVISION",DIVISION)_" days to resolve the rejects"
.S ^TMP($J,"PSOREJP4","MESSAGE",2)="listed in this message. They will continue to show on the Third Party"
.S ^TMP($J,"PSOREJP4","MESSAGE",3)="Payer Rejects - Worklist until acted upon. Please use the Third Party Payer"
.S ^TMP($J,"PSOREJP4","MESSAGE",4)="Rejects - Worklist option to resolve the rejection or add a comment to the"
.S ^TMP($J,"PSOREJP4","MESSAGE",5)="rejection."
.S ^TMP($J,"PSOREJP4","MESSAGE",6)=""
.S ^TMP($J,"PSOREJP4","MESSAGE",7)="Prescriptions will not be filled for Unresolved DUR, RTS, RRR, TRICARE and"
.S ^TMP($J,"PSOREJP4","MESSAGE",8)="CHAMPVA rejects."
.S ^TMP($J,"PSOREJP4","MESSAGE",9)=""
.S ^TMP($J,"PSOREJP4","MESSAGE",10)=" FILL REJECT"
.S ^TMP($J,"PSOREJP4","MESSAGE",11)=" # RX/FILL PATIENT(ID) DRUG DATE DATE"
.S ^TMP($J,"PSOREJP4","MESSAGE",12)="------------------------------------------------------------------------------"
.S COUNT=13
.S SORTA=""
.F S SORTA=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA)) Q:SORTA="" D
..I SORTA'=1 D
...N X,POS,LBL
...S LBL=$P(SORTA,"^",2)
...S POS=41-($L(LBL)/2+.5\1)
...S X="",$P(X," ",42)="",$E(X,POS,POS-1+$L(LBL))=LBL
...S COUNT=COUNT+1,^TMP($J,"PSOREJP4","MESSAGE",COUNT)=X
..S SORT=""
..F S SORT=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT)) Q:SORT']"" D
...S I=0
...F S I=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,I)) Q:'I S COUNT=COUNT+1,^TMP($J,"PSOREJP4","MESSAGE",COUNT)=^(I) D
.D ^XMD
.S:+$G(XMZ) RESULT=XMZ
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREJP4 7961 printed Apr 09, 2024@21:30:37 Page 2
PSOREJP4 ;BP/CMF - Pharmacy Rejects List Mail message ;06/26/08
+1 ;;7.0;OUTPATIENT PHARMACY;**289,427,562**;DEC 1997;Build 19
+2 ;; use of ^VADPT supported by IA#10061
+3 ;@author - Chris Flegel
+4 ;@date - August 18, 2008
+5 ;@version - 1.0
+6 QUIT
EN ; entry point for background option
+1 NEW RESULT,C
+2 SET RESULT=0
+3 DO BEGIN
+4 IF +$$LOAD()
DO SORT
SET RESULT=$$MAIL()
+5 DO END
+6 QUIT
+7 ;;
BEGIN ;
+1 KILL ^TMP($JOB,"PSOREJP4")
+2 QUIT
+3 ;;
END ;
+1 KILL ^TMP($JOB,"PSOREJP4")
+2 QUIT
+3 ;;
BUFDATE(DIVISION) ;
+1 if '$GET(DIVISION)
QUIT ""
+2 NEW RXDIVBUF,CUTDT
+3 if '$DATA(^TMP($JOB,"PSOREJP4","DIVISION",DIVISION))
Begin DoDot:1
+4 SET RXDIVBUF=$$GET1^DIQ(52.86,DIVISION,4)
+5 SET ^TMP($JOB,"PSOREJP4","DIVISION",DIVISION)=RXDIVBUF
End DoDot:1
+6 SET RXDIVBUF=+^TMP($JOB,"PSOREJP4","DIVISION",DIVISION)
+7 SET RXDIVBUF=$SELECT(RXDIVBUF=""!(RXDIVBUF<1):5,1:RXDIVBUF)
+8 SET X1=DT
SET X2=-RXDIVBUF
DO C^%DTC
SET CUTDT=X
+9 QUIT CUTDT
+10 ;
LOAD() ;;
+1 NEW RXIEN,REJECT,BUFDATE,REJDATE,COMDATE,DIVISION,COUNT,RXSTAT,RXDIV
+2 SET COUNT=0
+3 SET RXIEN=0
+4 FOR
SET RXIEN=$ORDER(^PSRX("REJSTS",0,RXIEN))
if 'RXIEN
QUIT
Begin DoDot:1
+5 SET REJECT=0
+6 FOR
SET REJECT=$ORDER(^PSRX("REJSTS",0,RXIEN,REJECT))
if 'REJECT
QUIT
Begin DoDot:2
+7 ;quit unless active
SET RXSTAT=$$GET1^DIQ(52,RXIEN,100,"I")
if ",10,12,13,14,15,"[(","_RXSTAT_",")
QUIT
+8 SET RXDIV=$$GET1^DIQ(52,RXIEN,20,"I")
SET DIVISION=""
SET DIVISION=$ORDER(^PS(52.86,"B",RXDIV,DIVISION))
+9 if 'DIVISION
QUIT
+10 SET BUFDATE=$$BUFDATE(DIVISION)
+11 SET REJDATE=$PIECE(^PSRX(RXIEN,"REJ",REJECT,0),U,2)
SET REJDATE=$PIECE(REJDATE,".")
+12 ;;quit if reject date is newer than the cutoff date
if REJDATE>BUFDATE
QUIT
+13 SET COMDATE=""
+14 ;Get the last comments date
IF $DATA(^PSRX(RXIEN,"REJ",REJECT,"COM"))
SET COMDATE=$ORDER(^PSRX(RXIEN,"REJ",REJECT,"COM","B",COMDATE),-1)
SET COMDATE=$PIECE(COMDATE,".")
+15 ;S COMDATE=$O(^PSRX(RXIEN,"REJ",REJECT,"COM","B",BUFDATE))
+16 ;don't put on the list if comment was defined after cutoff date
if COMDATE>BUFDATE
QUIT
+17 SET ^TMP($JOB,"PSOREJP4",DIVISION,RXIEN,REJECT)=RXSTAT
+18 SET COUNT=COUNT+1
End DoDot:2
End DoDot:1
+19 QUIT COUNT
+20 ;;
SORT ;;
+1 NEW DIVISION,RXIEN,RX,DRUGNAME,PATNAME,PATSSN,PATLAST4,REJECT,DFN,RXSTAT
+2 NEW ENTRYNUM,SORT,OUT,I,J,LINE,II,COMM1,COMM2,SORTA,PSOTRIC,CODE
+3 KILL ^UTILITY($JOB,"W")
+4 SET (DIVISION,ENTRYNUM)=0
+5 FOR
SET DIVISION=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION))
if +DIVISION=0
QUIT
Begin DoDot:1
+6 SET RXIEN=0
+7 FOR
SET RXIEN=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION,RXIEN))
if +RXIEN=0
QUIT
Begin DoDot:2
+8 SET REJECT=0
+9 FOR
SET REJECT=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION,RXIEN,REJECT))
if 'REJECT
QUIT
Begin DoDot:3
+10 SET DFN=$$GET1^DIQ(52,RXIEN,2,"I")
+11 SET RXSTAT=$$GET1^DIQ(52,RXIEN,100)
+12 NEW VA,VADM,VAERR,SORT,OUT
+13 NEW RXIENS,REJIENS,REFIENS,RXNUM,RXFILL,I
+14 NEW FILLDATE,REJDATE,DETCDATE,RSNCODE,RSNTEXT
+15 DO DEM^VADPT
+16 if +$GET(VAERR)
QUIT
+17 SET PATNAME=VADM(1)
+18 SET PATSSN=VA("PID")
+19 SET PATLAST4=VA("BID")
+20 SET SORT=PATNAME_U_PATSSN_U
+21 SET RXNUM=$$GET1^DIQ(52,RXIEN,.01)
+22 SET REJIENS=REJECT_","_RXIEN_","
+23 SET RXFILL=$$GET1^DIQ(52.25,REJIENS,5)
+24 SET SORT=SORT_RXNUM_U_(999-RXFILL)_U_(999-REJECT)
+25 SET OUT=""
+26 SET OUT=OUT_$$LJ^XLFSTR(RXNUM_"/"_RXFILL,13)
+27 SET PATNAME=$EXTRACT(PATNAME,1,12)_"("_PATLAST4_")"
+28 SET PATNAME=$EXTRACT(PATNAME,1,18)
+29 SET OUT=OUT_$$LJ^XLFSTR(PATNAME,20)
+30 SET DRUGNAME=$$GET1^DIQ(52,RXIEN,6)
+31 SET DRUGNAME=$EXTRACT(DRUGNAME,1,22)
+32 SET OUT=OUT_$$LJ^XLFSTR(DRUGNAME,24)
+33 SET REFIENS=RXFILL_","_RXIEN_","
+34 SET FILLDATE=$SELECT(RXFILL=0:$$GET1^DIQ(52,RXIEN,22,"I"),1:$$GET1^DIQ(52.1,REFIENS,.01,"I"))
+35 SET FILLDATE=$$FMTE^XLFDT(FILLDATE,2)
+36 SET OUT=OUT_$$LJ^XLFSTR(FILLDATE,10)
+37 SET DETCDATE=$PIECE($$GET1^DIQ(52.25,REJIENS,1,"I"),".")
+38 SET DETCDATE=$$FMTE^XLFDT(DETCDATE,2)
+39 SET OUT=OUT_$$LJ^XLFSTR(DETCDATE,8)
+40 SET PSOTRIC=$$TRIC^PSOREJP1(RXIEN,RXFILL)
+41 SET CODE=$$GET1^DIQ(52.25,REJIENS,.01)
+42 SET SORTA=1
+43 IF CODE'=79
IF CODE'=88
IF CODE'=943
Begin DoDot:4
+44 IF PSOTRIC=2
SET SORTA="3^CHAMPVA - Non-DUR/RTS"
+45 IF PSOTRIC=1
SET SORTA="4^TRICARE - Non-DUR/RTS"
+46 IF 'PSOTRIC
Begin DoDot:5
+47 IF $$GET1^DIQ(52.25,REJIENS,30,"I")=1
SET SORTA="2^REJECT RESOLUTION REQUIRED"
QUIT
+48 SET SORTA="5^OTHER REJECTS"
End DoDot:5
End DoDot:4
+49 SET ^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,0)=RXIEN_U_REJECT
+50 SET ^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)=OUT
+51 SET OUT=" Rx Status: "_RXSTAT
+52 SET ^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,2)=OUT
+53 SET RSNCODE=$$GET1^DIQ(52.25,REJIENS,.01)
+54 SET OUT=" Reason: "_RSNCODE
+55 SET RSNCODE=$$FIND1^DIC(9002313.93,,,RSNCODE)
+56 SET RSNTEXT=$$GET1^DIQ(9002313.93,RSNCODE_",",.02,"E")
+57 SET ^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,3)=OUT_" :"_RSNTEXT
+58 SET LINE=3
+59 if $DATA(^PSRX(RXIEN,"REJ",REJECT,"COM"))
Begin DoDot:4
+60 NEW DIWL,DIWR,X
+61 SET LINE=LINE+1
SET COMM1=1
+62 SET II=0
+63 FOR
SET II=$ORDER(^PSRX(RXIEN,"REJ",REJECT,"COM",II))
if 'II
QUIT
Begin DoDot:5
+64 NEW COMIENS,COMDATE,COMUSER,COMTEXT,TXT
+65 SET DIWL=1
SET DIWR=60
+66 KILL ^UTILITY($JOB,"W")
+67 SET COMIENS=II_","_REJECT_","_RXIEN_","
+68 SET COMDATE=$$GET1^DIQ(52.2551,COMIENS,.01)
+69 SET X=COMDATE
+70 SET COMTEXT=$$GET1^DIQ(52.2551,COMIENS,2)
+71 SET X=X_" - "_COMTEXT
+72 SET COMUSER=$$GET1^DIQ(52.2551,COMIENS,1)
+73 SET X=X_" ("_COMUSER_")"
+74 DO ^DIWP
+75 SET COMM2=0
+76 FOR J=1:1
if '$DATA(^UTILITY($JOB,"W",1,J,0))
QUIT
Begin DoDot:6
+77 SET TXT=^UTILITY($JOB,"W",1,J,0)
SET COMM2=COMM2+1
+78 IF COMM1=1
SET OUT=" COMMENTS: -"_TXT
+79 IF '$TEST
SET OUT=" "_$SELECT(COMM2=1:"-",1:"")_TXT
+80 SET ^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,LINE)=OUT
+81 SET LINE=LINE+1
SET (COMM2,COMM1)=COMM1+1
End DoDot:6
+82 KILL ^UTILITY($JOB,"W")
End DoDot:5
End DoDot:4
+83 SET ^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,LINE+1)=""
End DoDot:3
End DoDot:2
End DoDot:1
+84 ;derive entry number for message
+85 SET DIVISION=0
+86 FOR
SET DIVISION=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION))
if +DIVISION=0
QUIT
Begin DoDot:1
+87 SET ENTRYNUM=0
+88 SET SORTA=""
+89 FOR
SET SORTA=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA))
if SORTA=""
QUIT
Begin DoDot:2
+90 SET SORT=""
+91 FOR
SET SORT=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT))
if SORT']""
QUIT
Begin DoDot:3
+92 SET ENTRYNUM=ENTRYNUM+1
+93 SET OUT=^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)
+94 SET ^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)=$$RJ^XLFSTR(ENTRYNUM,3)_" "_OUT
End DoDot:3
End DoDot:2
End DoDot:1
+95 ;;
MAIL() ;;
+1 NEW DIVISION,RESULT,COUNT,REJECT,I,SORT,COUNT
+2 SET (DIVISION,RESULT)=0
+3 FOR
SET DIVISION=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION))
if +DIVISION=0
QUIT
Begin DoDot:1
+4 NEW XMSUB,XMDUZ,XMTEXT,XMY
+5 SET XMSUB="ePharmacy - OPEN/UNRESOLVED REJECTS LIST for "_$$GET1^DIQ(52.86,DIVISION,.01)
+6 SET XMDUZ="OUTPATIENT PHARMACY PACKAGE"
+7 SET XMTEXT="^TMP($J,""PSOREJP4"",""MESSAGE"","
+8 SET XMY("G.PSO REJECTS BACKGROUND MESSAGE")=""
+9 KILL ^TMP($JOB,"PSOREJP4","MESSAGE")
+10 SET ^TMP($JOB,"PSOREJP4","MESSAGE",1)="No action has been taken within the past "_^TMP($JOB,"PSOREJP4","DIVISION",DIVISION)_" days to resolve the rejects"
+11 SET ^TMP($JOB,"PSOREJP4","MESSAGE",2)="listed in this message. They will continue to show on the Third Party"
+12 SET ^TMP($JOB,"PSOREJP4","MESSAGE",3)="Payer Rejects - Worklist until acted upon. Please use the Third Party Payer"
+13 SET ^TMP($JOB,"PSOREJP4","MESSAGE",4)="Rejects - Worklist option to resolve the rejection or add a comment to the"
+14 SET ^TMP($JOB,"PSOREJP4","MESSAGE",5)="rejection."
+15 SET ^TMP($JOB,"PSOREJP4","MESSAGE",6)=""
+16 SET ^TMP($JOB,"PSOREJP4","MESSAGE",7)="Prescriptions will not be filled for Unresolved DUR, RTS, RRR, TRICARE and"
+17 SET ^TMP($JOB,"PSOREJP4","MESSAGE",8)="CHAMPVA rejects."
+18 SET ^TMP($JOB,"PSOREJP4","MESSAGE",9)=""
+19 SET ^TMP($JOB,"PSOREJP4","MESSAGE",10)=" FILL REJECT"
+20 SET ^TMP($JOB,"PSOREJP4","MESSAGE",11)=" # RX/FILL PATIENT(ID) DRUG DATE DATE"
+21 SET ^TMP($JOB,"PSOREJP4","MESSAGE",12)="------------------------------------------------------------------------------"
+22 SET COUNT=13
+23 SET SORTA=""
+24 FOR
SET SORTA=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA))
if SORTA=""
QUIT
Begin DoDot:2
+25 IF SORTA'=1
Begin DoDot:3
+26 NEW X,POS,LBL
+27 SET LBL=$PIECE(SORTA,"^",2)
+28 SET POS=41-($LENGTH(LBL)/2+.5\1)
+29 SET X=""
SET $PIECE(X," ",42)=""
SET $EXTRACT(X,POS,POS-1+$LENGTH(LBL))=LBL
+30 SET COUNT=COUNT+1
SET ^TMP($JOB,"PSOREJP4","MESSAGE",COUNT)=X
End DoDot:3
+31 SET SORT=""
+32 FOR
SET SORT=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT))
if SORT']""
QUIT
Begin DoDot:3
+33 SET I=0
+34 FOR
SET I=$ORDER(^TMP($JOB,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,I))
if 'I
QUIT
SET COUNT=COUNT+1
SET ^TMP($JOB,"PSOREJP4","MESSAGE",COUNT)=^(I)
Begin DoDot:4
End DoDot:4
End DoDot:3
End DoDot:2
+35 DO ^XMD
+36 if +$GET(XMZ)
SET RESULT=XMZ
End DoDot:1
+37 QUIT RESULT
