PSOERX1D ;ALB/JSG - eRx Utilities ; 11/27/2019 11:02am
;;7.0;OUTPATIENT PHARMACY;**581,617**;DEC 1997;Build 110
;
;The rule numbers correspond to the last 4 digits of RTC story #'s and are abbreviations
; for the various conditions which control what is printed on the Summary Detail screen or
; the Print View
;
;i.e. 1058 -> 1251058, 1057 -> 1251057, etc.
; For Summary/Detail:
; 1058 - MTYPE=CX, RESPVAL=DENIED, CHGMESRI=G/T/S/OS/D
; 1059 - MTYPE=CX, RESPVAL=APPROVED OR DENIED, CHGMESRI=P
; 1060 - MTYPE=CX, RESPVAL=DENIED OR VALIDATED, CHGMESRI=U
; 1043 - MTYPE=CR, CHGMESRI=G/T/S/OS/D
; 1056 - MTYPE=CR, CHGMESRI=P/U
;
; For Print View:
; 1057P - MTYPE=CR, CHMESRI=P
; 1057G - MTYPE=CR, CHMESRI=G/T/D/S/OS
; 1057U - MTYPE=CR, CHMESRI=U
; 1061 - MTYPE=CX, RESPVAL=DENIED, CHMESRI=G/T/S/OS/D
; 1062PAN - MTYPE=CX, RESPVAL=APPROVED, CHMESRI=P, No 311
; 1062PA3 - MTYPE=CX, RESPVAL=APPROVED, CHMESRI=P, 311
; 1062PDN - MTYPE=CX, RESPVAL=DENIED, CHMESRI=P, No 311
; 1062PD3 - MTYPE=CX, RESPVAL=DENIED, CHMESRI=P, 311
; 1062UDN - MTYPE=CX, RESPVAL=DENIED, CHMESRI=U, No 311
; 1062UD3 - MTYPE=CX, RESPVAL=DENIED, CHMESRI=U, 311
; 1062UVN - MTYPE=CX, RESPVAL=VALIDATED, CHMESRI=U, No 311
; 1062UV3 - MTYPE=CX, RESPVAL=VALIDATED, CHMESRI=U, 311
;
; CONTEXT - MTYPE^RESPONSE VALUE^REQUEST TYPE
; EX CX^V^U - MEANING CHANGE RESPONSE^VALIDATE^PRIOR AUTHORIZATION??
;
GETRULES(PSOIEN,MTYPE,RESPVAL,CHGMESRI,PRTVIEW) ;
S PRTVIEW=+$G(PRTVIEW)
N DONE,NO311,RULE
S (DONE,RULE)=0
I 'PRTVIEW D
.I MTYPE="CX" D Q
..I RESPVAL="DENIED" D Q:DONE
...I ",G,T,S,OS,D,"[(","_CHGMESRI_",") S RULE=1058,DONE=1 Q
..I RESPVAL?1(1"APPROVED",1"DENIED"),CHGMESRI="P" S RULE=1059,DONE=1 Q
..I RESPVAL?1(1"DENIED",1"VALIDATED"),CHGMESRI="U" D
...S RULE=1060
.D:MTYPE="CR"
..I ",G,T,S,OS,D,"[(","_CHGMESRI_",") S RULE=1043 Q
..I ",P,U,"[(","_CHGMESRI_",") S RULE=1056
I PRTVIEW D
.I MTYPE="CR" D Q
..I CHGMESRI="P" S RULE="1057P" Q
..I CHGMESRI?1(1"G",1"T",1"D",1"S",1"OS") S RULE="1057G" Q
..I CHGMESRI="U" S RULE="1057U"
.D:MTYPE="CX"
..I RESPVAL="DENIED" D
...I ",G,T,S,OS,D,"[(","_CHGMESRI_",") S RULE=1061 Q
..I CHGMESRI="P" D Q
...S NO311='$D(^PS(52.49,PSOIEN,311))
...I RESPVAL="APPROVED" D Q
....S RULE="1062PA"_$S(NO311:"N",1:3)
...I RESPVAL="DENIED" D
....S RULE="1062PD"_$S(NO311:"N",1:3)
..I CHGMESRI="U" D
...S NO311='$D(^PS(52.49,PSOIEN,311))
...I RESPVAL="DENIED" D Q
....S RULE="1062UD"_$S(NO311:"N",1:3)
...I RESPVAL="VALIDATED" D
....S RULE="1062UV"_$S(NO311:"N",1:3)
Q RULE
;
SETMRC(PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,LINE) ; Set values for MRC variables
N CHGMESRE,CHMSSUB,I,IENS,NO311,NOTEARY
S CHGMESRE=$$GET1^DIQ(52.45,CHGMESRQ,.02,"I")
I RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056",1"0") D SET(.LINE,"Change Request Type: ",CHGMESRE)
I (RULE=1060)!((RULE=1056)&(CHGMESRI="U")) 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 D
..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 D SET^VALM10(LINE,$S(I=1:"Change Request Sub Type: ",1:$J("",25))_NOTEARY(I))
.I '$D(NOTEARY) D
..S LINE=LINE+1 D SET^VALM10(LINE,"Change Request Sub Type: ")
I RULE?1(1"1058",1"1059",1"1060") D
.S NO311='$D(^PS(52.49,PSOIEN,311))
I RULE'?1(1"1058",1"1059",1"1060") D
.S NO311=0
I NO311 D
.D RESTSMDT(1,PSOIEN,RESPVAL,RULE,.LINE)
Q NO311
;
RESTSMDT(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
.D MEDPRES(PSOIEN,RULE,.LINE)
I 'SMALLMP D:RULE=0!((RESPVAL="VALIDATED")&($$GET1^DIQ(52.49,PSOIEN,.08,"I")="CX"))
.D DISPRX^PSOERX1G
I RULE?1(1"1059",1"1060",1"1056",1"1062".E) D
.D PHCHREQ^PSOERX1E(PSOIEN,RULE,.LINE)
S CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
D CXRES(PSOIEN,RESPVAL,RULE,"1058,1059,1060,0",.LINE)
I RULE?1(1"1058",1"1043",1"0") D ;
.D MEDREQDR(PSOIEN,RULE,.LINE)
D CXREQ(PSOIEN,RULE,.LINE)
D MSGHIS^PSOERXU3(PSOIEN,.LINE)
Q
;
MEDPRES(PSOIEN,RULE,LINE) ; Medication Prescribed
S LINE=LINE+1 D SET^VALM10(LINE,"**************************MEDICATION PRESCRIBED******************************")
S LINE=LINE+1 D SET^VALM10(LINE,"No Medication information available on the Response.")
Q
;
CXRES(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)) D
.S (PRIAUTH,PRAUTHST,DRCVGST)=" "
S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"*************************RXCHANGE RESPONSE INFORMATION**************************")
S LINE=LINE+1 D SET^VALM10(LINE,RESVAL),CNTRL^VALM10(LINE,1,$L(RESVAL),IORVON,IORVOFF)
D SET(.LINE,"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 D SET^VALM10(LINE,$S(I=1:"Note: ",1:$J("",6))_NOTEARY(I))
S LINE=LINE+1 D SET^VALM10(LINE,"")
I ((RULE=1059)&(RESPVAL="APPROVED"))!(RULE?1"1062PA".E) D
.S XLINE=LINE
.D SET(.LINE,"Prior Authorization: ",PRIAUTH)
.D SET(.LINE,"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 D SET^VALM10(LINE,TXT)
.I '$D(NOTEARY) S LINE=LINE+1 D SET^VALM10(LINE,"Drug Coverage Status:")
.I LINE>XLINE S LINE=LINE+1 D SET^VALM10(LINE,"")
I ((RULE=1060)&(RESPVAL="VALIDATED"))!(RULE?1"1062UV".E) D
.S XLINE=LINE
.D SET(.LINE,"ID: ",ID)
.D SET(.LINE,"Date: ",DATE)
.I LINE>XLINE S LINE=LINE+1 D SET^VALM10(LINE,"")
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 D SET^VALM10(LINE,TXT)
I '$D(COMMARY) D
.S LINE=LINE+1 D SET^VALM10(LINE,"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 D SET^VALM10(LINE,"Comments By: "_COMMBY)
S LINE=LINE+1 D SET^VALM10(LINE,"Comments Date/Time: "_COMMDTTM)
S LINE=LINE+1 D SET^VALM10(LINE,"") 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")
.D
..S FLG=0
..I RULE=1058 S FLG=1 Q
..I RULE=1059,RESPVAL="DENIED" S FLG=1 Q
..I RULE=1060 S FLG=1 Q
..I RULE=1061 S FLG=1 Q
..I RULE?1"1062"1(1"PD",1"U").E S FLG=1
.I FLG D
..S RESTEXT=RESVAL_" reason code: "_ERESCODE
..S LINE=LINE+1 D SET^VALM10(LINE,RESTEXT),CNTRL^VALM10(LINE,1,$L(RESTEXT),IORVON,IORVOFF)
..D SET(.LINE,"Code Description: ",RESDESC)
I XLINE<LINE S LINE=LINE+1 D SET^VALM10(LINE,"")
Q
;
MEDREQDR(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)
W:RULE="1057G" !
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(REQIEN,F,IENS,I,.LINE,CNT)
.K DDAT
Q
;
MEDREQ(REQIEN,F,IENS,IEN311,LINE,CNT) ; Medication Request section
N DAYSUP,DRUG,FND,I,LTXT,NOTE,NOTEARY,QTY,QUOM,REFILL,SIG,SUB,TXT
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")
I $G(@VALMAR@(LINE,0))]"" S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"****************************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 D SET^VALM10(LINE,$S(I=1:"Drug: ",1:$J("",6))_NOTEARY(I))
S LINE=LINE+1 D SET^VALM10(LINE,"Substitutions: "_SUB)
D NOTE(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 D SET^VALM10(LINE,LTXT)
I QUOM="" D
. S LINE=LINE+1 D SET^VALM10(LINE,"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 D SET^VALM10(LINE,TXT)
S LINE=LINE+1 D SET^VALM10(LINE,"Sig: ")
S I=0 F S I=$O(^PS(52.49,REQIEN,311,IEN311,8,I)) Q:'I D
.S LINE=LINE+1 D SET^VALM10(LINE,^PS(52.49,REQIEN,311,IEN311,8,I,0))
S LINE=LINE+1 D SET^VALM10(LINE,"")
Q
; rxchange request information
CXREQ(ERXIEN,RULE,LINE) ;
N COMM,COMMARY,COMMBY,COMMDTTM,CTXT,I,REQBY,REQDTTM,REQIEN
; - the next line of code will actually reference the related message for retrieval 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")
I $G(@VALMAR@(LINE,0))]""&(RULE'="1057G") S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"************************RXCHANGE REQUEST INFORMATION**************************")
D SET(.LINE,"Requested By: ",REQBY)
D SET(.LINE,"Request Date/Time: ",REQDTTM)
S LINE=LINE+1 D SET^VALM10(LINE,"")
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 D SET^VALM10(LINE,CTXT)
I '$D(COMMARY) D
.S LINE=LINE+1 D SET^VALM10(LINE,"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 D SET^VALM10(LINE,"Comments By: "_COMMBY)
S LINE=LINE+1 D SET^VALM10(LINE,"Comments Date/Time: "_COMMDTTM)
Q
;
SET(LINE,TITLE,VAL) ; Add line if there is a value
I $G(VAL)]"" S LINE=LINE+1 D SET^VALM10(LINE,TITLE_VAL)
Q
;
PRTVIEW(PSOIEN,CHGMESRQ,RESPVAL,RULE,NO311) ; Set values for MRC variables
N CHGMESRE,CMTS,LINE,NOTEARY,RULES,SUBS,XMTYPE
S CHGMESRE=$$GET1^DIQ(52.45,CHGMESRQ,.02,"I")
I RULE?1(1"1061".E,1"1062P".E,1"1062U".E),NO311 D
.W !,"No Medication information available on the Response."
I RULE?1(1"1061".E,1"1062P".E,1"1062UD".E),NO311 D
.W !!,"eRx Reference #: ",$$GET1^DIQ(52.49,PSOIEN,.01,"E")
.W !,"Message ID: ",$$GET1^DIQ(52.49,PSOIEN,25,"E")
I RULE?1(1"1062P".E,1"1062UD".E),NO311 D
.S CMTS=$$GET1^DIQ(52.49,PSOIEN,30,"I")
.S SUBS=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
.S SUBS=$S(SUBS=1:"NO",SUBS=0:"YES",1:"")
.W:SUBS]"" !,"Substitutions?: ",SUBS
.K NOTEARY
.D TXT2ARY^PSOERXD1(.NOTEARY,CMTS," ",70)
.S I=0 F S I=$O(NOTEARY(I)) Q:'I D
..W !,$S(I=1:"Comments: ",1:$J("",10))_NOTEARY(I)
I RULE?1(1"1057"1.E,1"1061",1"1062".E,1"0") D
.W !!,"Change Request Type: ",CHGMESRE
I (RULE="1057U")!(RULE?1"1062U".E) D
.I $D(^PS(52.49,PSOIEN,316,1)) D
..N IENS
..S IENS=$O(^PS(52.49,PSOIEN,316,0))
..S IENS=IENS_","_PSOIEN_","
..S CHMSSUB=$$GET1^DIQ(52.49316,IENS,1,"I")
..S CHMSSUB=$$GET1^DIQ(52.45,CHMSSUB,.02,"E")
.I '$D(^PS(52.49,PSOIEN,316,1)) D
..S CHMSSUB=""
.W:CHMSSUB]"" !,"Change Request Sub Type: ",CHMSSUB
I RULE?1(1"1057U",1"1057P",1"1062".E) D
.D PHCHREQ^PSOERX1E(PSOIEN,RULE,"",1)
S RULES="1061,1062,0"
D ARR2PRT("CXRES(PSOIEN,RESPVAL,RULE,RULES,.LINE)",PSOIEN,RESPVAL,RULE,RULES,.LINE)
I RULE?1(1"1057G",1"1061",1"0") D
.D ARR2PRT("MEDREQDR(PSOIEN,RULE,.LINE)",PSOIEN,RESPVAL,RULE,RULES,.LINE)
I RULE?1(1"1057"1A,1"1061",1"1062".E,1"0") D
.I RULE?1"1057"1(1"U",1"P") D
..W !
.D ARR2PRT("CXREQ(PSOIEN,RULE,.LINE)",PSOIEN,RESPVAL,RULE,RULES,.LINE)
I RULE?1(1"1057"1A,1"1061",1"1062".E,1"0") D
.D ARR2PRT("MSGHIS^PSOERXU3(PSOIEN,.LINE)",PSOIEN,RESPVAL,RULE,RULES,.LINE)
I RULE="1061",NO311 D
.W !,"*******************************END OF eRx********************************"
Q
;
ARR2PRT(FUN,PSOIEN,RESPVAL,RULE,RULES,LINE) ; Change VALMAR to print
N ARR,LINE,VALMAR
S LINE=0,VALMAR="ARR"
D @FUN
S LINE=0
F S LINE=$O(@VALMAR@(LINE)) Q:'LINE D
.W !,@VALMAR@(LINE,0)
Q
;
CHGMTYPE(PSOIEN,MTYPE,RESPVAL,CHGMESRI) ; Check on changing message type
N FLG,RULE
D
.S FLG=0
.I MTYPE="CX",RESPVAL?1"APPROVED".1" WITH CHANGES",",G,T,S,OS,D,"[(","_CHGMESRI_",") S FLG=1 Q
.S RULE=$$GETRULES(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
.S FLG=RULE?1(1"1058",1"1059",1"1060",1"1062".E)
Q FLG
;
QTSUMDT1(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(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
.S FLG=(RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056"))
I FLG D
.S FLG=$$SETMRC(PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,.LINE)
Q FLG
;
QTSUMDT2(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(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
.S FLG=RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056")
I FLG D
.D RESTSMDT(0,PSOIEN,RESPVAL,RULE,.LINE)
Q FLG
;
ADMDPRLN(PSOIEN,MTYPE,RESPVAL,CHGMESRI) ; Add Medication Prescribed Line?
Q $$CHGMTYPE(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
;
SHORTPI(PSOIEN,MTYPE,RESPVAL,CHGMESRI) ; Short Prescription Info section?
N FLG,RULE
S RULE=$$GETRULES(PSOIEN,MTYPE,RESPVAL,CHGMESRI,1)
S FLG=((RULE=1061)&'$D(^PS(52.49,PSOIEN,311)))!(RULE?1"1062"2A1"N")
D:FLG PRTVIEW(PSOIEN,CHGMESRQ,RESPVAL,RULE,1)
Q FLG
;
CHGEND(PSOIEN,MTYPE,RESPVAL,CHGMESRI) ; Change end of Print View?
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(PSOIEN,MTYPE,RESPVAL,CHGMESRI,1)
.S FLG=RULE?1(1"1057"1.E,1"1061",1"1062".E)
I FLG D PRTVIEW(PSOIEN,CHGMESRQ,RESPVAL,RULE,'$D(^PS(52.49,PSOIEN,311)))
Q
;
NOTE(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 D SET^VALM10(LINE,$S(I=1:TITLE,1:$J("",LEN))_NOTEARY(I))
I '$D(NOTEARY) D:REQUIRED
.S LINE=LINE+1 D SET^VALM10(LINE,TITLE)
Q
;
PROHIBIT(RESPVAL,CHGMESRI) ; Print prohibit renewal tag?
Q:(RESPVAL?1"APPROVED".1" WITH CHANGES")&(",G,T,S,OS,D,"[(","_CHGMESRI_",")) 1
Q $S(RESPVAL="VALIDATED":1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERX1D 17184 printed Apr 09, 2024@21:33:46 Page 2
PSOERX1D ;ALB/JSG - eRx Utilities ; 11/27/2019 11:02am
+1 ;;7.0;OUTPATIENT PHARMACY;**581,617**;DEC 1997;Build 110
+2 ;
+3 ;The rule numbers correspond to the last 4 digits of RTC story #'s and are abbreviations
+4 ; for the various conditions which control what is printed on the Summary Detail screen or
+5 ; the Print View
+6 ;
+7 ;i.e. 1058 -> 1251058, 1057 -> 1251057, etc.
+8 ; For Summary/Detail:
+9 ; 1058 - MTYPE=CX, RESPVAL=DENIED, CHGMESRI=G/T/S/OS/D
+10 ; 1059 - MTYPE=CX, RESPVAL=APPROVED OR DENIED, CHGMESRI=P
+11 ; 1060 - MTYPE=CX, RESPVAL=DENIED OR VALIDATED, CHGMESRI=U
+12 ; 1043 - MTYPE=CR, CHGMESRI=G/T/S/OS/D
+13 ; 1056 - MTYPE=CR, CHGMESRI=P/U
+14 ;
+15 ; For Print View:
+16 ; 1057P - MTYPE=CR, CHMESRI=P
+17 ; 1057G - MTYPE=CR, CHMESRI=G/T/D/S/OS
+18 ; 1057U - MTYPE=CR, CHMESRI=U
+19 ; 1061 - MTYPE=CX, RESPVAL=DENIED, CHMESRI=G/T/S/OS/D
+20 ; 1062PAN - MTYPE=CX, RESPVAL=APPROVED, CHMESRI=P, No 311
+21 ; 1062PA3 - MTYPE=CX, RESPVAL=APPROVED, CHMESRI=P, 311
+22 ; 1062PDN - MTYPE=CX, RESPVAL=DENIED, CHMESRI=P, No 311
+23 ; 1062PD3 - MTYPE=CX, RESPVAL=DENIED, CHMESRI=P, 311
+24 ; 1062UDN - MTYPE=CX, RESPVAL=DENIED, CHMESRI=U, No 311
+25 ; 1062UD3 - MTYPE=CX, RESPVAL=DENIED, CHMESRI=U, 311
+26 ; 1062UVN - MTYPE=CX, RESPVAL=VALIDATED, CHMESRI=U, No 311
+27 ; 1062UV3 - MTYPE=CX, RESPVAL=VALIDATED, CHMESRI=U, 311
+28 ;
+29 ; CONTEXT - MTYPE^RESPONSE VALUE^REQUEST TYPE
+30 ; EX CX^V^U - MEANING CHANGE RESPONSE^VALIDATE^PRIOR AUTHORIZATION??
+31 ;
GETRULES(PSOIEN,MTYPE,RESPVAL,CHGMESRI,PRTVIEW) ;
+1 SET PRTVIEW=+$GET(PRTVIEW)
+2 NEW DONE,NO311,RULE
+3 SET (DONE,RULE)=0
+4 IF 'PRTVIEW
Begin DoDot:1
+5 IF MTYPE="CX"
Begin DoDot:2
+6 IF RESPVAL="DENIED"
Begin DoDot:3
+7 IF ",G,T,S,OS,D,"[(","_CHGMESRI_",")
SET RULE=1058
SET DONE=1
QUIT
End DoDot:3
if DONE
QUIT
+8 IF RESPVAL?1(1"APPROVED",1"DENIED")
IF CHGMESRI="P"
SET RULE=1059
SET DONE=1
QUIT
+9 IF RESPVAL?1(1"DENIED",1"VALIDATED")
IF CHGMESRI="U"
Begin DoDot:3
+10 SET RULE=1060
End DoDot:3
End DoDot:2
QUIT
+11 if MTYPE="CR"
Begin DoDot:2
+12 IF ",G,T,S,OS,D,"[(","_CHGMESRI_",")
SET RULE=1043
QUIT
+13 IF ",P,U,"[(","_CHGMESRI_",")
SET RULE=1056
End DoDot:2
End DoDot:1
+14 IF PRTVIEW
Begin DoDot:1
+15 IF MTYPE="CR"
Begin DoDot:2
+16 IF CHGMESRI="P"
SET RULE="1057P"
QUIT
+17 IF CHGMESRI?1(1"G",1"T",1"D",1"S",1"OS")
SET RULE="1057G"
QUIT
+18 IF CHGMESRI="U"
SET RULE="1057U"
End DoDot:2
QUIT
+19 if MTYPE="CX"
Begin DoDot:2
+20 IF RESPVAL="DENIED"
Begin DoDot:3
+21 IF ",G,T,S,OS,D,"[(","_CHGMESRI_",")
SET RULE=1061
QUIT
End DoDot:3
+22 IF CHGMESRI="P"
Begin DoDot:3
+23 SET NO311='$DATA(^PS(52.49,PSOIEN,311))
+24 IF RESPVAL="APPROVED"
Begin DoDot:4
+25 SET RULE="1062PA"_$SELECT(NO311:"N",1:3)
End DoDot:4
QUIT
+26 IF RESPVAL="DENIED"
Begin DoDot:4
+27 SET RULE="1062PD"_$SELECT(NO311:"N",1:3)
End DoDot:4
End DoDot:3
QUIT
+28 IF CHGMESRI="U"
Begin DoDot:3
+29 SET NO311='$DATA(^PS(52.49,PSOIEN,311))
+30 IF RESPVAL="DENIED"
Begin DoDot:4
+31 SET RULE="1062UD"_$SELECT(NO311:"N",1:3)
End DoDot:4
QUIT
+32 IF RESPVAL="VALIDATED"
Begin DoDot:4
+33 SET RULE="1062UV"_$SELECT(NO311:"N",1:3)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT RULE
+35 ;
SETMRC(PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,LINE) ; Set values for MRC variables
+1 NEW CHGMESRE,CHMSSUB,I,IENS,NO311,NOTEARY
+2 SET CHGMESRE=$$GET1^DIQ(52.45,CHGMESRQ,.02,"I")
+3 IF RULE?1(1"1058",1"1059",1"1060",1"1043",1"1056",1"0")
DO SET(.LINE,"Change Request Type: ",CHGMESRE)
+4 IF (RULE=1060)!((RULE=1056)&(CHGMESRI="U"))
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
Begin DoDot:2
+11 SET CHMSSUB=""
End DoDot:2
+12 KILL NOTEARY
+13 DO TXT2ARY^PSOERXD1(.NOTEARY,CHMSSUB," ",55)
+14 IF $DATA(NOTEARY)
Begin DoDot:2
+15 SET I=0
+16 FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:3
+17 SET LINE=LINE+1
DO SET^VALM10(LINE,$SELECT(I=1:"Change Request Sub Type: ",1:$JUSTIFY("",25))_NOTEARY(I))
End DoDot:3
End DoDot:2
+18 IF '$DATA(NOTEARY)
Begin DoDot:2
+19 SET LINE=LINE+1
DO SET^VALM10(LINE,"Change Request Sub Type: ")
End DoDot:2
End DoDot:1
+20 IF RULE?1(1"1058",1"1059",1"1060")
Begin DoDot:1
+21 SET NO311='$DATA(^PS(52.49,PSOIEN,311))
End DoDot:1
+22 IF RULE'?1(1"1058",1"1059",1"1060")
Begin DoDot:1
+23 SET NO311=0
End DoDot:1
+24 IF NO311
Begin DoDot:1
+25 DO RESTSMDT(1,PSOIEN,RESPVAL,RULE,.LINE)
End DoDot:1
+26 QUIT NO311
+27 ;
RESTSMDT(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
Begin DoDot:1
+3 DO MEDPRES(PSOIEN,RULE,.LINE)
End DoDot:1
+4 IF 'SMALLMP
if RULE=0!((RESPVAL="VALIDATED")&($$GET1^DIQ(52.49,PSOIEN,.08,"I")="CX"))
Begin DoDot:1
+5 DO DISPRX^PSOERX1G
End DoDot:1
+6 IF RULE?1(1"1059",1"1060",1"1056",1"1062".E)
Begin DoDot:1
+7 DO PHCHREQ^PSOERX1E(PSOIEN,RULE,.LINE)
End DoDot:1
+8 SET CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
+9 DO CXRES(PSOIEN,RESPVAL,RULE,"1058,1059,1060,0",.LINE)
+10 ;
IF RULE?1(1"1058",1"1043",1"0")
Begin DoDot:1
+11 DO MEDREQDR(PSOIEN,RULE,.LINE)
End DoDot:1
+12 DO CXREQ(PSOIEN,RULE,.LINE)
+13 DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
+14 QUIT
+15 ;
MEDPRES(PSOIEN,RULE,LINE) ; Medication Prescribed
+1 SET LINE=LINE+1
DO SET^VALM10(LINE,"**************************MEDICATION PRESCRIBED******************************")
+2 SET LINE=LINE+1
DO SET^VALM10(LINE,"No Medication information available on the Response.")
+3 QUIT
+4 ;
CXRES(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))
Begin DoDot:1
+40 SET (PRIAUTH,PRAUTHST,DRCVGST)=" "
End DoDot:1
+41 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+42 SET LINE=LINE+1
DO SET^VALM10(LINE,"*************************RXCHANGE RESPONSE INFORMATION**************************")
+43 SET LINE=LINE+1
DO SET^VALM10(LINE,RESVAL)
DO CNTRL^VALM10(LINE,1,$LENGTH(RESVAL),IORVON,IORVOFF)
+44 DO SET(.LINE,"Response Date/Time: ",RESDTTM)
+45 IF NOTE]""
Begin DoDot:1
+46 KILL NOTEARY
+47 DO TXT2ARY^PSOERXD1(.NOTEARY,NOTE," ",74)
+48 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:2
+49 SET LINE=LINE+1
DO SET^VALM10(LINE,$SELECT(I=1:"Note: ",1:$JUSTIFY("",6))_NOTEARY(I))
End DoDot:2
End DoDot:1
+50 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+51 IF ((RULE=1059)&(RESPVAL="APPROVED"))!(RULE?1"1062PA".E)
Begin DoDot:1
+52 SET XLINE=LINE
+53 DO SET(.LINE,"Prior Authorization: ",PRIAUTH)
+54 DO SET(.LINE,"Prior Authorization Status: ",PRAUTHST)
+55 KILL NOTEARY
DO TXT2ARY^PSOERXD1(.NOTEARY,DRCVGST," ",58)
+56 IF $DATA(NOTEARY)
Begin DoDot:2
+57 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:3
+58 SET TXT=$SELECT(I=1:"Drug Coverage Status: ",1:$JUSTIFY("",22))_NOTEARY(I)
+59 SET LINE=LINE+1
DO SET^VALM10(LINE,TXT)
End DoDot:3
End DoDot:2
+60 IF '$DATA(NOTEARY)
SET LINE=LINE+1
DO SET^VALM10(LINE,"Drug Coverage Status:")
+61 IF LINE>XLINE
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
End DoDot:1
+62 IF ((RULE=1060)&(RESPVAL="VALIDATED"))!(RULE?1"1062UV".E)
Begin DoDot:1
+63 SET XLINE=LINE
+64 DO SET(.LINE,"ID: ",ID)
+65 DO SET(.LINE,"Date: ",DATE)
+66 IF LINE>XLINE
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
End DoDot:1
+67 SET COMM=$$GET1^DIQ(52.49,RESIEN,50,"E")
+68 KILL COMMARY
DO TXT2ARY^PSOERXD1(.COMMARY,COMM," ",52)
+69 IF $DATA(COMMARY)
Begin DoDot:1
+70 SET I=0
FOR
SET I=$ORDER(COMMARY(I))
if 'I
QUIT
Begin DoDot:2
+71 SET TXT=$SELECT(I=1:"RxChange Response Comments: ",1:$JUSTIFY("",28))_COMMARY(I)
+72 SET LINE=LINE+1
DO SET^VALM10(LINE,TXT)
End DoDot:2
End DoDot:1
+73 IF '$DATA(COMMARY)
Begin DoDot:1
+74 SET LINE=LINE+1
DO SET^VALM10(LINE,"RxChange Response Comments:")
End DoDot:1
+75 SET COMMBY=$$GET1^DIQ(52.49,RESIEN,50.1,"E")
+76 SET COMMDTTM=$$GET1^DIQ(52.49,RESIEN,50.2,"E")
+77 SET LINE=LINE+1
DO SET^VALM10(LINE,"Comments By: "_COMMBY)
+78 SET LINE=LINE+1
DO SET^VALM10(LINE,"Comments Date/Time: "_COMMDTTM)
+79 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
SET XLINE=LINE
+80 SET I=0
FOR
SET I=$ORDER(^PS(52.49,RESIEN,55,I))
if 'I
QUIT
Begin DoDot:1
+81 SET ERESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
+82 SET CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
+83 SET RESDESC=$$GET1^DIQ(52.45,CODEIEN,.02,"E")
+84 Begin DoDot:2
+85 SET FLG=0
+86 IF RULE=1058
SET FLG=1
QUIT
+87 IF RULE=1059
IF RESPVAL="DENIED"
SET FLG=1
QUIT
+88 IF RULE=1060
SET FLG=1
QUIT
+89 IF RULE=1061
SET FLG=1
QUIT
+90 IF RULE?1"1062"1(1"PD",1"U").E
SET FLG=1
End DoDot:2
+91 IF FLG
Begin DoDot:2
+92 SET RESTEXT=RESVAL_" reason code: "_ERESCODE
+93 SET LINE=LINE+1
DO SET^VALM10(LINE,RESTEXT)
DO CNTRL^VALM10(LINE,1,$LENGTH(RESTEXT),IORVON,IORVOFF)
+94 DO SET(.LINE,"Code Description: ",RESDESC)
End DoDot:2
End DoDot:1
+95 IF XLINE<LINE
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+96 QUIT
+97 ;
MEDREQDR(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 if RULE="1057G"
WRITE !
+4 SET I=0
+5 FOR
SET I=$ORDER(^PS(52.49,REQIEN,311,I))
if 'I
QUIT
Begin DoDot:1
+6 SET F=52.49311
SET IENS=I_","_REQIEN_","
+7 DO GETS^DIQ(F,IENS,"**","IE","DDAT")
+8 ; Only requested medications
IF $GET(DDAT(F,IENS,.02,"I"))="R"
Begin DoDot:2
+9 SET CNT=CNT+1
+10 DO MEDREQ(REQIEN,F,IENS,I,.LINE,CNT)
End DoDot:2
+11 KILL DDAT
End DoDot:1
+12 QUIT
+13 ;
MEDREQ(REQIEN,F,IENS,IEN311,LINE,CNT) ; Medication Request section
+1 NEW DAYSUP,DRUG,FND,I,LTXT,NOTE,NOTEARY,QTY,QUOM,REFILL,SIG,SUB,TXT
+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 IF $GET(@VALMAR@(LINE,0))]""
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+12 SET LINE=LINE+1
DO SET^VALM10(LINE,"****************************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
DO SET^VALM10(LINE,$SELECT(I=1:"Drug: ",1:$JUSTIFY("",6))_NOTEARY(I))
End DoDot:1
+17 SET LINE=LINE+1
DO SET^VALM10(LINE,"Substitutions: "_SUB)
+18 DO NOTE(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
DO SET^VALM10(LINE,LTXT)
+24 IF QUOM=""
Begin DoDot:1
+25 SET LINE=LINE+1
DO SET^VALM10(LINE,"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
DO SET^VALM10(LINE,TXT)
End DoDot:2
End DoDot:1
+32 SET LINE=LINE+1
DO SET^VALM10(LINE,"Sig: ")
+33 SET I=0
FOR
SET I=$ORDER(^PS(52.49,REQIEN,311,IEN311,8,I))
if 'I
QUIT
Begin DoDot:1
+34 SET LINE=LINE+1
DO SET^VALM10(LINE,^PS(52.49,REQIEN,311,IEN311,8,I,0))
End DoDot:1
+35 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+36 QUIT
+37 ; rxchange request information
CXREQ(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 for retrieval 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 IF $GET(@VALMAR@(LINE,0))]""&(RULE'="1057G")
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+9 SET LINE=LINE+1
DO SET^VALM10(LINE,"************************RXCHANGE REQUEST INFORMATION**************************")
+10 DO SET(.LINE,"Requested By: ",REQBY)
+11 DO SET(.LINE,"Request Date/Time: ",REQDTTM)
+12 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+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
DO SET^VALM10(LINE,CTXT)
End DoDot:2
End DoDot:1
+18 IF '$DATA(COMMARY)
Begin DoDot:1
+19 SET LINE=LINE+1
DO SET^VALM10(LINE,"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
DO SET^VALM10(LINE,"Comments By: "_COMMBY)
+23 SET LINE=LINE+1
DO SET^VALM10(LINE,"Comments Date/Time: "_COMMDTTM)
+24 QUIT
+25 ;
SET(LINE,TITLE,VAL) ; Add line if there is a value
+1 IF $GET(VAL)]""
SET LINE=LINE+1
DO SET^VALM10(LINE,TITLE_VAL)
+2 QUIT
+3 ;
PRTVIEW(PSOIEN,CHGMESRQ,RESPVAL,RULE,NO311) ; Set values for MRC variables
+1 NEW CHGMESRE,CMTS,LINE,NOTEARY,RULES,SUBS,XMTYPE
+2 SET CHGMESRE=$$GET1^DIQ(52.45,CHGMESRQ,.02,"I")
+3 IF RULE?1(1"1061".E,1"1062P".E,1"1062U".E)
IF NO311
Begin DoDot:1
+4 WRITE !,"No Medication information available on the Response."
End DoDot:1
+5 IF RULE?1(1"1061".E,1"1062P".E,1"1062UD".E)
IF NO311
Begin DoDot:1
+6 WRITE !!,"eRx Reference #: ",$$GET1^DIQ(52.49,PSOIEN,.01,"E")
+7 WRITE !,"Message ID: ",$$GET1^DIQ(52.49,PSOIEN,25,"E")
End DoDot:1
+8 IF RULE?1(1"1062P".E,1"1062UD".E)
IF NO311
Begin DoDot:1
+9 SET CMTS=$$GET1^DIQ(52.49,PSOIEN,30,"I")
+10 SET SUBS=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
+11 SET SUBS=$SELECT(SUBS=1:"NO",SUBS=0:"YES",1:"")
+12 if SUBS]""
WRITE !,"Substitutions?: ",SUBS
+13 KILL NOTEARY
+14 DO TXT2ARY^PSOERXD1(.NOTEARY,CMTS," ",70)
+15 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:2
+16 WRITE !,$SELECT(I=1:"Comments: ",1:$JUSTIFY("",10))_NOTEARY(I)
End DoDot:2
End DoDot:1
+17 IF RULE?1(1"1057"1.E,1"1061",1"1062".E,1"0")
Begin DoDot:1
+18 WRITE !!,"Change Request Type: ",CHGMESRE
End DoDot:1
+19 IF (RULE="1057U")!(RULE?1"1062U".E)
Begin DoDot:1
+20 IF $DATA(^PS(52.49,PSOIEN,316,1))
Begin DoDot:2
+21 NEW IENS
+22 SET IENS=$ORDER(^PS(52.49,PSOIEN,316,0))
+23 SET IENS=IENS_","_PSOIEN_","
+24 SET CHMSSUB=$$GET1^DIQ(52.49316,IENS,1,"I")
+25 SET CHMSSUB=$$GET1^DIQ(52.45,CHMSSUB,.02,"E")
End DoDot:2
+26 IF '$DATA(^PS(52.49,PSOIEN,316,1))
Begin DoDot:2
+27 SET CHMSSUB=""
End DoDot:2
+28 if CHMSSUB]""
WRITE !,"Change Request Sub Type: ",CHMSSUB
End DoDot:1
+29 IF RULE?1(1"1057U",1"1057P",1"1062".E)
Begin DoDot:1
+30 DO PHCHREQ^PSOERX1E(PSOIEN,RULE,"",1)
End DoDot:1
+31 SET RULES="1061,1062,0"
+32 DO ARR2PRT("CXRES(PSOIEN,RESPVAL,RULE,RULES,.LINE)",PSOIEN,RESPVAL,RULE,RULES,.LINE)
+33 IF RULE?1(1"1057G",1"1061",1"0")
Begin DoDot:1
+34 DO ARR2PRT("MEDREQDR(PSOIEN,RULE,.LINE)",PSOIEN,RESPVAL,RULE,RULES,.LINE)
End DoDot:1
+35 IF RULE?1(1"1057"1A,1"1061",1"1062".E,1"0")
Begin DoDot:1
+36 IF RULE?1"1057"1(1"U",1"P")
Begin DoDot:2
+37 WRITE !
End DoDot:2
+38 DO ARR2PRT("CXREQ(PSOIEN,RULE,.LINE)",PSOIEN,RESPVAL,RULE,RULES,.LINE)
End DoDot:1
+39 IF RULE?1(1"1057"1A,1"1061",1"1062".E,1"0")
Begin DoDot:1
+40 DO ARR2PRT("MSGHIS^PSOERXU3(PSOIEN,.LINE)",PSOIEN,RESPVAL,RULE,RULES,.LINE)
End DoDot:1
+41 IF RULE="1061"
IF NO311
Begin DoDot:1
+42 WRITE !,"*******************************END OF eRx********************************"
End DoDot:1
+43 QUIT
+44 ;
ARR2PRT(FUN,PSOIEN,RESPVAL,RULE,RULES,LINE) ; Change VALMAR to print
+1 NEW ARR,LINE,VALMAR
+2 SET LINE=0
SET VALMAR="ARR"
+3 DO @FUN
+4 SET LINE=0
+5 FOR
SET LINE=$ORDER(@VALMAR@(LINE))
if 'LINE
QUIT
Begin DoDot:1
+6 WRITE !,@VALMAR@(LINE,0)
End DoDot:1
+7 QUIT
+8 ;
CHGMTYPE(PSOIEN,MTYPE,RESPVAL,CHGMESRI) ; Check on changing message type
+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_",")
SET FLG=1
QUIT
+5 SET RULE=$$GETRULES(PSOIEN,MTYPE,RESPVAL,CHGMESRI,0)
+6 SET FLG=RULE?1(1"1058",1"1059",1"1060",1"1062".E)
End DoDot:1
+7 QUIT FLG
+8 ;
QTSUMDT1(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(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
Begin DoDot:1
+9 SET FLG=$$SETMRC(PSOIEN,CHGMESRI,CHGMESRQ,RESPVAL,RULE,.LINE)
End DoDot:1
+10 QUIT FLG
+11 ;
QTSUMDT2(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(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
Begin DoDot:1
+9 DO RESTSMDT(0,PSOIEN,RESPVAL,RULE,.LINE)
End DoDot:1
+10 QUIT FLG
+11 ;
ADMDPRLN(PSOIEN,MTYPE,RESPVAL,CHGMESRI) ; Add Medication Prescribed Line?
+1 QUIT $$CHGMTYPE(PSOIEN,MTYPE,RESPVAL,CHGMESRI)
+2 ;
SHORTPI(PSOIEN,MTYPE,RESPVAL,CHGMESRI) ; Short Prescription Info section?
+1 NEW FLG,RULE
+2 SET RULE=$$GETRULES(PSOIEN,MTYPE,RESPVAL,CHGMESRI,1)
+3 SET FLG=((RULE=1061)&'$DATA(^PS(52.49,PSOIEN,311)))!(RULE?1"1062"2A1"N")
+4 if FLG
DO PRTVIEW(PSOIEN,CHGMESRQ,RESPVAL,RULE,1)
+5 QUIT FLG
+6 ;
CHGEND(PSOIEN,MTYPE,RESPVAL,CHGMESRI) ; Change end of Print View?
+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(PSOIEN,MTYPE,RESPVAL,CHGMESRI,1)
+7 SET FLG=RULE?1(1"1057"1.E,1"1061",1"1062".E)
End DoDot:1
+8 IF FLG
DO PRTVIEW(PSOIEN,CHGMESRQ,RESPVAL,RULE,'$DATA(^PS(52.49,PSOIEN,311)))
+9 QUIT
+10 ;
NOTE(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
DO SET^VALM10(LINE,$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
DO SET^VALM10(LINE,TITLE)
End DoDot:1
+9 QUIT
+10 ;
PROHIBIT(RESPVAL,CHGMESRI) ; Print prohibit renewal tag?
+1 if (RESPVAL?1"APPROVED".1" WITH CHANGES")&(",G,T,S,OS,D,"[(","_CHGMESRI_","))
QUIT 1
+2 QUIT $SELECT(RESPVAL="VALIDATED":1,1:0)
