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