Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOREJP4

PSOREJP4.m

Go to the documentation of this file.
  1. PSOREJP4 ;BP/CMF - Pharmacy Rejects List Mail message ;06/26/08
  1. ;;7.0;OUTPATIENT PHARMACY;**289,427,562**;DEC 1997;Build 19
  1. ;; use of ^VADPT supported by IA#10061
  1. ;@author - Chris Flegel
  1. ;@date - August 18, 2008
  1. ;@version - 1.0
  1. Q
  1. EN ; entry point for background option
  1. N RESULT,C
  1. S RESULT=0
  1. D BEGIN
  1. I +$$LOAD() D SORT S RESULT=$$MAIL()
  1. D END
  1. Q
  1. ;;
  1. BEGIN ;
  1. K ^TMP($J,"PSOREJP4")
  1. Q
  1. ;;
  1. END ;
  1. K ^TMP($J,"PSOREJP4")
  1. Q
  1. ;;
  1. BUFDATE(DIVISION) ;
  1. Q:'$G(DIVISION) ""
  1. N RXDIVBUF,CUTDT
  1. D:'$D(^TMP($J,"PSOREJP4","DIVISION",DIVISION))
  1. .S RXDIVBUF=$$GET1^DIQ(52.86,DIVISION,4)
  1. .S ^TMP($J,"PSOREJP4","DIVISION",DIVISION)=RXDIVBUF
  1. S RXDIVBUF=+^TMP($J,"PSOREJP4","DIVISION",DIVISION)
  1. S RXDIVBUF=$S(RXDIVBUF=""!(RXDIVBUF<1):5,1:RXDIVBUF)
  1. S X1=DT,X2=-RXDIVBUF D C^%DTC S CUTDT=X
  1. Q CUTDT
  1. ;
  1. LOAD() ;;
  1. N RXIEN,REJECT,BUFDATE,REJDATE,COMDATE,DIVISION,COUNT,RXSTAT,RXDIV
  1. S COUNT=0
  1. S RXIEN=0
  1. F S RXIEN=$O(^PSRX("REJSTS",0,RXIEN)) Q:'RXIEN D
  1. .S REJECT=0
  1. .F S REJECT=$O(^PSRX("REJSTS",0,RXIEN,REJECT)) Q:'REJECT D
  1. ..S RXSTAT=$$GET1^DIQ(52,RXIEN,100,"I") Q:",10,12,13,14,15,"[(","_RXSTAT_",") ;quit unless active
  1. ..S RXDIV=$$GET1^DIQ(52,RXIEN,20,"I"),DIVISION="",DIVISION=$O(^PS(52.86,"B",RXDIV,DIVISION))
  1. ..Q:'DIVISION
  1. ..S BUFDATE=$$BUFDATE(DIVISION)
  1. ..S REJDATE=$P(^PSRX(RXIEN,"REJ",REJECT,0),U,2),REJDATE=$P(REJDATE,".")
  1. ..Q:REJDATE>BUFDATE ;;quit if reject date is newer than the cutoff date
  1. ..S COMDATE=""
  1. ..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
  1. ..;S COMDATE=$O(^PSRX(RXIEN,"REJ",REJECT,"COM","B",BUFDATE))
  1. ..Q:COMDATE>BUFDATE ;don't put on the list if comment was defined after cutoff date
  1. ..S ^TMP($J,"PSOREJP4",DIVISION,RXIEN,REJECT)=RXSTAT
  1. ..S COUNT=COUNT+1
  1. Q COUNT
  1. ;;
  1. SORT ;;
  1. N DIVISION,RXIEN,RX,DRUGNAME,PATNAME,PATSSN,PATLAST4,REJECT,DFN,RXSTAT
  1. N ENTRYNUM,SORT,OUT,I,J,LINE,II,COMM1,COMM2,SORTA,PSOTRIC,CODE
  1. K ^UTILITY($J,"W")
  1. S (DIVISION,ENTRYNUM)=0
  1. F S DIVISION=$O(^TMP($J,"PSOREJP4",DIVISION)) Q:+DIVISION=0 D
  1. .S RXIEN=0
  1. .F S RXIEN=$O(^TMP($J,"PSOREJP4",DIVISION,RXIEN)) Q:+RXIEN=0 D
  1. ..S REJECT=0
  1. ..F S REJECT=$O(^TMP($J,"PSOREJP4",DIVISION,RXIEN,REJECT)) Q:'REJECT D
  1. ...S DFN=$$GET1^DIQ(52,RXIEN,2,"I")
  1. ...S RXSTAT=$$GET1^DIQ(52,RXIEN,100)
  1. ...N VA,VADM,VAERR,SORT,OUT
  1. ...N RXIENS,REJIENS,REFIENS,RXNUM,RXFILL,I
  1. ...N FILLDATE,REJDATE,DETCDATE,RSNCODE,RSNTEXT
  1. ...D DEM^VADPT
  1. ...Q:+$G(VAERR)
  1. ...S PATNAME=VADM(1)
  1. ...S PATSSN=VA("PID")
  1. ...S PATLAST4=VA("BID")
  1. ...S SORT=PATNAME_U_PATSSN_U
  1. ...S RXNUM=$$GET1^DIQ(52,RXIEN,.01)
  1. ...S REJIENS=REJECT_","_RXIEN_","
  1. ...S RXFILL=$$GET1^DIQ(52.25,REJIENS,5)
  1. ...S SORT=SORT_RXNUM_U_(999-RXFILL)_U_(999-REJECT)
  1. ...S OUT=""
  1. ...S OUT=OUT_$$LJ^XLFSTR(RXNUM_"/"_RXFILL,13)
  1. ...S PATNAME=$E(PATNAME,1,12)_"("_PATLAST4_")"
  1. ...S PATNAME=$E(PATNAME,1,18)
  1. ...S OUT=OUT_$$LJ^XLFSTR(PATNAME,20)
  1. ...S DRUGNAME=$$GET1^DIQ(52,RXIEN,6)
  1. ...S DRUGNAME=$E(DRUGNAME,1,22)
  1. ...S OUT=OUT_$$LJ^XLFSTR(DRUGNAME,24)
  1. ...S REFIENS=RXFILL_","_RXIEN_","
  1. ...S FILLDATE=$S(RXFILL=0:$$GET1^DIQ(52,RXIEN,22,"I"),1:$$GET1^DIQ(52.1,REFIENS,.01,"I"))
  1. ...S FILLDATE=$$FMTE^XLFDT(FILLDATE,2)
  1. ...S OUT=OUT_$$LJ^XLFSTR(FILLDATE,10)
  1. ...S DETCDATE=$P($$GET1^DIQ(52.25,REJIENS,1,"I"),".")
  1. ...S DETCDATE=$$FMTE^XLFDT(DETCDATE,2)
  1. ...S OUT=OUT_$$LJ^XLFSTR(DETCDATE,8)
  1. ...S PSOTRIC=$$TRIC^PSOREJP1(RXIEN,RXFILL)
  1. ...S CODE=$$GET1^DIQ(52.25,REJIENS,.01)
  1. ...S SORTA=1
  1. ...I CODE'=79,CODE'=88,CODE'=943 D
  1. ....I PSOTRIC=2 S SORTA="3^CHAMPVA - Non-DUR/RTS"
  1. ....I PSOTRIC=1 S SORTA="4^TRICARE - Non-DUR/RTS"
  1. ....I 'PSOTRIC D
  1. .....I $$GET1^DIQ(52.25,REJIENS,30,"I")=1 S SORTA="2^REJECT RESOLUTION REQUIRED" Q
  1. .....S SORTA="5^OTHER REJECTS"
  1. ...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,0)=RXIEN_U_REJECT
  1. ...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)=OUT
  1. ...S OUT=" Rx Status: "_RXSTAT
  1. ...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,2)=OUT
  1. ...S RSNCODE=$$GET1^DIQ(52.25,REJIENS,.01)
  1. ...S OUT=" Reason: "_RSNCODE
  1. ...S RSNCODE=$$FIND1^DIC(9002313.93,,,RSNCODE)
  1. ...S RSNTEXT=$$GET1^DIQ(9002313.93,RSNCODE_",",.02,"E")
  1. ...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,3)=OUT_" :"_RSNTEXT
  1. ...S LINE=3
  1. ...D:$D(^PSRX(RXIEN,"REJ",REJECT,"COM"))
  1. ....N DIWL,DIWR,X
  1. ....S LINE=LINE+1,COMM1=1
  1. ....S II=0
  1. ....F S II=$O(^PSRX(RXIEN,"REJ",REJECT,"COM",II)) Q:'II D
  1. .....N COMIENS,COMDATE,COMUSER,COMTEXT,TXT
  1. .....S DIWL=1,DIWR=60
  1. .....K ^UTILITY($J,"W")
  1. .....S COMIENS=II_","_REJECT_","_RXIEN_","
  1. .....S COMDATE=$$GET1^DIQ(52.2551,COMIENS,.01)
  1. .....S X=COMDATE
  1. .....S COMTEXT=$$GET1^DIQ(52.2551,COMIENS,2)
  1. .....S X=X_" - "_COMTEXT
  1. .....S COMUSER=$$GET1^DIQ(52.2551,COMIENS,1)
  1. .....S X=X_" ("_COMUSER_")"
  1. .....D ^DIWP
  1. .....S COMM2=0
  1. .....F J=1:1 Q:'$D(^UTILITY($J,"W",1,J,0)) D
  1. ......S TXT=^UTILITY($J,"W",1,J,0),COMM2=COMM2+1
  1. ......I COMM1=1 S OUT=" COMMENTS: -"_TXT
  1. ......E S OUT=" "_$S(COMM2=1:"-",1:"")_TXT
  1. ......S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,LINE)=OUT
  1. ......S LINE=LINE+1,(COMM2,COMM1)=COMM1+1
  1. .....K ^UTILITY($J,"W")
  1. ...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,LINE+1)=""
  1. ;derive entry number for message
  1. S DIVISION=0
  1. F S DIVISION=$O(^TMP($J,"PSOREJP4",DIVISION)) Q:+DIVISION=0 D
  1. .S ENTRYNUM=0
  1. .S SORTA=""
  1. .F S SORTA=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA)) Q:SORTA="" D
  1. ..S SORT=""
  1. ..F S SORT=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT)) Q:SORT']"" D
  1. ...S ENTRYNUM=ENTRYNUM+1
  1. ...S OUT=^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)
  1. ...S ^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT,1)=$$RJ^XLFSTR(ENTRYNUM,3)_" "_OUT
  1. ;;
  1. MAIL() ;;
  1. N DIVISION,RESULT,COUNT,REJECT,I,SORT,COUNT
  1. S (DIVISION,RESULT)=0
  1. F S DIVISION=$O(^TMP($J,"PSOREJP4",DIVISION)) Q:+DIVISION=0 D
  1. .N XMSUB,XMDUZ,XMTEXT,XMY
  1. .S XMSUB="ePharmacy - OPEN/UNRESOLVED REJECTS LIST for "_$$GET1^DIQ(52.86,DIVISION,.01)
  1. .S XMDUZ="OUTPATIENT PHARMACY PACKAGE"
  1. .S XMTEXT="^TMP($J,""PSOREJP4"",""MESSAGE"","
  1. .S XMY("G.PSO REJECTS BACKGROUND MESSAGE")=""
  1. .K ^TMP($J,"PSOREJP4","MESSAGE")
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",1)="No action has been taken within the past "_^TMP($J,"PSOREJP4","DIVISION",DIVISION)_" days to resolve the rejects"
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",2)="listed in this message. They will continue to show on the Third Party"
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",3)="Payer Rejects - Worklist until acted upon. Please use the Third Party Payer"
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",4)="Rejects - Worklist option to resolve the rejection or add a comment to the"
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",5)="rejection."
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",6)=""
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",7)="Prescriptions will not be filled for Unresolved DUR, RTS, RRR, TRICARE and"
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",8)="CHAMPVA rejects."
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",9)=""
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",10)=" FILL REJECT"
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",11)=" # RX/FILL PATIENT(ID) DRUG DATE DATE"
  1. .S ^TMP($J,"PSOREJP4","MESSAGE",12)="------------------------------------------------------------------------------"
  1. .S COUNT=13
  1. .S SORTA=""
  1. .F S SORTA=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA)) Q:SORTA="" D
  1. ..I SORTA'=1 D
  1. ...N X,POS,LBL
  1. ...S LBL=$P(SORTA,"^",2)
  1. ...S POS=41-($L(LBL)/2+.5\1)
  1. ...S X="",$P(X," ",42)="",$E(X,POS,POS-1+$L(LBL))=LBL
  1. ...S COUNT=COUNT+1,^TMP($J,"PSOREJP4","MESSAGE",COUNT)=X
  1. ..S SORT=""
  1. ..F S SORT=$O(^TMP($J,"PSOREJP4",DIVISION,"SORT",SORTA,SORT)) Q:SORT']"" D
  1. ...S I=0
  1. ...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
  1. .D ^XMD
  1. .S:+$G(XMZ) RESULT=XMZ
  1. Q RESULT