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

PSOERSE5.m

Go to the documentation of this file.
  1. PSOERSE5 ;ALB/RM - PSO eRx UTILITIES ;Feb 12, 2024@12:43:34
  1. ;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
  1. ;
  1. ;
  1. Q ;No Direct Call
  1. ;
  1. QTSUMDT1(TMPGBL,PSOIEN,MTYPE,CHGMESRI,CHGMESRQ,RESPVAL,LINE) ; Quit Summary Detail early?
  1. N FLG,NO311,RULE
  1. D
  1. . S FLG=0
  1. . I MTYPE="CX",RESPVAL?1"APPROVED".1" WITH CHANGES",",G,T,S,OS,D,"[(","_CHGMESRI_",") D Q
  1. . . S FLG=1,RULE=0
  1. . S RULE=$$GETRULES^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
  1. . S FLG=(RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056"))
  1. I FLG S FLG=$$SETMRC(TMPGBL,PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,.LINE)
  1. Q FLG
  1. ;
  1. SETMRC(TMPGBL,PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,LINE) ; Set values for MRC variables
  1. N CHGMESRE,CHMSSUB,I,IENS,NO311,NOTEARY,RET,X,REATXT
  1. S CHGMESRE=$$GET1^DIQ(52.45,CHGMESRQ,.02,"I")
  1. S @TMPGBL@(LINE,0)="Change Request Type: "_CHGMESRE
  1. I (CHGMESRI="U")!(CHGMESRI="D") D
  1. . S IENS=$O(^PS(52.49,PSOIEN,316,0))
  1. . I IENS D
  1. . . S IENS=IENS_","_PSOIEN_","
  1. . . S CHMSSUB=$$GET1^DIQ(52.49316,IENS,1,"I")
  1. . . S CHMSSUB=$$GET1^DIQ(52.45,CHMSSUB,.02,"E")
  1. . I 'IENS S CHMSSUB=""
  1. . K NOTEARY
  1. . D TXT2ARY^PSOERXD1(.NOTEARY,CHMSSUB," ",55)
  1. . I $D(NOTEARY) D
  1. . . S I=0
  1. . . F S I=$O(NOTEARY(I)) Q:'I D
  1. . . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(I=1:"Change Request Sub Type: ",1:$J("",25))_NOTEARY(I)
  1. . I '$D(NOTEARY) D
  1. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)="Change Request Sub Type: "
  1. ;
  1. S X=$$GET1^DIQ(52.49,PSOIEN,317,,"REATXT")
  1. I $G(REATXT(1))'="" D
  1. . S X=REATXT(1) K RET D TXT2ARY^PSOERXD1(.RET,X," ",80)
  1. . S LINE=LINE+1 S @TMPGBL@(LINE,0)="Change Request Reason Text: "
  1. . S I=0 F S I=$O(RET(I)) Q:I="" S LINE=LINE+1 S @TMPGBL@(LINE,0)=RET(I)
  1. I RULE?1(1"1058",1"1059",1"1060") S NO311='$D(^PS(52.49,PSOIEN,311))
  1. I RULE'?1(1"1058",1"1059",1"1060") S NO311=0
  1. I $G(NO311) D RESTSMDT(TMPGBL,1,PSOIEN,RESPVAL,RULE,.LINE)
  1. Q $G(NO311)
  1. ;
  1. RESTSMDT(TMPGBL,SMALLMP,PSOIEN,RESPVAL,RULE,LINE) ; Print rest of Summary/Details screen for CXD - G/T/S/OS/D
  1. N CHGMESRQ,FLG,STATUS
  1. I SMALLMP D MEDPRES(TMPGBL,PSOIEN,.LINE)
  1. I 'SMALLMP D:((RESPVAL="VALIDATED")&($$GET1^DIQ(52.49,PSOIEN,.08,"I")="CX"))
  1. . D DISPRX^PSOERSE4
  1. S CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
  1. D CXRES(TMPGBL,PSOIEN,RESPVAL,RULE,"1058,1059,1060,0",.LINE)
  1. D MEDREQDR(TMPGBL,PSOIEN,RULE,.LINE)
  1. D CXREQ(TMPGBL,PSOIEN,RULE,.LINE)
  1. D MSGHIS(TMPGBL,PSOIEN,.LINE)
  1. Q
  1. ;
  1. MEDPRES(TMPGBL,PSOIEN,LINE) ; Medication Prescribed
  1. I @TMPGBL@(LINE,0)'="" S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="**************************MEDICATION PRESCRIBED******************************"
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="No Medication information available on the Response."
  1. Q
  1. ;
  1. CXRES(TMPGBL,ERXIEN,RESPVAL,RULE,RULES,LINE) ;
  1. N CODEIEN,COMM,COMMARY,COMMBY,COMMDTTM,DATE,DELTA,DRCVGST,ERESCODE,ERXDAT,FLG,FN,I
  1. N ID,IENS,IENS2,J,MIEN,MTYPE,NOTE,NOTEARY,PRIAUTH,PRAUTHST,RECODE,REQIEN,RESCODE
  1. N RESDESC,RESDTTM,RESIEN,RESTEXT,RESVAL,SFIEN,STATUS,STR1,STR1ARY,STR2,STR2ARY
  1. N TXT,XLINE
  1. I (","_RULES_",")[(","_$E(RULE,1,4)_",") D
  1. .S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
  1. .S FLG=1
  1. I (","_RULES_",")'[(","_$E(RULE,1,4)_",") D
  1. .S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
  1. .I MTYPE="CR" D Q
  1. ..S RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
  1. ..I RESIEN D Q
  1. ...S REQIEN=ERXIEN
  1. ...S FLG=1
  1. ..S FLG=0
  1. .S FLG=0
  1. Q:'FLG
  1. S IENS=RESIEN_","
  1. D GETS^DIQ(52.49,RESIEN,".03;50;50.1;50.2;52.1;52.2;319.5;324","IE","ERXDAT")
  1. S RESDTTM=$G(ERXDAT(52.49,IENS,.03,"E"))
  1. S RESVAL=$G(ERXDAT(52.49,IENS,52.1,"E"))
  1. S RESCODE=$G(ERXDAT(52.49,IENS,52.1,"I"))
  1. S NOTE=$G(ERXDAT(52.49,IENS,52.2,"E"))
  1. S ID=$G(ERXDAT(52.49,IENS,319.5,"E"))
  1. S DATE=$G(ERXDAT(52.49,IENS,324,"I"))
  1. I $D(^PS(52.49,ERXIEN,311)) D
  1. . S SFIEN=$O(^PS(52.49,ERXIEN,311,"C","P",0))
  1. . Q:'SFIEN
  1. . S IENS2=SFIEN_","_IENS
  1. . D GETS^DIQ(52.49311,IENS2,"4.1;4.2;5","IE","ERXDAT")
  1. . S PRIAUTH=$G(ERXDAT(52.49311,IENS2,4.1,"E"))
  1. . S PRAUTHST=$G(ERXDAT(52.49311,IENS2,4.2,"E"))
  1. . S I=$O(^PS(52.49,RESIEN,311,SFIEN,7,0))
  1. . I I D
  1. . . S DRCVGST=$$GET1^DIQ(52.493117,I_","_IENS2,.02,"I")
  1. . . S DRCVGST=$$GET1^DIQ(52.45,DRCVGST,.02,"E")
  1. . I 'I S DRCVGST=""
  1. . F I="PRIAUTH","PRAUTHST","DRCVGST" S:@I="" @I=" "
  1. I '$D(^PS(52.49,ERXIEN,311)) S (PRIAUTH,PRAUTHST,DRCVGST)=" "
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="*************************RXCHANGE RESPONSE INFORMATION**************************"
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=RESVAL
  1. S @TMPGBL@(LINE,0)="Response Date/Time: "_RESDTTM
  1. I NOTE]"" D
  1. . K NOTEARY
  1. . D TXT2ARY^PSOERXD1(.NOTEARY,NOTE," ",74)
  1. . S I=0 F S I=$O(NOTEARY(I)) Q:'I D
  1. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(I=1:"Note: ",1:$J("",6))_NOTEARY(I)
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. I RESPVAL="APPROVED" D
  1. . S XLINE=LINE
  1. . S @TMPGBL@(LINE,0)="Prior Authorization: "_PRIAUTH
  1. . S @TMPGBL@(LINE,0)="Prior Authorization Status: "_PRAUTHST
  1. . K NOTEARY D TXT2ARY^PSOERXD1(.NOTEARY,DRCVGST," ",58)
  1. . I $D(NOTEARY) D
  1. . . S I=0 F S I=$O(NOTEARY(I)) Q:'I D
  1. . . . S TXT=$S(I=1:"Drug Coverage Status: ",1:$J("",22))_NOTEARY(I)
  1. . . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=TXT
  1. . I '$D(NOTEARY) S LINE=LINE+1 S @TMPGBL@(LINE,0)="Drug Coverage Status:"
  1. . I LINE>XLINE S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. I RESPVAL="VALIDATED" D
  1. . S XLINE=LINE
  1. . S @TMPGBL@(LINE,0)="ID: "_ID
  1. . S @TMPGBL@(LINE,0)="Date: "_DATE
  1. . I LINE>XLINE S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. S COMM=$$GET1^DIQ(52.49,RESIEN,50,"E")
  1. K COMMARY D TXT2ARY^PSOERXD1(.COMMARY,COMM," ",52)
  1. I $D(COMMARY) D
  1. . S I=0 F S I=$O(COMMARY(I)) Q:'I D
  1. . . S TXT=$S(I=1:"RxChange Response Comments: ",1:$J("",28))_COMMARY(I)
  1. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=TXT
  1. I '$D(COMMARY) D
  1. . S LINE=LINE+1 S @TMPGBL@(LINE,0)="RxChange Response Comments:"
  1. S COMMBY=$$GET1^DIQ(52.49,RESIEN,50.1,"E")
  1. S COMMDTTM=$$GET1^DIQ(52.49,RESIEN,50.2,"E")
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Comments By: "_COMMBY
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Comments Date/Time: "_COMMDTTM
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="" S XLINE=LINE
  1. S I=0 F S I=$O(^PS(52.49,RESIEN,55,I)) Q:'I D
  1. . S ERESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
  1. . S CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
  1. . S RESDESC=$$GET1^DIQ(52.45,CODEIEN,.02,"E")
  1. . S FLG=0
  1. . I RESPVAL="DENIED" S FLG=1
  1. . I FLG D
  1. . . S RESTEXT=RESVAL_" reason code: "_ERESCODE
  1. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=RESTEXT
  1. . . S @TMPGBL@(LINE,0)="Code Description: "_RESDESC
  1. I XLINE<LINE S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. Q
  1. ;
  1. MEDREQDR(TMPGBL,PSOIEN,RULE,LINE) ; Medication Requested section driver
  1. N CNT,F,I,IENS,REQIEN
  1. S CNT=0,REQIEN=$S(RULE?1(1"1058",1"1061",1"0"):$$RESOLV^PSOERXU2(PSOIEN),1:PSOIEN)
  1. S I=0
  1. F S I=$O(^PS(52.49,REQIEN,311,I)) Q:'I D
  1. . S F=52.49311,IENS=I_","_REQIEN_","
  1. . D GETS^DIQ(F,IENS,"**","IE","DDAT")
  1. . I $G(DDAT(F,IENS,.02,"I"))="R" D ; Only requested medications
  1. . . S CNT=CNT+1
  1. . . D MEDREQ(TMPGBL,REQIEN,F,IENS,I,.LINE,CNT)
  1. . K DDAT
  1. Q
  1. ;
  1. MEDREQ(TMPGBL,REQIEN,F,IENS,IEN311,LINE,CNT) ; Medication Request section
  1. N DAYSUP,DRUG,FND,I,LTXT,NOTE,NOTEARY,QTY,QUOM,REFILL,SIG,SUB,TXT,SIGDATA,SIGARY
  1. S DRUG=$G(DDAT(F,IENS,.03,"E"))
  1. S SUB=$G(DDAT(F,IENS,2.7,"I"))
  1. S SUB=$S(SUB=1:"NO",SUB=0:"YES",1:"")
  1. S NOTE=$G(DDAT(F,IENS,5,"E"))
  1. S QTY=$G(DDAT(F,IENS,2.1,"E"))
  1. S REFILL=$G(DDAT(F,IENS,2.8,"E"))
  1. S DAYSUP=$G(DDAT(F,IENS,2.4,"E"))
  1. S QUOM=$G(DDAT(F,IENS,2.3,"I"))
  1. S QUOM=$$GET1^DIQ(52.45,QUOM,.02,"E")
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="****************************MEDICATION REQUESTED "_CNT_"****************************"
  1. K NOTEARY
  1. D TXT2ARY^PSOERXD1(.NOTEARY,DRUG_" "_$P($$ERXDRSCH^PSOERXUT(ERXIEN),"^",2)," ",74)
  1. S I=0 F S I=$O(NOTEARY(I)) Q:'I D
  1. .S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(I=1:"Drug: ",1:$J("",6))_NOTEARY(I)
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Substitutions: "_SUB
  1. D NOTE(TMPGBL,NOTE,"Note: ",1,.LINE)
  1. S LTXT=""
  1. D ADDITEM^PSOERX1A(.LTXT,"Qty: ",QTY,1,22)
  1. D ADDITEM^PSOERX1A(.LTXT,"Refills: ",REFILL,23,21)
  1. D ADDITEM^PSOERX1A(.LTXT,"Days Supply: ",DAYSUP,44,37)
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=LTXT
  1. I QUOM="" D
  1. . S LINE=LINE+1 S @TMPGBL@(LINE,0)="Quantity Unit Of Measure:"
  1. I QUOM]"" D
  1. .K NOTEARY
  1. .D TXT2ARY^PSOERXD1(.NOTEARY,QUOM," ",54)
  1. .S I=0 F S I=$O(NOTEARY(I)) Q:'I D
  1. ..S TXT=$S(I=1:"Quantity Unit Of Measure: ",1:$J("",26))_NOTEARY(I)
  1. ..S LINE=LINE+1 S @TMPGBL@(LINE,0)=TXT
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Sig: "
  1. S SIGDATA=""
  1. S I=0 F S I=$O(^PS(52.49,REQIEN,311,IEN311,8,I)) Q:'I D
  1. . S SIGDATA=SIGDATA_^PS(52.49,REQIEN,311,IEN311,8,I,0)_" "
  1. I $G(SIGDATA)'="" D
  1. . K SIGARY D TXT2ARY^PSOERXD1(.SIGARY,SIGDATA," ",80)
  1. . S I=0 F S I=$O(SIGARY(I)) Q:I="" D
  1. . . I I=1 S @TMPGBL@(LINE,0)=@TMPGBL@(LINE,0)_SIGARY(I) Q
  1. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$J("",5)_SIGARY(I)
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. Q
  1. ;
  1. NOTE(TMPGBL,STR,TITLE,REQUIRED,LINE) ; Print possibly multi-line comment
  1. N I,LEN,NOTEARY
  1. S LEN=$L(TITLE)
  1. D TXT2ARY^PSOERXD1(.NOTEARY,STR," ",80-LEN)
  1. I $D(NOTEARY) D
  1. . S I=0 F S I=$O(NOTEARY(I)) Q:'I D
  1. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(I=1:TITLE,1:$J("",LEN))_NOTEARY(I)
  1. I '$D(NOTEARY) D:REQUIRED
  1. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=TITLE
  1. Q
  1. ;
  1. ; rxchange request information
  1. CXREQ(TMPGBL,ERXIEN,RULE,LINE) ;
  1. N COMM,COMMARY,COMMBY,COMMDTTM,CTXT,I,REQBY,REQDTTM,REQIEN
  1. ; - the next line of code will actually reference the related message of the rxchange request information
  1. ; - check that this is correct and test.
  1. S REQIEN=$S(RULE?1(1"1058",1"1059",1"1060",1"1061",1"1062".E,1"0"):$$RESOLV^PSOERXU2(ERXIEN),1:ERXIEN)
  1. S REQBY=$$GET1^DIQ(52.49,REQIEN,51.1,"E")
  1. S REQDTTM=$$GET1^DIQ(52.49,REQIEN,.03,"E")
  1. S COMM=$$GET1^DIQ(52.49,REQIEN,50,"E")
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="************************RXCHANGE REQUEST INFORMATION**************************"
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Requested By: "_REQBY
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Request Date/Time: "_REQDTTM
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. K COMMARY D TXT2ARY^PSOERXD1(.COMMARY,COMM," ",53)
  1. I $D(COMMARY) D
  1. . S I=0 F S I=$O(COMMARY(I)) Q:'I D
  1. . .S CTXT=$S(I=1:"RxChange Request Comments: ",1:$J("",27))_COMMARY(I)
  1. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=CTXT
  1. I '$D(COMMARY) D
  1. . S LINE=LINE+1 S @TMPGBL@(LINE,0)="RxChange Request Comments:"
  1. S COMMBY=$$GET1^DIQ(52.49,REQIEN,50.1,"E")
  1. S COMMDTTM=$$GET1^DIQ(52.49,REQIEN,50.2,"E")
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Comments By: "_COMMBY
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Comments Date/Time: "_COMMDTTM
  1. Q
  1. ;
  1. MSGHIS(TMPGBL,ERXIEN,LINE) ;
  1. N FLAG
  1. S FLAG=+$G(FLAG)
  1. N ERXREF,RELERX,ERXRES,I,ERXHID,FOUND,REQID,RESID,MTYPE
  1. S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
  1. I ",CR,"[(","_MTYPE_",") S REQIEN=ERXIEN,RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
  1. I ",CX,"[(","_MTYPE_",") S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
  1. I MTYPE="IE" S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
  1. S RESID=$$GET1^DIQ(52.49,RESIEN,.01,"E")
  1. S REQID=$$GET1^DIQ(52.49,REQIEN,.01,"E")
  1. S RELERX=$$GET1^DIQ(52.49,REQIEN,.14)
  1. S FOUND=0
  1. S I=ERXIEN F S I=$O(^PS(52.49,ERXIEN,201,"B",I)) Q:'I!(FOUND) D
  1. .I $$GET1^DIQ(52.49,I,.08,"E")="RE",$$GET1^DIQ(52.49,I,.14,"E")=$$GET1^DIQ(52.49,ERXIEN,.01,"E") S ERXRES=$$GET1^DIQ(52.49,I,.14,"E"),FOUND=1
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="*****************************MESSAGE HISTORY********************************"
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Request Reference #: "_$G(REQID)
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="New eRx Reference #: "_RELERX
  1. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Response eRx Reference #: "_$G(RESID)
  1. Q
  1. QTSUMDT2(TMPGBL,PSOIEN,MTYPE,CHGMESRI,RESPVAL,LINE) ; Quit Summary Detail later?
  1. N FLG,RULE
  1. D
  1. . S FLG=0
  1. . I MTYPE="CX",RESPVAL?1"APPROVED".1" WITH CHANGES",",G,T,S,OS,D,"[(","_CHGMESRI_",") D Q
  1. . . S FLG=1,RULE=0
  1. . S RULE=$$GETRULES^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
  1. . S FLG=RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056")
  1. I FLG D RESTSMDT(TMPGBL,0,PSOIEN,RESPVAL,RULE,.LINE)
  1. Q FLG
  1. ;