PSOERSE5 ;ALB/RM - PSO eRx UTILITIES ;Feb 12, 2024@12:43:34
;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
;
;
Q ;No Direct Call
;
QTSUMDT1(TMPGBL,PSOIEN,MTYPE,CHGMESRI,CHGMESRQ,RESPVAL,LINE) ; Quit Summary Detail early?
N FLG,NO311,RULE
D
. S FLG=0
. I MTYPE="CX",RESPVAL?1"APPROVED".1" WITH CHANGES",",G,T,S,OS,D,"[(","_CHGMESRI_",") D Q
. . S FLG=1,RULE=0
. S RULE=$$GETRULES^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
. S FLG=(RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056"))
I FLG S FLG=$$SETMRC(TMPGBL,PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,.LINE)
Q FLG
;
SETMRC(TMPGBL,PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,LINE) ; Set values for MRC variables
N CHGMESRE,CHMSSUB,I,IENS,NO311,NOTEARY,RET,X,REATXT
S CHGMESRE=$$GET1^DIQ(52.45,CHGMESRQ,.02,"I")
S @TMPGBL@(LINE,0)="Change Request Type: "_CHGMESRE
I (CHGMESRI="U")!(CHGMESRI="D") D
. S IENS=$O(^PS(52.49,PSOIEN,316,0))
. I IENS D
. . S IENS=IENS_","_PSOIEN_","
. . S CHMSSUB=$$GET1^DIQ(52.49316,IENS,1,"I")
. . S CHMSSUB=$$GET1^DIQ(52.45,CHMSSUB,.02,"E")
. I 'IENS S CHMSSUB=""
. K NOTEARY
. D TXT2ARY^PSOERXD1(.NOTEARY,CHMSSUB," ",55)
. I $D(NOTEARY) D
. . S I=0
. . F S I=$O(NOTEARY(I)) Q:'I D
. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(I=1:"Change Request Sub Type: ",1:$J("",25))_NOTEARY(I)
. I '$D(NOTEARY) D
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)="Change Request Sub Type: "
;
S X=$$GET1^DIQ(52.49,PSOIEN,317,,"REATXT")
I $G(REATXT(1))'="" D
. S X=REATXT(1) K RET D TXT2ARY^PSOERXD1(.RET,X," ",80)
. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Change Request Reason Text: "
. S I=0 F S I=$O(RET(I)) Q:I="" S LINE=LINE+1 S @TMPGBL@(LINE,0)=RET(I)
I RULE?1(1"1058",1"1059",1"1060") S NO311='$D(^PS(52.49,PSOIEN,311))
I RULE'?1(1"1058",1"1059",1"1060") S NO311=0
I $G(NO311) D RESTSMDT(TMPGBL,1,PSOIEN,RESPVAL,RULE,.LINE)
Q $G(NO311)
;
RESTSMDT(TMPGBL,SMALLMP,PSOIEN,RESPVAL,RULE,LINE) ; Print rest of Summary/Details screen for CXD - G/T/S/OS/D
N CHGMESRQ,FLG,STATUS
I SMALLMP D MEDPRES(TMPGBL,PSOIEN,.LINE)
I 'SMALLMP D:((RESPVAL="VALIDATED")&($$GET1^DIQ(52.49,PSOIEN,.08,"I")="CX"))
. D DISPRX^PSOERSE4
S CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
D CXRES(TMPGBL,PSOIEN,RESPVAL,RULE,"1058,1059,1060,0",.LINE)
D MEDREQDR(TMPGBL,PSOIEN,RULE,.LINE)
D CXREQ(TMPGBL,PSOIEN,RULE,.LINE)
D MSGHIS(TMPGBL,PSOIEN,.LINE)
Q
;
MEDPRES(TMPGBL,PSOIEN,LINE) ; Medication Prescribed
I @TMPGBL@(LINE,0)'="" S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
S LINE=LINE+1 S @TMPGBL@(LINE,0)="**************************MEDICATION PRESCRIBED******************************"
S LINE=LINE+1 S @TMPGBL@(LINE,0)="No Medication information available on the Response."
Q
;
CXRES(TMPGBL,ERXIEN,RESPVAL,RULE,RULES,LINE) ;
N CODEIEN,COMM,COMMARY,COMMBY,COMMDTTM,DATE,DELTA,DRCVGST,ERESCODE,ERXDAT,FLG,FN,I
N ID,IENS,IENS2,J,MIEN,MTYPE,NOTE,NOTEARY,PRIAUTH,PRAUTHST,RECODE,REQIEN,RESCODE
N RESDESC,RESDTTM,RESIEN,RESTEXT,RESVAL,SFIEN,STATUS,STR1,STR1ARY,STR2,STR2ARY
N TXT,XLINE
I (","_RULES_",")[(","_$E(RULE,1,4)_",") D
.S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
.S FLG=1
I (","_RULES_",")'[(","_$E(RULE,1,4)_",") D
.S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
.I MTYPE="CR" D Q
..S RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
..I RESIEN D Q
...S REQIEN=ERXIEN
...S FLG=1
..S FLG=0
.S FLG=0
Q:'FLG
S IENS=RESIEN_","
D GETS^DIQ(52.49,RESIEN,".03;50;50.1;50.2;52.1;52.2;319.5;324","IE","ERXDAT")
S RESDTTM=$G(ERXDAT(52.49,IENS,.03,"E"))
S RESVAL=$G(ERXDAT(52.49,IENS,52.1,"E"))
S RESCODE=$G(ERXDAT(52.49,IENS,52.1,"I"))
S NOTE=$G(ERXDAT(52.49,IENS,52.2,"E"))
S ID=$G(ERXDAT(52.49,IENS,319.5,"E"))
S DATE=$G(ERXDAT(52.49,IENS,324,"I"))
I $D(^PS(52.49,ERXIEN,311)) D
. S SFIEN=$O(^PS(52.49,ERXIEN,311,"C","P",0))
. Q:'SFIEN
. S IENS2=SFIEN_","_IENS
. D GETS^DIQ(52.49311,IENS2,"4.1;4.2;5","IE","ERXDAT")
. S PRIAUTH=$G(ERXDAT(52.49311,IENS2,4.1,"E"))
. S PRAUTHST=$G(ERXDAT(52.49311,IENS2,4.2,"E"))
. S I=$O(^PS(52.49,RESIEN,311,SFIEN,7,0))
. I I D
. . S DRCVGST=$$GET1^DIQ(52.493117,I_","_IENS2,.02,"I")
. . S DRCVGST=$$GET1^DIQ(52.45,DRCVGST,.02,"E")
. I 'I S DRCVGST=""
. F I="PRIAUTH","PRAUTHST","DRCVGST" S:@I="" @I=" "
I '$D(^PS(52.49,ERXIEN,311)) S (PRIAUTH,PRAUTHST,DRCVGST)=" "
S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
S LINE=LINE+1 S @TMPGBL@(LINE,0)="*************************RXCHANGE RESPONSE INFORMATION**************************"
S LINE=LINE+1 S @TMPGBL@(LINE,0)=RESVAL
S @TMPGBL@(LINE,0)="Response Date/Time: "_RESDTTM
I NOTE]"" D
. K NOTEARY
. D TXT2ARY^PSOERXD1(.NOTEARY,NOTE," ",74)
. S I=0 F S I=$O(NOTEARY(I)) Q:'I D
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(I=1:"Note: ",1:$J("",6))_NOTEARY(I)
S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
I RESPVAL="APPROVED" D
. S XLINE=LINE
. S @TMPGBL@(LINE,0)="Prior Authorization: "_PRIAUTH
. S @TMPGBL@(LINE,0)="Prior Authorization Status: "_PRAUTHST
. K NOTEARY D TXT2ARY^PSOERXD1(.NOTEARY,DRCVGST," ",58)
. I $D(NOTEARY) D
. . S I=0 F S I=$O(NOTEARY(I)) Q:'I D
. . . S TXT=$S(I=1:"Drug Coverage Status: ",1:$J("",22))_NOTEARY(I)
. . . S LINE=LINE+1 S @TMPGBL@(LINE,0)=TXT
. I '$D(NOTEARY) S LINE=LINE+1 S @TMPGBL@(LINE,0)="Drug Coverage Status:"
. I LINE>XLINE S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
I RESPVAL="VALIDATED" D
. S XLINE=LINE
. S @TMPGBL@(LINE,0)="ID: "_ID
. S @TMPGBL@(LINE,0)="Date: "_DATE
. I LINE>XLINE S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
S COMM=$$GET1^DIQ(52.49,RESIEN,50,"E")
K COMMARY D TXT2ARY^PSOERXD1(.COMMARY,COMM," ",52)
I $D(COMMARY) D
. S I=0 F S I=$O(COMMARY(I)) Q:'I D
. . S TXT=$S(I=1:"RxChange Response Comments: ",1:$J("",28))_COMMARY(I)
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=TXT
I '$D(COMMARY) D
. S LINE=LINE+1 S @TMPGBL@(LINE,0)="RxChange Response Comments:"
S COMMBY=$$GET1^DIQ(52.49,RESIEN,50.1,"E")
S COMMDTTM=$$GET1^DIQ(52.49,RESIEN,50.2,"E")
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Comments By: "_COMMBY
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Comments Date/Time: "_COMMDTTM
S LINE=LINE+1 S @TMPGBL@(LINE,0)="" S XLINE=LINE
S I=0 F S I=$O(^PS(52.49,RESIEN,55,I)) Q:'I D
. S ERESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
. S CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
. S RESDESC=$$GET1^DIQ(52.45,CODEIEN,.02,"E")
. S FLG=0
. I RESPVAL="DENIED" S FLG=1
. I FLG D
. . S RESTEXT=RESVAL_" reason code: "_ERESCODE
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=RESTEXT
. . S @TMPGBL@(LINE,0)="Code Description: "_RESDESC
I XLINE<LINE S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
Q
;
MEDREQDR(TMPGBL,PSOIEN,RULE,LINE) ; Medication Requested section driver
N CNT,F,I,IENS,REQIEN
S CNT=0,REQIEN=$S(RULE?1(1"1058",1"1061",1"0"):$$RESOLV^PSOERXU2(PSOIEN),1:PSOIEN)
S I=0
F S I=$O(^PS(52.49,REQIEN,311,I)) Q:'I D
. S F=52.49311,IENS=I_","_REQIEN_","
. D GETS^DIQ(F,IENS,"**","IE","DDAT")
. I $G(DDAT(F,IENS,.02,"I"))="R" D ; Only requested medications
. . S CNT=CNT+1
. . D MEDREQ(TMPGBL,REQIEN,F,IENS,I,.LINE,CNT)
. K DDAT
Q
;
MEDREQ(TMPGBL,REQIEN,F,IENS,IEN311,LINE,CNT) ; Medication Request section
N DAYSUP,DRUG,FND,I,LTXT,NOTE,NOTEARY,QTY,QUOM,REFILL,SIG,SUB,TXT,SIGDATA,SIGARY
S DRUG=$G(DDAT(F,IENS,.03,"E"))
S SUB=$G(DDAT(F,IENS,2.7,"I"))
S SUB=$S(SUB=1:"NO",SUB=0:"YES",1:"")
S NOTE=$G(DDAT(F,IENS,5,"E"))
S QTY=$G(DDAT(F,IENS,2.1,"E"))
S REFILL=$G(DDAT(F,IENS,2.8,"E"))
S DAYSUP=$G(DDAT(F,IENS,2.4,"E"))
S QUOM=$G(DDAT(F,IENS,2.3,"I"))
S QUOM=$$GET1^DIQ(52.45,QUOM,.02,"E")
S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
S LINE=LINE+1 S @TMPGBL@(LINE,0)="****************************MEDICATION REQUESTED "_CNT_"****************************"
K NOTEARY
D TXT2ARY^PSOERXD1(.NOTEARY,DRUG_" "_$P($$ERXDRSCH^PSOERXUT(ERXIEN),"^",2)," ",74)
S I=0 F S I=$O(NOTEARY(I)) Q:'I D
.S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(I=1:"Drug: ",1:$J("",6))_NOTEARY(I)
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Substitutions: "_SUB
D NOTE(TMPGBL,NOTE,"Note: ",1,.LINE)
S LTXT=""
D ADDITEM^PSOERX1A(.LTXT,"Qty: ",QTY,1,22)
D ADDITEM^PSOERX1A(.LTXT,"Refills: ",REFILL,23,21)
D ADDITEM^PSOERX1A(.LTXT,"Days Supply: ",DAYSUP,44,37)
S LINE=LINE+1 S @TMPGBL@(LINE,0)=LTXT
I QUOM="" D
. S LINE=LINE+1 S @TMPGBL@(LINE,0)="Quantity Unit Of Measure:"
I QUOM]"" D
.K NOTEARY
.D TXT2ARY^PSOERXD1(.NOTEARY,QUOM," ",54)
.S I=0 F S I=$O(NOTEARY(I)) Q:'I D
..S TXT=$S(I=1:"Quantity Unit Of Measure: ",1:$J("",26))_NOTEARY(I)
..S LINE=LINE+1 S @TMPGBL@(LINE,0)=TXT
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Sig: "
S SIGDATA=""
S I=0 F S I=$O(^PS(52.49,REQIEN,311,IEN311,8,I)) Q:'I D
. S SIGDATA=SIGDATA_^PS(52.49,REQIEN,311,IEN311,8,I,0)_" "
I $G(SIGDATA)'="" D
. K SIGARY D TXT2ARY^PSOERXD1(.SIGARY,SIGDATA," ",80)
. S I=0 F S I=$O(SIGARY(I)) Q:I="" D
. . I I=1 S @TMPGBL@(LINE,0)=@TMPGBL@(LINE,0)_SIGARY(I) Q
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$J("",5)_SIGARY(I)
S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
Q
;
NOTE(TMPGBL,STR,TITLE,REQUIRED,LINE) ; Print possibly multi-line comment
N I,LEN,NOTEARY
S LEN=$L(TITLE)
D TXT2ARY^PSOERXD1(.NOTEARY,STR," ",80-LEN)
I $D(NOTEARY) D
. S I=0 F S I=$O(NOTEARY(I)) Q:'I D
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=$S(I=1:TITLE,1:$J("",LEN))_NOTEARY(I)
I '$D(NOTEARY) D:REQUIRED
. S LINE=LINE+1 S @TMPGBL@(LINE,0)=TITLE
Q
;
; rxchange request information
CXREQ(TMPGBL,ERXIEN,RULE,LINE) ;
N COMM,COMMARY,COMMBY,COMMDTTM,CTXT,I,REQBY,REQDTTM,REQIEN
; - the next line of code will actually reference the related message of the rxchange request information
; - check that this is correct and test.
S REQIEN=$S(RULE?1(1"1058",1"1059",1"1060",1"1061",1"1062".E,1"0"):$$RESOLV^PSOERXU2(ERXIEN),1:ERXIEN)
S REQBY=$$GET1^DIQ(52.49,REQIEN,51.1,"E")
S REQDTTM=$$GET1^DIQ(52.49,REQIEN,.03,"E")
S COMM=$$GET1^DIQ(52.49,REQIEN,50,"E")
S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
S LINE=LINE+1 S @TMPGBL@(LINE,0)="************************RXCHANGE REQUEST INFORMATION**************************"
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Requested By: "_REQBY
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Request Date/Time: "_REQDTTM
S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
K COMMARY D TXT2ARY^PSOERXD1(.COMMARY,COMM," ",53)
I $D(COMMARY) D
. S I=0 F S I=$O(COMMARY(I)) Q:'I D
. .S CTXT=$S(I=1:"RxChange Request Comments: ",1:$J("",27))_COMMARY(I)
. . S LINE=LINE+1 S @TMPGBL@(LINE,0)=CTXT
I '$D(COMMARY) D
. S LINE=LINE+1 S @TMPGBL@(LINE,0)="RxChange Request Comments:"
S COMMBY=$$GET1^DIQ(52.49,REQIEN,50.1,"E")
S COMMDTTM=$$GET1^DIQ(52.49,REQIEN,50.2,"E")
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Comments By: "_COMMBY
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Comments Date/Time: "_COMMDTTM
Q
;
MSGHIS(TMPGBL,ERXIEN,LINE) ;
N FLAG
S FLAG=+$G(FLAG)
N ERXREF,RELERX,ERXRES,I,ERXHID,FOUND,REQID,RESID,MTYPE
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
I ",CR,"[(","_MTYPE_",") S REQIEN=ERXIEN,RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
I ",CX,"[(","_MTYPE_",") S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
I MTYPE="IE" S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
S RESID=$$GET1^DIQ(52.49,RESIEN,.01,"E")
S REQID=$$GET1^DIQ(52.49,REQIEN,.01,"E")
S RELERX=$$GET1^DIQ(52.49,REQIEN,.14)
S FOUND=0
S I=ERXIEN F S I=$O(^PS(52.49,ERXIEN,201,"B",I)) Q:'I!(FOUND) D
.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
S LINE=LINE+1 S @TMPGBL@(LINE,0)=""
S LINE=LINE+1 S @TMPGBL@(LINE,0)="*****************************MESSAGE HISTORY********************************"
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Request Reference #: "_$G(REQID)
S LINE=LINE+1 S @TMPGBL@(LINE,0)="New eRx Reference #: "_RELERX
S LINE=LINE+1 S @TMPGBL@(LINE,0)="Response eRx Reference #: "_$G(RESID)
Q
QTSUMDT2(TMPGBL,PSOIEN,MTYPE,CHGMESRI,RESPVAL,LINE) ; Quit Summary Detail later?
N FLG,RULE
D
. S FLG=0
. I MTYPE="CX",RESPVAL?1"APPROVED".1" WITH CHANGES",",G,T,S,OS,D,"[(","_CHGMESRI_",") D Q
. . S FLG=1,RULE=0
. S RULE=$$GETRULES^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
. S FLG=RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056")
I FLG D RESTSMDT(TMPGBL,0,PSOIEN,RESPVAL,RULE,.LINE)
Q FLG
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERSE5 12181 printed Dec 13, 2024@02:27:59 Page 2
PSOERSE5 ;ALB/RM - PSO eRx UTILITIES ;Feb 12, 2024@12:43:34
+1 ;;7.0;OUTPATIENT PHARMACY;**746**;DEC 16, 1997;Build 106
+2 ;
+3 ;
+4 ;No Direct Call
QUIT
+5 ;
QTSUMDT1(TMPGBL,PSOIEN,MTYPE,CHGMESRI,CHGMESRQ,RESPVAL,LINE) ; Quit Summary Detail early?
+1 NEW FLG,NO311,RULE
+2 Begin DoDot:1
+3 SET FLG=0
+4 IF MTYPE="CX"
IF RESPVAL?1"APPROVED".1" WITH CHANGES"
IF ",G,T,S,OS,D,"[(","_CHGMESRI_",")
Begin DoDot:2
+5 SET FLG=1
SET RULE=0
End DoDot:2
QUIT
+6 SET RULE=$$GETRULES^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
+7 SET FLG=(RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056"))
End DoDot:1
+8 IF FLG
SET FLG=$$SETMRC(TMPGBL,PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,.LINE)
+9 QUIT FLG
+10 ;
SETMRC(TMPGBL,PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,LINE) ; Set values for MRC variables
+1 NEW CHGMESRE,CHMSSUB,I,IENS,NO311,NOTEARY,RET,X,REATXT
+2 SET CHGMESRE=$$GET1^DIQ(52.45,CHGMESRQ,.02,"I")
+3 SET @TMPGBL@(LINE,0)="Change Request Type: "_CHGMESRE
+4 IF (CHGMESRI="U")!(CHGMESRI="D")
Begin DoDot:1
+5 SET IENS=$ORDER(^PS(52.49,PSOIEN,316,0))
+6 IF IENS
Begin DoDot:2
+7 SET IENS=IENS_","_PSOIEN_","
+8 SET CHMSSUB=$$GET1^DIQ(52.49316,IENS,1,"I")
+9 SET CHMSSUB=$$GET1^DIQ(52.45,CHMSSUB,.02,"E")
End DoDot:2
+10 IF 'IENS
SET CHMSSUB=""
+11 KILL NOTEARY
+12 DO TXT2ARY^PSOERXD1(.NOTEARY,CHMSSUB," ",55)
+13 IF $DATA(NOTEARY)
Begin DoDot:2
+14 SET I=0
+15 FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:3
+16 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=$SELECT(I=1:"Change Request Sub Type: ",1:$JUSTIFY("",25))_NOTEARY(I)
End DoDot:3
End DoDot:2
+17 IF '$DATA(NOTEARY)
Begin DoDot:2
+18 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Change Request Sub Type: "
End DoDot:2
End DoDot:1
+19 ;
+20 SET X=$$GET1^DIQ(52.49,PSOIEN,317,,"REATXT")
+21 IF $GET(REATXT(1))'=""
Begin DoDot:1
+22 SET X=REATXT(1)
KILL RET
DO TXT2ARY^PSOERXD1(.RET,X," ",80)
+23 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Change Request Reason Text: "
+24 SET I=0
FOR
SET I=$ORDER(RET(I))
if I=""
QUIT
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=RET(I)
End DoDot:1
+25 IF RULE?1(1"1058",1"1059",1"1060")
SET NO311='$DATA(^PS(52.49,PSOIEN,311))
+26 IF RULE'?1(1"1058",1"1059",1"1060")
SET NO311=0
+27 IF $GET(NO311)
DO RESTSMDT(TMPGBL,1,PSOIEN,RESPVAL,RULE,.LINE)
+28 QUIT $GET(NO311)
+29 ;
RESTSMDT(TMPGBL,SMALLMP,PSOIEN,RESPVAL,RULE,LINE) ; Print rest of Summary/Details screen for CXD - G/T/S/OS/D
+1 NEW CHGMESRQ,FLG,STATUS
+2 IF SMALLMP
DO MEDPRES(TMPGBL,PSOIEN,.LINE)
+3 IF 'SMALLMP
if ((RESPVAL="VALIDATED")&($$GET1^DIQ(52.49,PSOIEN,.08,"I")="CX"))
Begin DoDot:1
+4 DO DISPRX^PSOERSE4
End DoDot:1
+5 SET CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
+6 DO CXRES(TMPGBL,PSOIEN,RESPVAL,RULE,"1058,1059,1060,0",.LINE)
+7 DO MEDREQDR(TMPGBL,PSOIEN,RULE,.LINE)
+8 DO CXREQ(TMPGBL,PSOIEN,RULE,.LINE)
+9 DO MSGHIS(TMPGBL,PSOIEN,.LINE)
+10 QUIT
+11 ;
MEDPRES(TMPGBL,PSOIEN,LINE) ; Medication Prescribed
+1 IF @TMPGBL@(LINE,0)'=""
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+2 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="**************************MEDICATION PRESCRIBED******************************"
+3 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="No Medication information available on the Response."
+4 QUIT
+5 ;
CXRES(TMPGBL,ERXIEN,RESPVAL,RULE,RULES,LINE) ;
+1 NEW CODEIEN,COMM,COMMARY,COMMBY,COMMDTTM,DATE,DELTA,DRCVGST,ERESCODE,ERXDAT,FLG,FN,I
+2 NEW ID,IENS,IENS2,J,MIEN,MTYPE,NOTE,NOTEARY,PRIAUTH,PRAUTHST,RECODE,REQIEN,RESCODE
+3 NEW RESDESC,RESDTTM,RESIEN,RESTEXT,RESVAL,SFIEN,STATUS,STR1,STR1ARY,STR2,STR2ARY
+4 NEW TXT,XLINE
+5 IF (","_RULES_",")[(","_$EXTRACT(RULE,1,4)_",")
Begin DoDot:1
+6 SET RESIEN=ERXIEN
SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
+7 SET FLG=1
End DoDot:1
+8 IF (","_RULES_",")'[(","_$EXTRACT(RULE,1,4)_",")
Begin DoDot:1
+9 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+10 IF MTYPE="CR"
Begin DoDot:2
+11 SET RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
+12 IF RESIEN
Begin DoDot:3
+13 SET REQIEN=ERXIEN
+14 SET FLG=1
End DoDot:3
QUIT
+15 SET FLG=0
End DoDot:2
QUIT
+16 SET FLG=0
End DoDot:1
+17 if 'FLG
QUIT
+18 SET IENS=RESIEN_","
+19 DO GETS^DIQ(52.49,RESIEN,".03;50;50.1;50.2;52.1;52.2;319.5;324","IE","ERXDAT")
+20 SET RESDTTM=$GET(ERXDAT(52.49,IENS,.03,"E"))
+21 SET RESVAL=$GET(ERXDAT(52.49,IENS,52.1,"E"))
+22 SET RESCODE=$GET(ERXDAT(52.49,IENS,52.1,"I"))
+23 SET NOTE=$GET(ERXDAT(52.49,IENS,52.2,"E"))
+24 SET ID=$GET(ERXDAT(52.49,IENS,319.5,"E"))
+25 SET DATE=$GET(ERXDAT(52.49,IENS,324,"I"))
+26 IF $DATA(^PS(52.49,ERXIEN,311))
Begin DoDot:1
+27 SET SFIEN=$ORDER(^PS(52.49,ERXIEN,311,"C","P",0))
+28 if 'SFIEN
QUIT
+29 SET IENS2=SFIEN_","_IENS
+30 DO GETS^DIQ(52.49311,IENS2,"4.1;4.2;5","IE","ERXDAT")
+31 SET PRIAUTH=$GET(ERXDAT(52.49311,IENS2,4.1,"E"))
+32 SET PRAUTHST=$GET(ERXDAT(52.49311,IENS2,4.2,"E"))
+33 SET I=$ORDER(^PS(52.49,RESIEN,311,SFIEN,7,0))
+34 IF I
Begin DoDot:2
+35 SET DRCVGST=$$GET1^DIQ(52.493117,I_","_IENS2,.02,"I")
+36 SET DRCVGST=$$GET1^DIQ(52.45,DRCVGST,.02,"E")
End DoDot:2
+37 IF 'I
SET DRCVGST=""
+38 FOR I="PRIAUTH","PRAUTHST","DRCVGST"
if @I=""
SET @I=" "
End DoDot:1
+39 IF '$DATA(^PS(52.49,ERXIEN,311))
SET (PRIAUTH,PRAUTHST,DRCVGST)=" "
+40 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+41 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="*************************RXCHANGE RESPONSE INFORMATION**************************"
+42 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=RESVAL
+43 SET @TMPGBL@(LINE,0)="Response Date/Time: "_RESDTTM
+44 IF NOTE]""
Begin DoDot:1
+45 KILL NOTEARY
+46 DO TXT2ARY^PSOERXD1(.NOTEARY,NOTE," ",74)
+47 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:2
+48 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=$SELECT(I=1:"Note: ",1:$JUSTIFY("",6))_NOTEARY(I)
End DoDot:2
End DoDot:1
+49 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+50 IF RESPVAL="APPROVED"
Begin DoDot:1
+51 SET XLINE=LINE
+52 SET @TMPGBL@(LINE,0)="Prior Authorization: "_PRIAUTH
+53 SET @TMPGBL@(LINE,0)="Prior Authorization Status: "_PRAUTHST
+54 KILL NOTEARY
DO TXT2ARY^PSOERXD1(.NOTEARY,DRCVGST," ",58)
+55 IF $DATA(NOTEARY)
Begin DoDot:2
+56 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:3
+57 SET TXT=$SELECT(I=1:"Drug Coverage Status: ",1:$JUSTIFY("",22))_NOTEARY(I)
+58 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=TXT
End DoDot:3
End DoDot:2
+59 IF '$DATA(NOTEARY)
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Drug Coverage Status:"
+60 IF LINE>XLINE
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
End DoDot:1
+61 IF RESPVAL="VALIDATED"
Begin DoDot:1
+62 SET XLINE=LINE
+63 SET @TMPGBL@(LINE,0)="ID: "_ID
+64 SET @TMPGBL@(LINE,0)="Date: "_DATE
+65 IF LINE>XLINE
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
End DoDot:1
+66 SET COMM=$$GET1^DIQ(52.49,RESIEN,50,"E")
+67 KILL COMMARY
DO TXT2ARY^PSOERXD1(.COMMARY,COMM," ",52)
+68 IF $DATA(COMMARY)
Begin DoDot:1
+69 SET I=0
FOR
SET I=$ORDER(COMMARY(I))
if 'I
QUIT
Begin DoDot:2
+70 SET TXT=$SELECT(I=1:"RxChange Response Comments: ",1:$JUSTIFY("",28))_COMMARY(I)
+71 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=TXT
End DoDot:2
End DoDot:1
+72 IF '$DATA(COMMARY)
Begin DoDot:1
+73 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="RxChange Response Comments:"
End DoDot:1
+74 SET COMMBY=$$GET1^DIQ(52.49,RESIEN,50.1,"E")
+75 SET COMMDTTM=$$GET1^DIQ(52.49,RESIEN,50.2,"E")
+76 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Comments By: "_COMMBY
+77 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Comments Date/Time: "_COMMDTTM
+78 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
SET XLINE=LINE
+79 SET I=0
FOR
SET I=$ORDER(^PS(52.49,RESIEN,55,I))
if 'I
QUIT
Begin DoDot:1
+80 SET ERESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
+81 SET CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
+82 SET RESDESC=$$GET1^DIQ(52.45,CODEIEN,.02,"E")
+83 SET FLG=0
+84 IF RESPVAL="DENIED"
SET FLG=1
+85 IF FLG
Begin DoDot:2
+86 SET RESTEXT=RESVAL_" reason code: "_ERESCODE
+87 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=RESTEXT
+88 SET @TMPGBL@(LINE,0)="Code Description: "_RESDESC
End DoDot:2
End DoDot:1
+89 IF XLINE<LINE
SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+90 QUIT
+91 ;
MEDREQDR(TMPGBL,PSOIEN,RULE,LINE) ; Medication Requested section driver
+1 NEW CNT,F,I,IENS,REQIEN
+2 SET CNT=0
SET REQIEN=$SELECT(RULE?1(1"1058",1"1061",1"0"):$$RESOLV^PSOERXU2(PSOIEN),1:PSOIEN)
+3 SET I=0
+4 FOR
SET I=$ORDER(^PS(52.49,REQIEN,311,I))
if 'I
QUIT
Begin DoDot:1
+5 SET F=52.49311
SET IENS=I_","_REQIEN_","
+6 DO GETS^DIQ(F,IENS,"**","IE","DDAT")
+7 ; Only requested medications
IF $GET(DDAT(F,IENS,.02,"I"))="R"
Begin DoDot:2
+8 SET CNT=CNT+1
+9 DO MEDREQ(TMPGBL,REQIEN,F,IENS,I,.LINE,CNT)
End DoDot:2
+10 KILL DDAT
End DoDot:1
+11 QUIT
+12 ;
MEDREQ(TMPGBL,REQIEN,F,IENS,IEN311,LINE,CNT) ; Medication Request section
+1 NEW DAYSUP,DRUG,FND,I,LTXT,NOTE,NOTEARY,QTY,QUOM,REFILL,SIG,SUB,TXT,SIGDATA,SIGARY
+2 SET DRUG=$GET(DDAT(F,IENS,.03,"E"))
+3 SET SUB=$GET(DDAT(F,IENS,2.7,"I"))
+4 SET SUB=$SELECT(SUB=1:"NO",SUB=0:"YES",1:"")
+5 SET NOTE=$GET(DDAT(F,IENS,5,"E"))
+6 SET QTY=$GET(DDAT(F,IENS,2.1,"E"))
+7 SET REFILL=$GET(DDAT(F,IENS,2.8,"E"))
+8 SET DAYSUP=$GET(DDAT(F,IENS,2.4,"E"))
+9 SET QUOM=$GET(DDAT(F,IENS,2.3,"I"))
+10 SET QUOM=$$GET1^DIQ(52.45,QUOM,.02,"E")
+11 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+12 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="****************************MEDICATION REQUESTED "_CNT_"****************************"
+13 KILL NOTEARY
+14 DO TXT2ARY^PSOERXD1(.NOTEARY,DRUG_" "_$PIECE($$ERXDRSCH^PSOERXUT(ERXIEN),"^",2)," ",74)
+15 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:1
+16 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=$SELECT(I=1:"Drug: ",1:$JUSTIFY("",6))_NOTEARY(I)
End DoDot:1
+17 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Substitutions: "_SUB
+18 DO NOTE(TMPGBL,NOTE,"Note: ",1,.LINE)
+19 SET LTXT=""
+20 DO ADDITEM^PSOERX1A(.LTXT,"Qty: ",QTY,1,22)
+21 DO ADDITEM^PSOERX1A(.LTXT,"Refills: ",REFILL,23,21)
+22 DO ADDITEM^PSOERX1A(.LTXT,"Days Supply: ",DAYSUP,44,37)
+23 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=LTXT
+24 IF QUOM=""
Begin DoDot:1
+25 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Quantity Unit Of Measure:"
End DoDot:1
+26 IF QUOM]""
Begin DoDot:1
+27 KILL NOTEARY
+28 DO TXT2ARY^PSOERXD1(.NOTEARY,QUOM," ",54)
+29 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:2
+30 SET TXT=$SELECT(I=1:"Quantity Unit Of Measure: ",1:$JUSTIFY("",26))_NOTEARY(I)
+31 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=TXT
End DoDot:2
End DoDot:1
+32 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Sig: "
+33 SET SIGDATA=""
+34 SET I=0
FOR
SET I=$ORDER(^PS(52.49,REQIEN,311,IEN311,8,I))
if 'I
QUIT
Begin DoDot:1
+35 SET SIGDATA=SIGDATA_^PS(52.49,REQIEN,311,IEN311,8,I,0)_" "
End DoDot:1
+36 IF $GET(SIGDATA)'=""
Begin DoDot:1
+37 KILL SIGARY
DO TXT2ARY^PSOERXD1(.SIGARY,SIGDATA," ",80)
+38 SET I=0
FOR
SET I=$ORDER(SIGARY(I))
if I=""
QUIT
Begin DoDot:2
+39 IF I=1
SET @TMPGBL@(LINE,0)=@TMPGBL@(LINE,0)_SIGARY(I)
QUIT
+40 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=$JUSTIFY("",5)_SIGARY(I)
End DoDot:2
End DoDot:1
+41 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+42 QUIT
+43 ;
NOTE(TMPGBL,STR,TITLE,REQUIRED,LINE) ; Print possibly multi-line comment
+1 NEW I,LEN,NOTEARY
+2 SET LEN=$LENGTH(TITLE)
+3 DO TXT2ARY^PSOERXD1(.NOTEARY,STR," ",80-LEN)
+4 IF $DATA(NOTEARY)
Begin DoDot:1
+5 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:2
+6 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=$SELECT(I=1:TITLE,1:$JUSTIFY("",LEN))_NOTEARY(I)
End DoDot:2
End DoDot:1
+7 IF '$DATA(NOTEARY)
if REQUIRED
Begin DoDot:1
+8 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=TITLE
End DoDot:1
+9 QUIT
+10 ;
+11 ; rxchange request information
CXREQ(TMPGBL,ERXIEN,RULE,LINE) ;
+1 NEW COMM,COMMARY,COMMBY,COMMDTTM,CTXT,I,REQBY,REQDTTM,REQIEN
+2 ; - the next line of code will actually reference the related message of the rxchange request information
+3 ; - check that this is correct and test.
+4 SET REQIEN=$SELECT(RULE?1(1"1058",1"1059",1"1060",1"1061",1"1062".E,1"0"):$$RESOLV^PSOERXU2(ERXIEN),1:ERXIEN)
+5 SET REQBY=$$GET1^DIQ(52.49,REQIEN,51.1,"E")
+6 SET REQDTTM=$$GET1^DIQ(52.49,REQIEN,.03,"E")
+7 SET COMM=$$GET1^DIQ(52.49,REQIEN,50,"E")
+8 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+9 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="************************RXCHANGE REQUEST INFORMATION**************************"
+10 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Requested By: "_REQBY
+11 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Request Date/Time: "_REQDTTM
+12 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+13 KILL COMMARY
DO TXT2ARY^PSOERXD1(.COMMARY,COMM," ",53)
+14 IF $DATA(COMMARY)
Begin DoDot:1
+15 SET I=0
FOR
SET I=$ORDER(COMMARY(I))
if 'I
QUIT
Begin DoDot:2
+16 SET CTXT=$SELECT(I=1:"RxChange Request Comments: ",1:$JUSTIFY("",27))_COMMARY(I)
+17 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=CTXT
End DoDot:2
End DoDot:1
+18 IF '$DATA(COMMARY)
Begin DoDot:1
+19 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="RxChange Request Comments:"
End DoDot:1
+20 SET COMMBY=$$GET1^DIQ(52.49,REQIEN,50.1,"E")
+21 SET COMMDTTM=$$GET1^DIQ(52.49,REQIEN,50.2,"E")
+22 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Comments By: "_COMMBY
+23 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Comments Date/Time: "_COMMDTTM
+24 QUIT
+25 ;
MSGHIS(TMPGBL,ERXIEN,LINE) ;
+1 NEW FLAG
+2 SET FLAG=+$GET(FLAG)
+3 NEW ERXREF,RELERX,ERXRES,I,ERXHID,FOUND,REQID,RESID,MTYPE
+4 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+5 IF ",CR,"[(","_MTYPE_",")
SET REQIEN=ERXIEN
SET RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
+6 IF ",CX,"[(","_MTYPE_",")
SET RESIEN=ERXIEN
SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
+7 IF MTYPE="IE"
SET RESIEN=ERXIEN
SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
+8 SET RESID=$$GET1^DIQ(52.49,RESIEN,.01,"E")
+9 SET REQID=$$GET1^DIQ(52.49,REQIEN,.01,"E")
+10 SET RELERX=$$GET1^DIQ(52.49,REQIEN,.14)
+11 SET FOUND=0
+12 SET I=ERXIEN
FOR
SET I=$ORDER(^PS(52.49,ERXIEN,201,"B",I))
if 'I!(FOUND)
QUIT
Begin DoDot:1
+13 IF $$GET1^DIQ(52.49,I,.08,"E")="RE"
IF $$GET1^DIQ(52.49,I,.14,"E")=$$GET1^DIQ(52.49,ERXIEN,.01,"E")
SET ERXRES=$$GET1^DIQ(52.49,I,.14,"E")
SET FOUND=1
End DoDot:1
+14 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)=""
+15 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="*****************************MESSAGE HISTORY********************************"
+16 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Request Reference #: "_$GET(REQID)
+17 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="New eRx Reference #: "_RELERX
+18 SET LINE=LINE+1
SET @TMPGBL@(LINE,0)="Response eRx Reference #: "_$GET(RESID)
+19 QUIT
QTSUMDT2(TMPGBL,PSOIEN,MTYPE,CHGMESRI,RESPVAL,LINE) ; Quit Summary Detail later?
+1 NEW FLG,RULE
+2 Begin DoDot:1
+3 SET FLG=0
+4 IF MTYPE="CX"
IF RESPVAL?1"APPROVED".1" WITH CHANGES"
IF ",G,T,S,OS,D,"[(","_CHGMESRI_",")
Begin DoDot:2
+5 SET FLG=1
SET RULE=0
End DoDot:2
QUIT
+6 SET RULE=$$GETRULES^PSOERX1D(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
+7 SET FLG=RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056")
End DoDot:1
+8 IF FLG
DO RESTSMDT(TMPGBL,0,PSOIEN,RESPVAL,RULE,.LINE)
+9 QUIT FLG
+10 ;
