PSOERX1D ;ALB/JSG - eRx Utilities ; 11/27/2019 11:02am
;;7.0;OUTPATIENT PHARMACY;**581,617,746**;DEC 1997;Build 106
;
;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,X,REATXT
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),CNTRL^VALM10(LINE,22,$L(CHGMESRE),IOINHI,IOINORM)
I (RULE=1060)!((RULE=1056)&(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 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)),CNTRL^VALM10(LINE,26,$L(NOTEARY(I)),IOINHI,IOINORM)
.I '$D(NOTEARY) D
..S LINE=LINE+1 D SET^VALM10(LINE,"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 D SET^VALM10(LINE,"Change Request Reason Text: ")
. S I=0 F S I=$O(RET(I)) Q:I="" S LINE=LINE+1 D SET^VALM10(LINE,RET(I)),CNTRL^VALM10(LINE,1,80,IOINHI,IOINORM)
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"))
.I $G(SDERXFLG) D DISPRX^PSOERSE3 Q
.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) ;
D CXRES^PSOERX1E
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,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")
I '$G(SDERXFLG) S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"****************************MEDICATIONREQUESTED "_CNT_"****************************")
I $G(SDERXFLG) D SET^VALM10(LINE," MEDICATION REQUESTED "_CNT_" "),CNTRL^VALM10(LINE,1,80,IOUON_IOINHI,IOUOFF_IOINORM)
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))
. D CNTRL^VALM10(LINE,7,$L(NOTEARY(I)),IOINHI,IOINORM)
S LINE=LINE+1 D SET^VALM10(LINE,"Substitutions: "_SUB),CNTRL^VALM10(LINE,16,$L(SUB),IOINHI,IOINORM)
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)
D CNTRL^VALM10(LINE,6,$L(QTY),IOINHI,IOINORM)
D CNTRL^VALM10(LINE,33,$L(REFILL),IOINHI,IOINORM)
D CNTRL^VALM10(LINE,58,$L(DAYSUP),IOINHI,IOINORM)
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)
. . D CNTRL^VALM10(LINE,27,$L(NOTEARY(I)),IOINHI,IOINORM)
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
. D TXT2ARY^PSOERXD1(.SIGARY,SIGDATA," ",75)
. S I=0 F S I=$O(SIGARY(I)) Q:I="" D
. . S LINE=LINE+1
. . I I=1 D SET^VALM10(LINE,"Sig: "_SIGARY(I)),CNTRL^VALM10(LINE,6,$L(SIGARY(I)),IOINHI,IOINORM) Q
. . D SET^VALM10(LINE,$J("",5)_SIGARY(I)),CNTRL^VALM10(LINE,6,$L(SIGARY(I)),IOINHI,IOINORM)
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")&('$G(SDERXFLG)) S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"************************RXCHANGE REQUEST INFORMATION**************************")
I $G(SDERXFLG) D SET^VALM10(LINE," RXCHANGE REQUEST INFORMATION "),CNTRL^VALM10(LINE,1,80,IOUON_IOINHI,IOUOFF_IOINORM)
D SET^PSOERX1D(.LINE,"Requested By: ",REQBY),CNTRL^VALM10(LINE,15,$L(REQBY),IOINHI,IOINORM)
D SET^PSOERX1D(.LINE,"Request Date/Time: ",REQDTTM),CNTRL^VALM10(LINE,20,$L(REQDTTM),IOINHI,IOINORM)
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)
. . D CNTRL^VALM10(LINE,28,$L(COMMARY(I)),IOINHI,IOINORM)
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)
D CNTRL^VALM10(LINE,14,$L(COMMBY),IOINHI,IOINORM)
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,SDSPLAY) ; 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)),CNTRL^VALM10(LINE,7,$L(NOTEARY(I)),IOINHI,IOINORM)
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 14803 printed Sep 11, 2024@02:48:01 Page 2
PSOERX1D ;ALB/JSG - eRx Utilities ; 11/27/2019 11:02am
+1 ;;7.0;OUTPATIENT PHARMACY;**581,617,746**;DEC 1997;Build 106
+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,X,REATXT
+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)
DO CNTRL^VALM10(LINE,22,$LENGTH(CHGMESRE),IOINHI,IOINORM)
+4 IF (RULE=1060)!((RULE=1056)&(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
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))
DO CNTRL^VALM10(LINE,26,$LENGTH(NOTEARY(I)),IOINHI,IOINORM)
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 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
DO SET^VALM10(LINE,"Change Request Reason Text: ")
+24 SET I=0
FOR
SET I=$ORDER(RET(I))
if I=""
QUIT
SET LINE=LINE+1
DO SET^VALM10(LINE,RET(I))
DO CNTRL^VALM10(LINE,1,80,IOINHI,IOINORM)
End DoDot:1
+25 IF RULE?1(1"1058",1"1059",1"1060")
Begin DoDot:1
+26 SET NO311='$DATA(^PS(52.49,PSOIEN,311))
End DoDot:1
+27 IF RULE'?1(1"1058",1"1059",1"1060")
Begin DoDot:1
+28 SET NO311=0
End DoDot:1
+29 IF NO311
Begin DoDot:1
+30 DO RESTSMDT(1,PSOIEN,RESPVAL,RULE,.LINE)
End DoDot:1
+31 QUIT NO311
+32 ;
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 IF $GET(SDERXFLG)
DO DISPRX^PSOERSE3
QUIT
+6 DO DISPRX^PSOERX1G
End DoDot:1
+7 IF RULE?1(1"1059",1"1060",1"1056",1"1062".E)
Begin DoDot:1
+8 DO PHCHREQ^PSOERX1E(PSOIEN,RULE,.LINE)
End DoDot:1
+9 SET CHGMESRQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"I")
+10 DO CXRES(PSOIEN,RESPVAL,RULE,"1058,1059,1060,0",.LINE)
+11 ;
IF RULE?1(1"1058",1"1043",1"0")
Begin DoDot:1
+12 DO MEDREQDR(PSOIEN,RULE,.LINE)
End DoDot:1
+13 DO CXREQ(PSOIEN,RULE,.LINE)
+14 DO MSGHIS^PSOERXU3(PSOIEN,.LINE)
+15 QUIT
+16 ;
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 DO CXRES^PSOERX1E
+2 QUIT
+3 ;
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,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 IF '$GET(SDERXFLG)
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+12 SET LINE=LINE+1
DO SET^VALM10(LINE,"****************************MEDICATIONREQUESTED "_CNT_"****************************")
+13 IF $GET(SDERXFLG)
DO SET^VALM10(LINE," MEDICATION REQUESTED "_CNT_" ")
DO CNTRL^VALM10(LINE,1,80,IOUON_IOINHI,IOUOFF_IOINORM)
+14 KILL NOTEARY
+15 DO TXT2ARY^PSOERXD1(.NOTEARY,DRUG_" "_$PIECE($$ERXDRSCH^PSOERXUT(ERXIEN),"^",2)," ",74)
+16 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:1
+17 SET LINE=LINE+1
+18 DO SET^VALM10(LINE,$SELECT(I=1:"Drug: ",1:$JUSTIFY("",6))_NOTEARY(I))
+19 DO CNTRL^VALM10(LINE,7,$LENGTH(NOTEARY(I)),IOINHI,IOINORM)
End DoDot:1
+20 SET LINE=LINE+1
DO SET^VALM10(LINE,"Substitutions: "_SUB)
DO CNTRL^VALM10(LINE,16,$LENGTH(SUB),IOINHI,IOINORM)
+21 DO NOTE(NOTE,"Note: ",1,.LINE)
+22 SET LTXT=""
+23 DO ADDITEM^PSOERX1A(.LTXT,"Qty: ",QTY,1,22)
+24 DO ADDITEM^PSOERX1A(.LTXT,"Refills: ",REFILL,23,21)
+25 DO ADDITEM^PSOERX1A(.LTXT,"Days Supply: ",DAYSUP,44,37)
+26 SET LINE=LINE+1
DO SET^VALM10(LINE,LTXT)
+27 DO CNTRL^VALM10(LINE,6,$LENGTH(QTY),IOINHI,IOINORM)
+28 DO CNTRL^VALM10(LINE,33,$LENGTH(REFILL),IOINHI,IOINORM)
+29 DO CNTRL^VALM10(LINE,58,$LENGTH(DAYSUP),IOINHI,IOINORM)
+30 IF QUOM=""
Begin DoDot:1
+31 SET LINE=LINE+1
DO SET^VALM10(LINE,"Quantity Unit Of Measure:")
End DoDot:1
+32 IF QUOM]""
Begin DoDot:1
+33 KILL NOTEARY
+34 DO TXT2ARY^PSOERXD1(.NOTEARY,QUOM," ",54)
+35 SET I=0
FOR
SET I=$ORDER(NOTEARY(I))
if 'I
QUIT
Begin DoDot:2
+36 SET TXT=$SELECT(I=1:"Quantity Unit Of Measure: ",1:$JUSTIFY("",26))_NOTEARY(I)
+37 SET LINE=LINE+1
DO SET^VALM10(LINE,TXT)
+38 DO CNTRL^VALM10(LINE,27,$LENGTH(NOTEARY(I)),IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+39 SET SIGDATA=""
+40 SET I=0
FOR
SET I=$ORDER(^PS(52.49,REQIEN,311,IEN311,8,I))
if 'I
QUIT
Begin DoDot:1
+41 SET SIGDATA=SIGDATA_^PS(52.49,REQIEN,311,IEN311,8,I,0)_" "
End DoDot:1
+42 IF $GET(SIGDATA)'=""
Begin DoDot:1
+43 DO TXT2ARY^PSOERXD1(.SIGARY,SIGDATA," ",75)
+44 SET I=0
FOR
SET I=$ORDER(SIGARY(I))
if I=""
QUIT
Begin DoDot:2
+45 SET LINE=LINE+1
+46 IF I=1
DO SET^VALM10(LINE,"Sig: "_SIGARY(I))
DO CNTRL^VALM10(LINE,6,$LENGTH(SIGARY(I)),IOINHI,IOINORM)
QUIT
+47 DO SET^VALM10(LINE,$JUSTIFY("",5)_SIGARY(I))
DO CNTRL^VALM10(LINE,6,$LENGTH(SIGARY(I)),IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+48 QUIT
+49 ; 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")&('$GET(SDERXFLG))
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+9 SET LINE=LINE+1
DO SET^VALM10(LINE,"************************RXCHANGE REQUEST INFORMATION**************************")
+10 IF $GET(SDERXFLG)
DO SET^VALM10(LINE," RXCHANGE REQUEST INFORMATION ")
DO CNTRL^VALM10(LINE,1,80,IOUON_IOINHI,IOUOFF_IOINORM)
+11 DO SET^PSOERX1D(.LINE,"Requested By: ",REQBY)
DO CNTRL^VALM10(LINE,15,$LENGTH(REQBY),IOINHI,IOINORM)
+12 DO SET^PSOERX1D(.LINE,"Request Date/Time: ",REQDTTM)
DO CNTRL^VALM10(LINE,20,$LENGTH(REQDTTM),IOINHI,IOINORM)
+13 KILL COMMARY
+14 DO TXT2ARY^PSOERXD1(.COMMARY,COMM," ",53)
+15 IF $DATA(COMMARY)
Begin DoDot:1
+16 SET I=0
FOR
SET I=$ORDER(COMMARY(I))
if 'I
QUIT
Begin DoDot:2
+17 SET CTXT=$SELECT(I=1:"RxChange Request Comments: ",1:$JUSTIFY("",27))_COMMARY(I)
+18 SET LINE=LINE+1
DO SET^VALM10(LINE,CTXT)
+19 DO CNTRL^VALM10(LINE,28,$LENGTH(COMMARY(I)),IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+20 IF '$DATA(COMMARY)
Begin DoDot:1
+21 SET LINE=LINE+1
DO SET^VALM10(LINE,"RxChange Request Comments:")
End DoDot:1
+22 SET COMMBY=$$GET1^DIQ(52.49,REQIEN,50.1,"E")
+23 SET COMMDTTM=$$GET1^DIQ(52.49,REQIEN,50.2,"E")
+24 SET LINE=LINE+1
DO SET^VALM10(LINE,"Comments By: "_COMMBY)
+25 DO CNTRL^VALM10(LINE,14,$LENGTH(COMMBY),IOINHI,IOINORM)
+26 QUIT
+27 ;
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,SDSPLAY) ; 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))
DO CNTRL^VALM10(LINE,7,$LENGTH(NOTEARY(I)),IOINHI,IOINORM)
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)
