PSOERHL1 ;BIRM/MFR - eRx History Log View continued - Listman Driver ;04/12/23
;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
;
GETDATA(ERXNUM) ;Determine data to display for messages
N MESSTYPE,CHKTYPE,STATDT,ERXHUB,ERXSTEX,ERXSTIN,ERXSTCK,ERXST,X2
S MESSTYPE=$$GET1^DIQ(52.49,ERXNUM,.08)
S CHKTYPE=$$GET1^DIQ(52.49,ERXNUM,.08,"I")
S STATDT=$$GET1^DIQ(52.49,ERXNUM,.03,"I")
S ERXHUB=$$GET1^DIQ(52.49,ERXNUM,.01)
S ERXSTEX=$$GET1^DIQ(52.49,ERXNUM,1)
S ERXSTIN=$$GET1^DIQ(52.49,ERXNUM,1,"I")
S ERXSTCK=$E($$GET1^DIQ(52.49,ERXNUM,1,"E"),1,2)
S ERXST=$E($$GET1^DIQ(52.45,ERXSTIN,.02),1,59)
S X2=$$FMTE^XLFDT($G(STATDT),"2Z"),$E(X2,19)=MESSTYPE,$E(X2,37)=ERXHUB,$E(X2,63)=ERXSTEX
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X2
I $G(ERXST)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Status Description: "_ERXST,HIGHLN(LINE)="1^80"
;RXChange Request
I CHKTYPE="CR" D
. N MCODE,CODEIEN,SRCODE,REQDESC,CODETYP,PHNOTE,I,CMCODE,CMSUB,X2
. S MCODE=$$GET1^DIQ(52.49,ERXNUM,315.1)
. S CODEIEN=$$GET1^DIQ(52.49,ERXNUM,315.1,"I")
. S SRCODE=$$GET1^DIQ(52.45,CODEIEN,.01,"E")
. S REQDESC=$E($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,44)
. S CODETYP=$$GET1^DIQ(52.45,CODEIEN,.03,"E")
. S PHNOTE=$E($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,64)
. S X2="MessageRequestCode/Description: "_SRCODE_"/"_REQDESC
. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X2
. S I=0 F S I=$O(^PS(52.49,ERXNUM,316,I)) Q:'I D
. . S IENS=$O(^PS(52.49,ERXNUM,316,I,0)),IENS=IENS_","_ERXNUM_","
. . S CMCODE=$$GET1^DIQ(52.49316,IENS,1,"I")
. . S CMSUB=$E($$GET1^DIQ(52.45,CMCODE,.02,"E"),1,63)
. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="MessageSubType: "_CMSUB,HIGHLN(LINE)="1^80"
. I $G(PHNOTE)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Pharmacy Note: "_PHNOTE,HIGHLN(LINE)="1^80"
;Inbound Error
I CHKTYPE="IE" D
. N ERRCODE,ERRDCI,ERRDCE,ERRTXT,I
. S ERRCODE=$$GET1^DIQ(52.49,ERXNUM,60.1,"I")
. S ERRTXT=$E($$GET1^DIQ(52.49,ERXNUM,60),1,67)
. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Error Code: "_ERRCODE
. S I=0 F S I=$O(^PS(52.49,ERXNUM,61,I)) Q:'I D
. . S ERRDCI=$$GET1^DIQ(52.4961,I_","_ERXNUM_",",.01,"I")
. . S ERRDCE=$$GET1^DIQ(52.4961,I_","_ERXNUM_",",.01,"E")
. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Error DCode(s): "_ERRDCI_" - "_ERRDCE
. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Error Text: "_ERRTXT,HIGHLN(LINE)="1^80"
;RXChange Response
I CHKTYPE="CX" D
. N RVALUE,IENS,I,RESCODE,CODEIEN,SRCODE,RESDESC,CTABB,PNOTE,PCOMM,X2,DFLAG
. S RVALUE=$$GET1^DIQ(52.49,ERXNUM,52.1)
. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Value: "_RVALUE
. S IENS=ERXNUM_","
. S I=0 F S I=$O(^PS(52.49,ERXNUM,55,I)) Q:'I D
. . I '$G(DFLAG) S DFLAG=1,LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Code(s): "
. . S RESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
. . S CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
. . S SRCODE=$$GET1^DIQ(52.45,CODEIEN,.01,"E")
. . S RESDESC=$E($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,60)
. . S CTABB=$$GET1^DIQ(52.45,CODEIEN,.03,"E")
. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=" - "_RESDESC_" ("_SRCODE_")"
. S PNOTE=$$GET1^DIQ(52.49,ERXNUM,52.2,"E")
. S PCOMM=$E($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,52)
. I $G(PNOTE)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Prescriber Note: "_PNOTE,HIGHLN(LINE)="1^80"
. I $G(PCOMM)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Pharmacy Note: "_PCOMM,HIGHLN(LINE)="1^80"
;RXRenewal Response
I CHKTYPE="RE" D
. N RCODE,IENS,RVALUE,RDTTM,RNOTE,RCOMM,RCOMBY,RCOMDT,RESCODE,CODEIEN,RESDESC,X2
. S RCODE=$$GET1^DIQ(52.49,ERXNUM,52.1,"I")
. I RCODE'="D" Q ;Only Denied Response Value
. S IENS=ERXNUM_","
. S RVALUE=$$GET1^DIQ(52.49,ERXNUM,52.1,"E")
. S RDTTM=$$GET1^DIQ(52.49,ERXNUM,.03,"I")
. S RNOTE=$E($$GET1^DIQ(52.49,ERXNUM,52.2,"E"),1,64)
. S RCOMM=$E($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,60)
. S RCOMBY=$E($$GET1^DIQ(52.49,ERXNUM,50.1,"E"),1,57)
. S RCOMDT=$$GET1^DIQ(52.49,ERXNUM,50.2,"I")
. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Value: "_RVALUE
. I $G(RNOTE)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Note: "_RNOTE,HIGHLN(LINE)="1^80"
. I $G(RCOMM)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Comments: "_RCOMM,HIGHLN(LINE)="1^80"
. I $G(RCOMM)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Comments Date/Time: "_$$FMTE^XLFDT(RCOMDT,"2Z")
. I $G(RCOMBY)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Comments By: "_RCOMBY
. S I=0 F S I=$O(^PS(52.49,ERXNUM,55,I)) Q:'I D
. . S RESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
. . S CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
. . S RESDESC=$E($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,54)
. . ;S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=RVALUE_" Reason Code: "_RESCODE
. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=RVALUE_" Reason Description: "_RESDESC,HIGHLN(LINE)="1^80"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERHL1 4888 printed Dec 13, 2024@02:27:43 Page 2
PSOERHL1 ;BIRM/MFR - eRx History Log View continued - Listman Driver ;04/12/23
+1 ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
+2 ;
GETDATA(ERXNUM) ;Determine data to display for messages
+1 NEW MESSTYPE,CHKTYPE,STATDT,ERXHUB,ERXSTEX,ERXSTIN,ERXSTCK,ERXST,X2
+2 SET MESSTYPE=$$GET1^DIQ(52.49,ERXNUM,.08)
+3 SET CHKTYPE=$$GET1^DIQ(52.49,ERXNUM,.08,"I")
+4 SET STATDT=$$GET1^DIQ(52.49,ERXNUM,.03,"I")
+5 SET ERXHUB=$$GET1^DIQ(52.49,ERXNUM,.01)
+6 SET ERXSTEX=$$GET1^DIQ(52.49,ERXNUM,1)
+7 SET ERXSTIN=$$GET1^DIQ(52.49,ERXNUM,1,"I")
+8 SET ERXSTCK=$EXTRACT($$GET1^DIQ(52.49,ERXNUM,1,"E"),1,2)
+9 SET ERXST=$EXTRACT($$GET1^DIQ(52.45,ERXSTIN,.02),1,59)
+10 SET X2=$$FMTE^XLFDT($GET(STATDT),"2Z")
SET $EXTRACT(X2,19)=MESSTYPE
SET $EXTRACT(X2,37)=ERXHUB
SET $EXTRACT(X2,63)=ERXSTEX
+11 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+12 IF $GET(ERXST)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Status Description: "_ERXST
SET HIGHLN(LINE)="1^80"
+13 ;RXChange Request
+14 IF CHKTYPE="CR"
Begin DoDot:1
+15 NEW MCODE,CODEIEN,SRCODE,REQDESC,CODETYP,PHNOTE,I,CMCODE,CMSUB,X2
+16 SET MCODE=$$GET1^DIQ(52.49,ERXNUM,315.1)
+17 SET CODEIEN=$$GET1^DIQ(52.49,ERXNUM,315.1,"I")
+18 SET SRCODE=$$GET1^DIQ(52.45,CODEIEN,.01,"E")
+19 SET REQDESC=$EXTRACT($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,44)
+20 SET CODETYP=$$GET1^DIQ(52.45,CODEIEN,.03,"E")
+21 SET PHNOTE=$EXTRACT($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,64)
+22 SET X2="MessageRequestCode/Description: "_SRCODE_"/"_REQDESC
+23 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+24 SET I=0
FOR
SET I=$ORDER(^PS(52.49,ERXNUM,316,I))
if 'I
QUIT
Begin DoDot:2
+25 SET IENS=$ORDER(^PS(52.49,ERXNUM,316,I,0))
SET IENS=IENS_","_ERXNUM_","
+26 SET CMCODE=$$GET1^DIQ(52.49316,IENS,1,"I")
+27 SET CMSUB=$EXTRACT($$GET1^DIQ(52.45,CMCODE,.02,"E"),1,63)
+28 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="MessageSubType: "_CMSUB
SET HIGHLN(LINE)="1^80"
End DoDot:2
+29 IF $GET(PHNOTE)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Pharmacy Note: "_PHNOTE
SET HIGHLN(LINE)="1^80"
End DoDot:1
+30 ;Inbound Error
+31 IF CHKTYPE="IE"
Begin DoDot:1
+32 NEW ERRCODE,ERRDCI,ERRDCE,ERRTXT,I
+33 SET ERRCODE=$$GET1^DIQ(52.49,ERXNUM,60.1,"I")
+34 SET ERRTXT=$EXTRACT($$GET1^DIQ(52.49,ERXNUM,60),1,67)
+35 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Error Code: "_ERRCODE
+36 SET I=0
FOR
SET I=$ORDER(^PS(52.49,ERXNUM,61,I))
if 'I
QUIT
Begin DoDot:2
+37 SET ERRDCI=$$GET1^DIQ(52.4961,I_","_ERXNUM_",",.01,"I")
+38 SET ERRDCE=$$GET1^DIQ(52.4961,I_","_ERXNUM_",",.01,"E")
+39 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Error DCode(s): "_ERRDCI_" - "_ERRDCE
End DoDot:2
+40 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Error Text: "_ERRTXT
SET HIGHLN(LINE)="1^80"
End DoDot:1
+41 ;RXChange Response
+42 IF CHKTYPE="CX"
Begin DoDot:1
+43 NEW RVALUE,IENS,I,RESCODE,CODEIEN,SRCODE,RESDESC,CTABB,PNOTE,PCOMM,X2,DFLAG
+44 SET RVALUE=$$GET1^DIQ(52.49,ERXNUM,52.1)
+45 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Response Value: "_RVALUE
+46 SET IENS=ERXNUM_","
+47 SET I=0
FOR
SET I=$ORDER(^PS(52.49,ERXNUM,55,I))
if 'I
QUIT
Begin DoDot:2
+48 IF '$GET(DFLAG)
SET DFLAG=1
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Response Code(s): "
+49 SET RESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
+50 SET CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
+51 SET SRCODE=$$GET1^DIQ(52.45,CODEIEN,.01,"E")
+52 SET RESDESC=$EXTRACT($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,60)
+53 SET CTABB=$$GET1^DIQ(52.45,CODEIEN,.03,"E")
+54 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=" - "_RESDESC_" ("_SRCODE_")"
End DoDot:2
+55 SET PNOTE=$$GET1^DIQ(52.49,ERXNUM,52.2,"E")
+56 SET PCOMM=$EXTRACT($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,52)
+57 IF $GET(PNOTE)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Prescriber Note: "_PNOTE
SET HIGHLN(LINE)="1^80"
+58 IF $GET(PCOMM)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Pharmacy Note: "_PCOMM
SET HIGHLN(LINE)="1^80"
End DoDot:1
+59 ;RXRenewal Response
+60 IF CHKTYPE="RE"
Begin DoDot:1
+61 NEW RCODE,IENS,RVALUE,RDTTM,RNOTE,RCOMM,RCOMBY,RCOMDT,RESCODE,CODEIEN,RESDESC,X2
+62 SET RCODE=$$GET1^DIQ(52.49,ERXNUM,52.1,"I")
+63 ;Only Denied Response Value
IF RCODE'="D"
QUIT
+64 SET IENS=ERXNUM_","
+65 SET RVALUE=$$GET1^DIQ(52.49,ERXNUM,52.1,"E")
+66 SET RDTTM=$$GET1^DIQ(52.49,ERXNUM,.03,"I")
+67 SET RNOTE=$EXTRACT($$GET1^DIQ(52.49,ERXNUM,52.2,"E"),1,64)
+68 SET RCOMM=$EXTRACT($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,60)
+69 SET RCOMBY=$EXTRACT($$GET1^DIQ(52.49,ERXNUM,50.1,"E"),1,57)
+70 SET RCOMDT=$$GET1^DIQ(52.49,ERXNUM,50.2,"I")
+71 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Response Value: "_RVALUE
+72 IF $GET(RNOTE)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Response Note: "_RNOTE
SET HIGHLN(LINE)="1^80"
+73 IF $GET(RCOMM)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Response Comments: "_RCOMM
SET HIGHLN(LINE)="1^80"
+74 IF $GET(RCOMM)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Response Comments Date/Time: "_$$FMTE^XLFDT(RCOMDT,"2Z")
+75 IF $GET(RCOMBY)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Response Comments By: "_RCOMBY
+76 SET I=0
FOR
SET I=$ORDER(^PS(52.49,ERXNUM,55,I))
if 'I
QUIT
Begin DoDot:2
+77 SET RESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
+78 SET CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
+79 SET RESDESC=$EXTRACT($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,54)
+80 ;S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=RVALUE_" Reason Code: "_RESCODE
+81 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=RVALUE_" Reason Description: "_RESDESC
SET HIGHLN(LINE)="1^80"
End DoDot:2
End DoDot:1
+82 QUIT
