Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERHL1

PSOERHL1.m

Go to the documentation of this file.
  1. PSOERHL1 ;BIRM/MFR - eRx History Log View continued - Listman Driver ;04/12/23
  1. ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
  1. ;
  1. GETDATA(ERXNUM) ;Determine data to display for messages
  1. N MESSTYPE,CHKTYPE,STATDT,ERXHUB,ERXSTEX,ERXSTIN,ERXSTCK,ERXST,X2
  1. S MESSTYPE=$$GET1^DIQ(52.49,ERXNUM,.08)
  1. S CHKTYPE=$$GET1^DIQ(52.49,ERXNUM,.08,"I")
  1. S STATDT=$$GET1^DIQ(52.49,ERXNUM,.03,"I")
  1. S ERXHUB=$$GET1^DIQ(52.49,ERXNUM,.01)
  1. S ERXSTEX=$$GET1^DIQ(52.49,ERXNUM,1)
  1. S ERXSTIN=$$GET1^DIQ(52.49,ERXNUM,1,"I")
  1. S ERXSTCK=$E($$GET1^DIQ(52.49,ERXNUM,1,"E"),1,2)
  1. S ERXST=$E($$GET1^DIQ(52.45,ERXSTIN,.02),1,59)
  1. S X2=$$FMTE^XLFDT($G(STATDT),"2Z"),$E(X2,19)=MESSTYPE,$E(X2,37)=ERXHUB,$E(X2,63)=ERXSTEX
  1. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X2
  1. I $G(ERXST)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Status Description: "_ERXST,HIGHLN(LINE)="1^80"
  1. ;RXChange Request
  1. I CHKTYPE="CR" D
  1. . N MCODE,CODEIEN,SRCODE,REQDESC,CODETYP,PHNOTE,I,CMCODE,CMSUB,X2
  1. . S MCODE=$$GET1^DIQ(52.49,ERXNUM,315.1)
  1. . S CODEIEN=$$GET1^DIQ(52.49,ERXNUM,315.1,"I")
  1. . S SRCODE=$$GET1^DIQ(52.45,CODEIEN,.01,"E")
  1. . S REQDESC=$E($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,44)
  1. . S CODETYP=$$GET1^DIQ(52.45,CODEIEN,.03,"E")
  1. . S PHNOTE=$E($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,64)
  1. . S X2="MessageRequestCode/Description: "_SRCODE_"/"_REQDESC
  1. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X2
  1. . S I=0 F S I=$O(^PS(52.49,ERXNUM,316,I)) Q:'I D
  1. . . S IENS=$O(^PS(52.49,ERXNUM,316,I,0)),IENS=IENS_","_ERXNUM_","
  1. . . S CMCODE=$$GET1^DIQ(52.49316,IENS,1,"I")
  1. . . S CMSUB=$E($$GET1^DIQ(52.45,CMCODE,.02,"E"),1,63)
  1. . . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="MessageSubType: "_CMSUB,HIGHLN(LINE)="1^80"
  1. . I $G(PHNOTE)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Pharmacy Note: "_PHNOTE,HIGHLN(LINE)="1^80"
  1. ;Inbound Error
  1. I CHKTYPE="IE" D
  1. . N ERRCODE,ERRDCI,ERRDCE,ERRTXT,I
  1. . S ERRCODE=$$GET1^DIQ(52.49,ERXNUM,60.1,"I")
  1. . S ERRTXT=$E($$GET1^DIQ(52.49,ERXNUM,60),1,67)
  1. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Error Code: "_ERRCODE
  1. . S I=0 F S I=$O(^PS(52.49,ERXNUM,61,I)) Q:'I D
  1. . . S ERRDCI=$$GET1^DIQ(52.4961,I_","_ERXNUM_",",.01,"I")
  1. . . S ERRDCE=$$GET1^DIQ(52.4961,I_","_ERXNUM_",",.01,"E")
  1. . . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Error DCode(s): "_ERRDCI_" - "_ERRDCE
  1. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Error Text: "_ERRTXT,HIGHLN(LINE)="1^80"
  1. ;RXChange Response
  1. I CHKTYPE="CX" D
  1. . N RVALUE,IENS,I,RESCODE,CODEIEN,SRCODE,RESDESC,CTABB,PNOTE,PCOMM,X2,DFLAG
  1. . S RVALUE=$$GET1^DIQ(52.49,ERXNUM,52.1)
  1. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Value: "_RVALUE
  1. . S IENS=ERXNUM_","
  1. . S I=0 F S I=$O(^PS(52.49,ERXNUM,55,I)) Q:'I D
  1. . . I '$G(DFLAG) S DFLAG=1,LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Code(s): "
  1. . . S RESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
  1. . . S CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
  1. . . S SRCODE=$$GET1^DIQ(52.45,CODEIEN,.01,"E")
  1. . . S RESDESC=$E($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,60)
  1. . . S CTABB=$$GET1^DIQ(52.45,CODEIEN,.03,"E")
  1. . . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=" - "_RESDESC_" ("_SRCODE_")"
  1. . S PNOTE=$$GET1^DIQ(52.49,ERXNUM,52.2,"E")
  1. . S PCOMM=$E($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,52)
  1. . I $G(PNOTE)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Prescriber Note: "_PNOTE,HIGHLN(LINE)="1^80"
  1. . I $G(PCOMM)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Pharmacy Note: "_PCOMM,HIGHLN(LINE)="1^80"
  1. ;RXRenewal Response
  1. I CHKTYPE="RE" D
  1. . N RCODE,IENS,RVALUE,RDTTM,RNOTE,RCOMM,RCOMBY,RCOMDT,RESCODE,CODEIEN,RESDESC,X2
  1. . S RCODE=$$GET1^DIQ(52.49,ERXNUM,52.1,"I")
  1. . I RCODE'="D" Q ;Only Denied Response Value
  1. . S IENS=ERXNUM_","
  1. . S RVALUE=$$GET1^DIQ(52.49,ERXNUM,52.1,"E")
  1. . S RDTTM=$$GET1^DIQ(52.49,ERXNUM,.03,"I")
  1. . S RNOTE=$E($$GET1^DIQ(52.49,ERXNUM,52.2,"E"),1,64)
  1. . S RCOMM=$E($$GET1^DIQ(52.49,ERXNUM,50,"E"),1,60)
  1. . S RCOMBY=$E($$GET1^DIQ(52.49,ERXNUM,50.1,"E"),1,57)
  1. . S RCOMDT=$$GET1^DIQ(52.49,ERXNUM,50.2,"I")
  1. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Value: "_RVALUE
  1. . I $G(RNOTE)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Note: "_RNOTE,HIGHLN(LINE)="1^80"
  1. . I $G(RCOMM)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Comments: "_RCOMM,HIGHLN(LINE)="1^80"
  1. . I $G(RCOMM)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Comments Date/Time: "_$$FMTE^XLFDT(RCOMDT,"2Z")
  1. . I $G(RCOMBY)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Response Comments By: "_RCOMBY
  1. . S I=0 F S I=$O(^PS(52.49,ERXNUM,55,I)) Q:'I D
  1. . . S RESCODE=$$GET1^DIQ(52.4955,I_","_IENS,.01,"E")
  1. . . S CODEIEN=$$GET1^DIQ(52.4955,I_","_IENS,.01,"I")
  1. . . S RESDESC=$E($$GET1^DIQ(52.45,CODEIEN,.02,"E"),1,54)
  1. . . ;S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=RVALUE_" Reason Code: "_RESCODE
  1. . . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=RVALUE_" Reason Description: "_RESDESC,HIGHLN(LINE)="1^80"
  1. Q