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