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

PSOERXAU.m

Go to the documentation of this file.
  1. PSOERXAU ;BIRM/MFR - eRx Audit Log View - Listmam Driver ;11/02/20
  1. ;;7.0;OUTPATIENT PHARMACY;**617,651**;DEC 1997;Build 30
  1. ;
  1. EN(PSOERXID) ;Menu option entry point
  1. N PSOSRTBY,PSORDER,SHOWERX,UNDLN,HIGHLN,REVLN,LASTLINE,VALMCNT
  1. ;
  1. S PSOSRTBY="DT",PSORDER="A",SHOWERX=0
  1. W !,"Please wait..."
  1. D EN^VALM("PSO ERX AUDIT LOG")
  1. D FULL^VALM1
  1. G EXIT
  1. ;
  1. HDR ;Header
  1. N LINE,POS,LINE1,LINE2,LINE3,LINE4,WT,WTDT,HT,HTDT,VADM,DFN,PNAME,DOB,SEX,X,GMRAL,ADVREA
  1. K VALMHDR S VALMHDR(1)="eRx Patient: "_$$GET1^DIQ(52.49,PSOERXID,.04,"E")
  1. S VALMHDR(2)="eRx Reference #: "_$$GET1^DIQ(52.49,PSOERXID,.01)
  1. D SETHDR
  1. Q
  1. ;
  1. INIT ;Populates the Body section for ListMan
  1. K ^TMP("PSOERXAU",$J),^TMP("PSOAUDSR",$J)
  1. D SETSORT(PSOSRTBY),SETLINE,SETHDR
  1. Q
  1. ;
  1. SETLINE ;Sets the line to be displayed in ListMan
  1. N TYPE,SRT,AUD,LINE,ZAUD,TOTAL,I,X,X1
  1. K ^TMP("PSOERXAU",$J) S VALMCNT=0
  1. ;
  1. I '$D(^TMP("PSOAUDSR",$J)) D Q
  1. . F I=1:1:6 S ^TMP("PSOERXAU",$J,I,0)=""
  1. . S ^TMP("PSOERXAU",$J,7,0)=" No Audit Log for this eRx"
  1. . S VALMCNT=1
  1. ;
  1. ;Resetting list to NORMAL video attributes
  1. F I=1:1:$G(LASTLINE) D RESTORE^VALM10(I)
  1. K UNDLN,HIGHLN,REVLN
  1. ;Building the list (line by line)
  1. S (SRT,AUD)="",LINE=0 K ^TMP("PSOERXAU",$J)
  1. S SRT=$S(PSORDER="D":"zzz",1:""),ORDER=$S(PSORDER="D":-1,1:1)
  1. F S SRT=$O(^TMP("PSOAUDSR",$J,SRT),ORDER) Q:SRT="" D
  1. . F S AUD=$O(^TMP("PSOAUDSR",$J,SRT,AUD)) Q:AUD="" D
  1. . . S ZAUD=$G(^TMP("PSOAUDSR",$J,SRT,AUD))
  1. . . S X1=$$FMTE^XLFDT($P(ZAUD,"^")),$E(X1,28)=$P(ZAUD,"^",2),$E(X1,54)=$E($$GET1^DIQ(200,+$P(ZAUD,"^",3),.01),1,26)
  1. . . S LINE=LINE+1,^TMP("PSOERXAU",$J,LINE,0)=X1,UNDLN(LINE)="1^80"
  1. . . I $G(SHOWERX) D ERXVAL(PSOERXID,$P(ZAUD,"^",2))
  1. . . D SETVALUE(PSOERXID,$P(ZAUD,"^",2),AUD,"OLD")
  1. . . D SETVALUE(PSOERXID,$P(ZAUD,"^",2),AUD,"NEW")
  1. . . S LINE=LINE+1,^TMP("PSOERXAU",$J,LINE,0)=""
  1. ;
  1. ;Saving NORMAL video attributes to be reset later
  1. I LINE>$G(LASTLINE) D
  1. . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
  1. . S LASTLINE=LINE
  1. S VALMCNT=+$G(LINE)
  1. D VIDEO
  1. Q
  1. ;
  1. VIDEO ; - Changes the Video Attributes for the list
  1. ; - Highlighting the group lines (order type and status)
  1. N LN
  1. F LN=1:1:LASTLINE D
  1. . I $G(UNDLN(LN)) D CNTRL^VALM10(LN,+UNDLN(LN),$P(UNDLN(LN),"^",2),IOUON,IOINORM)
  1. . I $G(HIGHLN(LN)) D CNTRL^VALM10(LN,+HIGHLN(LN),$P(HIGHLN(LN),"^",2),IOINHI,IOINORM)
  1. . I $G(REVLN(LN)) D CNTRL^VALM10(LN,+REVLN(LN),$P(REVLN(LN),"^",2),IORVON,IORVOFF)
  1. Q
  1. ;
  1. SETSORT(SORTBY) ;Sets the data sorted by the SORTBY specified
  1. N AUD,ZAUD,DATETIME,FLDNAME,EDITEDBY,I
  1. K ^TMP("PSOAUDSR",$J)
  1. ;Loading eRx Audit Log (Sorted)
  1. S AUD=0
  1. F S AUD=$O(^PS(52.49,PSOERXID,"AUD",AUD)) Q:'AUD D
  1. . S ZAUD=$G(^PS(52.49,PSOERXID,"AUD",AUD,0))
  1. . S DATETIME=$P(ZAUD,"^",1)
  1. . S FLDNAME=$P(ZAUD,"^",2)
  1. . S EDITEDBY=$P(ZAUD,"^",3)
  1. . S SORT=$S(SORTBY="DT":DATETIME,SORTBY="FN":FLDNAME,SORTBY="EB":$$GET1^DIQ(200,EDITEDBY,.01))
  1. . S ^TMP("PSOAUDSR",$J,SORT,AUD)=ZAUD
  1. . F I=1:1 Q:'$D(^PS(52.49,PSOERXID,"AUD",AUD,"VAL",I)) D
  1. . . S ^TMP("PSOAUDSR",$J,SORT,AUD,"VAL",I)=^PS(52.49,PSOERXID,"AUD",AUD,"VAL",I,0)
  1. Q
  1. ;
  1. DT ;Sort by Date/Time
  1. D SORT("DT")
  1. Q
  1. ;
  1. FN ;Sort by Field Name
  1. D SORT("FN")
  1. Q
  1. ;
  1. EB ;Sort by Edite By
  1. D SORT("EB")
  1. Q
  1. ;
  1. SH ;Show/Hide eRx Value
  1. S SHOWERX=$S($G(SHOWERX):0,1:1)
  1. D REFRESH
  1. Q
  1. ;
  1. SORT(FIELD) ;Sort entries by FIELD
  1. I PSOSRTBY=FIELD S PSORDER=$S(PSORDER="A":"D",1:"A")
  1. E S PSOSRTBY=FIELD,PSORDER="A"
  1. D REFRESH
  1. Q
  1. ;
  1. REFRESH ;Screen Refresh
  1. W ?52,"Please wait..." D INIT,HDR S VALMBCK="R"
  1. Q
  1. ;
  1. EXIT ;
  1. K ^TMP("PSOERXAU",$J),^TMP("PSOAUDSR",$J)
  1. Q
  1. ;
  1. HELP Q
  1. ;
  1. SETHDR ; - Displays the Header Line
  1. N HDR,ORD,POS
  1. ;
  1. ; - Line 1
  1. S HDR="DATE/TIME",$E(HDR,28)="FIELD NAME",$E(HDR,54)="EDITED BY"
  1. S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,4)
  1. S ORD=$S(PSORDER="A":"[^]",1:"[v]")
  1. S:PSOSRTBY="DT" POS=11 S:PSOSRTBY="FN" POS=39 S:PSOSRTBY="EB" POS=64
  1. D INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,4)
  1. Q
  1. ;
  1. SETOLD(PSOERXID,AUD) ; Set Old Value
  1. N OLDVAL,X,I,DIWL,DIWR,DIWF
  1. D OLDVAL^PSOERXUT(PSOERXID,$P(Z,"^",2),AUD,.OLDVAL)
  1. S X="" F I=1:1 Q:'$D(OLDVAL(I)) S X=X_" "_OLDVAL(I)
  1. K ^UTILITY($J,"W") S DIWL=1,DIWR=70,DIWF="|" D ^DIWP
  1. F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) D
  1. . S LINE=LINE+1,^TMP("PSOERXAU",$J,LINE,0)=$S(I=1:"Old Value:",1:" ")_^UTILITY($J,"W",1,I,0)
  1. Q
  1. ;
  1. SETVALUE(ERXIEN,FIELD,AUDIEN,TYPE) ; Set Old and New Values
  1. ; Input: (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (52.49)
  1. ; (r) FIELD - Audited Field (e.g., "SIG", "DRUG", etc.)
  1. ; (r) AUDIEN - Internal Entry Number for the Audit Log sub-file
  1. ; (r) TYPE - Value Type ("OLD" or "NEW")
  1. N OLDVAL,AUDVAL,I,X,DIWL,DIWR,DIWF
  1. S AUDVAL=""
  1. I TYPE="OLD" D
  1. . D OLDVAL^PSOERXUT(ERXIEN,FIELD,AUDIEN,.OLDVAL)
  1. . F I=1:1 Q:'$D(OLDVAL(I)) S AUDVAL=AUDVAL_" "_OLDVAL(I)
  1. I TYPE="NEW" D
  1. . F I=1:1 Q:'$D(^PS(52.49,ERXIEN,"AUD",AUDIEN,"VAL",I)) D
  1. . . S AUDVAL=AUDVAL_" "_$G(^PS(52.49,ERXIEN,"AUD",AUDIEN,"VAL",I,0))
  1. S $E(AUDVAL,1)=""
  1. ;
  1. S X=AUDVAL K ^UTILITY($J,"W") S DIWL=1,DIWR=70,DIWF="|" D ^DIWP
  1. F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) D
  1. . S LINE=LINE+1,^TMP("PSOERXAU",$J,LINE,0)=$S(I=1:$S(TYPE="NEW":"New",1:"Old")_" Value: ",1:" ")_^UTILITY($J,"W",1,I,0)
  1. . I TYPE="NEW" S HIGHLN(LINE)="12^80"
  1. Q
  1. ;
  1. ERXVAL(ERXIEN,FIELD) ; Set the Original Value
  1. ; Input: (r) ERXIEN - Pointer to the ERX HOLDING QUEUE file (52.49)
  1. ; (r) FIELD - Field Name
  1. N VALUE,I
  1. I FIELD="PATIENT" D
  1. . N ERXPATID,SSN
  1. . S ERXPATID=+$$GET1^DIQ(52.49,ERXIEN,.04,"I"),SSN=$$GET1^DIQ(52.46,ERXPATID,1.4)
  1. . S VALUE(1)=$$GET1^DIQ(52.46,ERXPATID,.01)_" (L4SSN: "_$E(SSN,$L(SSN)-4,$L(SSN))_" | DOB: "_$$GET1^DIQ(52.46,ERXPATID,.08)_")"
  1. ;
  1. I FIELD="PROVIDER" D
  1. . N ERXPRVID,SSN
  1. . S ERXPRVID=+$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
  1. . S VALUE(1)=$$GET1^DIQ(52.48,ERXPRVID,.01)_" (DEA#: "_$$GET1^DIQ(52.48,ERXPRVID,1.6)_")"
  1. ;
  1. I FIELD="QTY" D
  1. . S VALUE(1)=+$$GET1^DIQ(52.49,ERXIEN,5.1)
  1. ;
  1. I FIELD="DAYS SUPPLY" D
  1. . S VALUE(1)=+$$GET1^DIQ(52.49,ERXIEN,5.5)
  1. ;
  1. I FIELD="# OF REFILLS" D
  1. . S VALUE(1)=+$$GET1^DIQ(52.49,ERXIEN,5.6)
  1. ;
  1. I FIELD="DRUG" D
  1. . S VALUE(1)=$$GET1^DIQ(52.49,ERXIEN,3.1)_$S($$GET1^DIQ(52.49,ERXIEN,4.2,"I")="ND":" (NDC#: "_$$NDCFMT^PSSNDCUT($$GET1^DIQ(52.49,ERXIEN,4.1))_")",1:"")
  1. ;
  1. I FIELD="SIG" D
  1. . N X,DIWL,DIWR,DIWF S X=$$ERXSIG^PSOERXUT(ERXIEN)
  1. . K ^UTILITY($J,"W") S DIWL=1,DIWR=70,DIWF="|" D ^DIWP
  1. . F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) D
  1. . . S VALUE(I)=^UTILITY($J,"W",1,I,0)
  1. ;
  1. I FIELD="PROVIDER COMMENTS"!(FIELD="PATIENT INSTRUCTIONS") S VALUE(1)="N/A"
  1. ;
  1. F I=1:1 Q:'$D(VALUE(I)) D
  1. . S LINE=LINE+1,^TMP("PSOERXAU",$J,LINE,0)=$S(I=1:"eRx Value: ",1:" ")_VALUE(I),REVLN(LINE)="12^"_($L(VALUE(I)))
  1. Q