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