- 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 Feb 18, 2025@23:54:26 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 ;