- 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 Feb 18, 2025@24:00 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