PSOERHL0 ;BIRM/MFR - eRx History Log View - Listman Driver ;04/12/23
;;7.0;OUTPATIENT PHARMACY;**700,746,770**;DEC 1997;Build 145
;
EN(PSOERXID) ;Menu option entry point
N PSOSRTBY,PSORDER,UNDLN,HIGHLN,REVLN,LASTLINE,VALMCNT
;
S PSOSRTBY="DT",PSORDER="A"
W !,"Please wait..."
D EN^VALM("PSO ERX HISTORY 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)
Q
;
INIT ;Populates the Body section for ListMan
K ^TMP("PSOERXHL",$J)
D SETSORT(PSOSRTBY),SETLINE
Q
;
SETLINE ;Sets the line to be displayed in ListMan
;
I '$D(^TMP("PSOERXHL",$J)) D Q
. F I=1:1:6 S ^TMP("PSOERXHL",$J,I,0)=""
. S ^TMP("PSOERXHL",$J,7,0)=" No History Log for this eRx"
. S VALMCNT=1
;
;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) ;Building the list (line by line)
;Resetting list to NORMAL video attributes
D RESET^PSOERUT0()
S LINE=0
N PAAM,PRAM,DRAM,PAME,PRME,DRME,DISP,X1,X2,X3
K ^TMP("PSOERXHL",$J)
S PAAM=$$GET1^DIQ(52.49,PSOERXID,1.6,"E") S PAME=$$GET1^DIQ(52.49,PSOERXID,1.7,"E")
S PRAM=$$GET1^DIQ(52.49,PSOERXID,1.2,"E") S PRME=$$GET1^DIQ(52.49,PSOERXID,1.3,"E")
S DRAM=$$GET1^DIQ(52.49,PSOERXID,1.4,"E") S DRME=$$GET1^DIQ(52.49,PSOERXID,1.5,"E")
S X1="Pat Auto-Match: "_PAAM,$E(X1,39)="Pat Manual Edit: "_PRAM
S X2="Prov Auto-Match: "_PRAM,$E(X2,39)="Prov Manual Edit: "_PRME
S X3="Drug Auto-Match: "_DRAM,$E(X3,39)="Drug Manual Edit: "_DRME
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X1
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X2
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X3
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=""
;
N AUD,ZAUD,IENS,DATETIME,EDITEDBY,STADE,X1,X2,I,VAL1,RET,II,HFFDT
S AUD=0 ;STATUS HISTORY LOOP
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Status History:",REVLN(LINE)="1^15"
S X1="Date/Time",$E(X1,19)="Status",$E(X1,60)="Entered By"
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X1,UNDLN(LINE)="1^80"
I '$D(^PS(52.49,PSOERXID,19)) S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="No Status History Available"
F S AUD=$O(^PS(52.49,PSOERXID,19,AUD)) Q:'AUD D
. S ZAUD=$G(^PS(52.49,PSOERXID,19,AUD,0))
. S IENS=AUD_","_PSOERXID_","
. S DATETIME=$P(ZAUD,"^",1)
. S EDITEDBY=$P(ZAUD,"^",3)
. S EDITEDBY=$E(EDITEDBY,1,16)
. S STADE=$$GET1^DIQ(52.45,$P(ZAUD,"^",2),.02)
. S STADE=$E(STADE,1,36)
. S X2=$$FMTE^XLFDT(DATETIME,"2Z"),$E(X2,19)=$$GET1^DIQ(52.45,$P(ZAUD,"^",2),.01)_"-"_$E(STADE,1,34)
. ; Un-Accept Flag
. I $P(ZAUD,"^",4) S X2=X2_" (Un-Accept)"
. ; Hold for Future Fill Date
. I $$GET1^DIQ(52.45,$P(ZAUD,"^",2),.01)="HFF" S X2=X2_" ("_$$FMTE^XLFDT($P(ZAUD,"^",5))_")"
. S $E(X2,60)=$E($$GET1^DIQ(200,EDITEDBY,.01),1,19) ;eRx Status
. S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)=X2
. S VAL1=$$GET1^DIQ(52.4919,IENS,1,"E")
. I $G(VAL1)'="" D
. . K RET D TXT2ARY^PSOERXD1(.RET,VAL1,,60)
. . F II=1:1:+$O(RET(""),-1) S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)=$S(II=1:"Status Comments: ",1:"")_RET(II),HIGHLN(LINE)="1^80"
;
N OERR,ORSTAT,IEN,DATETM,FLGDT,FLGBY,FLGREA,UNFLGDT,UNFLGBY,UNFLGRE,X1,X2,FLG
S OERR=$$GET1^DIQ(52.49,PSOERXID,.12)
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=""
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Order:",REVLN(LINE)="1^6"
S X1="Date/Time",$E(X1,24)="Order#",$E(X1,43)="Status"
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X1,UNDLN(LINE)="1^80"
I 'OERR S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="No Order History Available"
I OERR D
. S FLG=0 F S FLG=$O(^OR(100,OERR,8,FLG)) Q:'FLG D
. . I '$D(^OR(100,OERR,8,FLG,3)) Q
. . S ORSTAT=$$GET1^DIQ(100,OERR,5,"E") ;Order Status
. . S DATETM=$$GET1^DIQ(100,OERR,31,"I") ;Date/Time
. . S X2=$$FMTE^XLFDT(DATETM,"2Z"),$E(X2,24)=OERR,$E(X2,43)=ORSTAT
. . S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)=X2
. . S FLGDT=$$GET1^DIQ(100.008,FLG_","_OERR,33) ;Date/Time Flagged
. . S FLGBY=$E($$GET1^DIQ(100.008,FLG_","_OERR,34),1,26) ;Flagged By
. . S FLGREA=$$GET1^DIQ(100.008,FLG_","_OERR,35) ;Flagged Reason
. . S UNFLGDT=$$GET1^DIQ(100.008,FLG_","_OERR,36) ;Date/Time Un-flagged
. . S UNFLGBY=$E($$GET1^DIQ(100.008,FLG_","_OERR,37),1,26) ;Un-flagged By
. . S UNFLGRE=$$GET1^DIQ(100.008,FLG_","_OERR,38) ;Un-flagged Reason
. . I $G(FLGDT)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Date/Time Flagged:"_" "_$$FMTE^XLFDT(FLGDT,"2Z"),HIGHLN(LINE)="20^18"
. . I $G(FLGBY)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Flagged By:"_" "_FLGBY,HIGHLN(LINE)="13^50"
. . I $G(FLGREA)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Reason for Flag:"_" "_$G(FLGREA),HIGHLN(LINE)="18^62"
. . I $G(UNFLGDT)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="",LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Date/Time Unflagged:"_" "_$$FMTE^XLFDT(UNFLGDT,"2Z"),HIGHLN(LINE)="22^18"
. . I $G(UNFLGBY)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Unflagged By:"_" "_UNFLGBY,HIGHLN(LINE)="15^50"
. . I $G(UNFLGRE)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Reason for Unflag:"_" "_$G(UNFLGRE),HIGHLN(LINE)="20^60"
;
N ERXHUB,PSRX,AUD,ZAUD,IENS,PRESE,PRESI,DATETIME,FLDNAME,EDITEDBY,FILL,COMMENT,X,X1,X2
S ERXHUB=$P(^PS(52.49,PSOERXID,0),"^",1)
S (PSRX,AUD,IEN)=0 ;RX ACTIVITY LOG
S PRESE=$$GET1^DIQ(52.49,PSOERXID,.13,"E")
S PRESI=$$GET1^DIQ(52.49,PSOERXID,.13,"I")
I PRESE'="" D
. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=""
. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Prescription:",REVLN(LINE)="1^13",UNDLN(LINE)="14^80"
. S X="Prescription#: ",$E(X,16)=PRESE,$E(X,38)="Status: ",$E(X,47)=$$GET1^DIQ(52,PRESI,100,"E")
. S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=""
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Activity Log:",REVLN(LINE)="1^13"
S X1="Date/Time",$E(X1,19)="Reason",$E(X1,41)="Rx Ref",$E(X1,57)="Initiator Of Activity"
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X1
S LINE=LINE+1,$P(^TMP("PSOERXHL",$J,LINE,0),"=",79)="="
I '$D(^PSRX("D",ERXHUB,"PHARMACY")) S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="No Activity Log Available"
F S PSRX=$O(^PSRX("D",ERXHUB,"PHARMACY",PSRX)) Q:'PSRX D
. I '$D(^PSRX(PSRX,"A")) Q
. F S AUD=$O(^PSRX(PSRX,"A",AUD)) Q:'AUD D
. . S ZAUD=$G(^PSRX(PSRX,"A",AUD,0))
. . S IENS=AUD_","_PSRX_","
. . I $$GET1^DIQ(52.3,IENS,.02,"I")="M" Q
. . S DATETIME=$P(ZAUD,"^",1)
. . S EDITEDBY=$P(ZAUD,"^",3)
. . S FILL=$P(ZAUD,"^",4)
. . S COMMENT=$P(ZAUD,"^",5)
. . S FILL=$S(FILL>0&(FILL<6):"REFILL "_FILL,FILL=6:"PARTIAL",FILL>6:"REFILL "_(FILL-1),1:"ORIGINAL")
. . S X2=$$FMTE^XLFDT(DATETIME,"2Z"),$E(X2,19)=$$GET1^DIQ(52.3,IENS,.02,"E"),$E(X2,41)=FILL,$E(X2,57)=$E($$GET1^DIQ(200,EDITEDBY,.01),1,24)
. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X2
. . I $G(COMMENT)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Comments: "_$P(ZAUD,"^",5),HIGHLN(LINE)="1^80"
;
N PSRX,AUD,ZAUD,ZAUD1,TRANS,SEQNO,FILL,FILLD,STAT,STATD,BREF,DATE,NDC,COMMENTS,CARR,PKGID,FLDNAME,X1,X2,X3
S PSRX=$$GET1^DIQ(52.49,PSOERXID,.13,"I")
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=""
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="CMOP Event Log:",REVLN(LINE)="1^15"
S X1="Date/Time",$E(X1,19)="Rx Ref",$E(X1,28)="TRN-Order",$E(X1,42)="Stat",$E(X1,62)="NDC"
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X1
S LINE=LINE+1,$P(^TMP("PSOERXHL",$J,LINE,0),"=",79)="="
I '$G(PSRX) S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="No CMOP Log Available"
I $G(PSRX),'$D(^PSRX(PSRX,4)) S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="No CMOP Log Available"
I $G(PSRX),$D(^PSRX(PSRX,4)) D
. S AUD=0 ;CMOP LOOP
. F S AUD=$O(^PSRX(PSRX,4,AUD)) Q:'AUD D
. . S ZAUD=$G(^PSRX(PSRX,4,AUD,0))
. . S ZAUD1=$G(^PSRX(PSRX,4,AUD,1))
. . S TRANS=$P(ZAUD,U) ;Transmission #
. . S SEQNO=$P(ZAUD,U,2) ;Sequence #
. . S FILL=$P(ZAUD,U,3) ;Rx Indicator
. . S FILLD=$S(FILL>0&(FILL<6):"REFILL "_FILL,FILL=6:"PARTIAL",FILL>6:"REFILL "_(FILL-1),1:"ORIGINAL")
. . S STAT=$P(ZAUD,U,4) ;Status
. . S STATD=$$STATDSP(STAT)
. . S BREF=$G(TRANS)_"-"_$G(SEQNO)
. . S DATE=$$CMOPDT(PSRX,FILL) ;Date
. . S NDC=$P(ZAUD,U,8) ;NDC Received
. . S COMMENTS=$S($G(STAT)=3:$E($P($G(ZAUD1),"^"),1,35),$G(NDC)'="":"NDC: "_NDC,1:"") ;They only want to see comments if STATUS=3/Not Dispensed
. . S CARR=$P(ZAUD1,U,3) ;Carrier
. . S PKGID=$P(ZAUD1,U,4) ;Package ID
. . S X2=$$FMTE^XLFDT(DATE,"2Z"),$E(X2,19)=FILLD,$E(X2,28)=BREF,$E(X2,42)=STATD,$E(X2,62)=NDC
. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X2
. . S X3="Carrier: "_CARR,$E(X3,28)="Package ID: "_PKGID
. . S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X3
. . I $G(COMMENTS)'="" S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Comments: "_COMMENTS,HIGHLN(LINE)="1^80"
;
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=""
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)="Change, Cancel, Renewal Log:",REVLN(LINE)="1^28"
S X1="Date/Time",$E(X1,19)="MessageType",$E(X1,37)="eRx ID",$E(X1,63)="eRx Order Status"
S LINE=LINE+1,^TMP("PSOERXHL",$J,LINE,0)=X1,UNDLN(LINE)="1^80"
N FLAG,MTYPE,REQIEN,REQID,RESIEN,RESID,RELERX,RELMES,RELTYPE,RESTYPE,REQTYPE
S (FLAG,RELMES)=0
S MTYPE=$$GET1^DIQ(52.49,PSOERXID,.08,"I")
I ",RR,CA,CR,"[(","_MTYPE_",") D
. S FLAG=1,REQIEN=PSOERXID,RESIEN=$$GETRESP^PSOERXU2(PSOERXID) ;If the message is a Request
. S RESTYPE=$$GET1^DIQ(52.49,RESIEN,.08,"I")
. I ",N,RR,CA,CR,"[(","_RESTYPE_",") S RESIEN=""
I ",RE,CN,CX,"[(","_MTYPE_",") D
. S FLAG=1,RESIEN=PSOERXID,REQIEN=$$RESOLV^PSOERXU2(PSOERXID) ;If the message is a Response
. S REQTYPE=$$GET1^DIQ(52.49,REQIEN,.08,"I")
. I ",N,RE,CN,CX,"[(","_REQTYPE_",") S REQIEN=""
I ",N,RE,"[(","_MTYPE_",") D ;If the message is a New eRx
. D GETDATA^PSOERHL1(PSOERXID)
. F S RELMES=$O(^PS(52.49,PSOERXID,201,"B",RELMES)) Q:'RELMES D
. . S RELTYPE=$$GET1^DIQ(52.49,RELMES,.08,"I")
. . I ",RR,CA,CR,RE,CN,CX,"[(","_RELTYPE_",") D
. . . D GETDATA^PSOERHL1(RELMES)
I MTYPE="IE" S FLAG=1,RESIEN=PSOERXID,REQIEN=$$RESOLV^PSOERXU2(PSOERXID) ;If the message is an Inbound Error
;Inbound Error, Request and Response below
I $G(FLAG) D
. I $G(REQIEN)'="" S REQID=$$GET1^DIQ(52.49,REQIEN,.01,"E"),RELERX=$$GET1^DIQ(52.49,REQIEN,.14)
. I $G(RESIEN)'="" S RESID=$$GET1^DIQ(52.49,RESIEN,.01,"E")
. I $G(RELERX)'="" D ;New eRX
. . N ERXIEN S ERXIEN=$O(^PS(52.49,"B",RELERX,0))
. . D GETDATA^PSOERHL1(ERXIEN)
. I $G(REQID)'="" D ;Request
. . N ERXIEN S ERXIEN=$O(^PS(52.49,"B",REQID,0))
. . D GETDATA^PSOERHL1(ERXIEN)
. I $G(RESID)'="" D ;Response
. . N ERXIEN S ERXIEN=$O(^PS(52.49,"B",RESID,0))
. . D GETDATA^PSOERHL1(ERXIEN)
Q
;
STATDSP(STAT) ;Determine Status to display
;0:TRANSMITTED
;1:DISPENSED
;2:RETRANSMITTED
;3:NOT DISPENSED
N STATD
S:STAT=0 STATD="TRAN"
S:STAT=1 STATD="DISP"
I $G(STATD)="DISP" D
. I FILL>0,('$D(^PSRX(PSRX,1,FILL,0))) S STATD="DISP Refill Deleted" Q
S:STAT=2 STATD="RTRN"
S:STAT=3 STATD="NDISP"
Q STATD
;
CMOPDT(PSRX,FILL) ;Determine date to display
;Use Cancelled DT/TM first if available
;If Cancelled DT/TM is not populated, use Release DT/TM
;If Release DT/TM is not populated, use Transmission Create DT/TM
;
N CANDT,CDATE
I $G(STAT)=3 S CANDT=$P(ZAUD,U,5) I CANDT'="" Q CANDT ;Cancelled DT/TM
;If status = 3 (not dispensed) and there is a cancelled date/time then quit with the cancelled date/time
I $G(STAT)=1 D
. S CDATE=$S(FILL=0:$P(^PSRX(PSRX,2),"^",13),1:$P(^PSRX(PSRX,1,FILL,0),"^",18))
. ;If Original Fill set to Released Date/Time (node 2 piece 13)
. ;If Fill greater than 0 (not Original) set to Released Date in the Refill Node (node 1 piece 18)
I $G(STAT)=3,'FILL,$$GET1^DIQ(52,PSRX,32.1,"I") Q $$FMTE^XLFDT($$GET1^DIQ(52,PSRX,32.1,"I"),2) ;If original fill and RTS
I $G(STAT)=3,FILL,$$GET1^DIQ(52.1,FILL_","_PSRX,5,"I") Q $$FMTE^XLFDT($$GET1^DIQ(52.1,FILL_","_PSRX,32.1,"I"),2) ;If refill and there is a lot#
I '$G(CDATE) D
. S CDATE=$P(^PSX(550.2,TRANS,0),"^",6) ;Transmission DT/TM
Q $G(CDATE)
;
REFRESH ;Screen Refresh
W ?52,"Please wait..." D INIT,HDR S VALMBCK="R"
Q
;
EXIT ;
K ^TMP("PSOERXHL",$J)
Q
;
HELP Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERHL0 12888 printed Aug 26, 2025@22:43:45 Page 2
PSOERHL0 ;BIRM/MFR - eRx History Log View - Listman Driver ;04/12/23
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746,770**;DEC 1997;Build 145
+2 ;
EN(PSOERXID) ;Menu option entry point
+1 NEW PSOSRTBY,PSORDER,UNDLN,HIGHLN,REVLN,LASTLINE,VALMCNT
+2 ;
+3 SET PSOSRTBY="DT"
SET PSORDER="A"
+4 WRITE !,"Please wait..."
+5 DO EN^VALM("PSO ERX HISTORY 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 QUIT
+5 ;
INIT ;Populates the Body section for ListMan
+1 KILL ^TMP("PSOERXHL",$JOB)
+2 DO SETSORT(PSOSRTBY)
DO SETLINE
+3 QUIT
+4 ;
SETLINE ;Sets the line to be displayed in ListMan
+1 ;
+2 IF '$DATA(^TMP("PSOERXHL",$JOB))
Begin DoDot:1
+3 FOR I=1:1:6
SET ^TMP("PSOERXHL",$JOB,I,0)=""
+4 SET ^TMP("PSOERXHL",$JOB,7,0)=" No History Log for this eRx"
+5 SET VALMCNT=1
End DoDot:1
QUIT
+6 ;
+7 ;Saving NORMAL video attributes to be reset later
+8 IF LINE>$GET(LASTLINE)
Begin DoDot:1
+9 FOR I=($GET(LASTLINE)+1):1:LINE
DO SAVE^VALM10(I)
+10 SET LASTLINE=LINE
End DoDot:1
+11 SET VALMCNT=+$GET(LINE)
+12 DO VIDEO
+13 ;
+14 QUIT
+15 ;
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) ;Building the list (line by line)
+1 ;Resetting list to NORMAL video attributes
+2 DO RESET^PSOERUT0()
+3 SET LINE=0
+4 NEW PAAM,PRAM,DRAM,PAME,PRME,DRME,DISP,X1,X2,X3
+5 KILL ^TMP("PSOERXHL",$JOB)
+6 SET PAAM=$$GET1^DIQ(52.49,PSOERXID,1.6,"E")
SET PAME=$$GET1^DIQ(52.49,PSOERXID,1.7,"E")
+7 SET PRAM=$$GET1^DIQ(52.49,PSOERXID,1.2,"E")
SET PRME=$$GET1^DIQ(52.49,PSOERXID,1.3,"E")
+8 SET DRAM=$$GET1^DIQ(52.49,PSOERXID,1.4,"E")
SET DRME=$$GET1^DIQ(52.49,PSOERXID,1.5,"E")
+9 SET X1="Pat Auto-Match: "_PAAM
SET $EXTRACT(X1,39)="Pat Manual Edit: "_PRAM
+10 SET X2="Prov Auto-Match: "_PRAM
SET $EXTRACT(X2,39)="Prov Manual Edit: "_PRME
+11 SET X3="Drug Auto-Match: "_DRAM
SET $EXTRACT(X3,39)="Drug Manual Edit: "_DRME
+12 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
+13 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+14 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X3
+15 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+16 ;
+17 NEW AUD,ZAUD,IENS,DATETIME,EDITEDBY,STADE,X1,X2,I,VAL1,RET,II,HFFDT
+18 ;STATUS HISTORY LOOP
SET AUD=0
+19 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Status History:"
SET REVLN(LINE)="1^15"
+20 SET X1="Date/Time"
SET $EXTRACT(X1,19)="Status"
SET $EXTRACT(X1,60)="Entered By"
+21 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
SET UNDLN(LINE)="1^80"
+22 IF '$DATA(^PS(52.49,PSOERXID,19))
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="No Status History Available"
+23 FOR
SET AUD=$ORDER(^PS(52.49,PSOERXID,19,AUD))
if 'AUD
QUIT
Begin DoDot:1
+24 SET ZAUD=$GET(^PS(52.49,PSOERXID,19,AUD,0))
+25 SET IENS=AUD_","_PSOERXID_","
+26 SET DATETIME=$PIECE(ZAUD,"^",1)
+27 SET EDITEDBY=$PIECE(ZAUD,"^",3)
+28 SET EDITEDBY=$EXTRACT(EDITEDBY,1,16)
+29 SET STADE=$$GET1^DIQ(52.45,$PIECE(ZAUD,"^",2),.02)
+30 SET STADE=$EXTRACT(STADE,1,36)
+31 SET X2=$$FMTE^XLFDT(DATETIME,"2Z")
SET $EXTRACT(X2,19)=$$GET1^DIQ(52.45,$PIECE(ZAUD,"^",2),.01)_"-"_$EXTRACT(STADE,1,34)
+32 ; Un-Accept Flag
+33 IF $PIECE(ZAUD,"^",4)
SET X2=X2_" (Un-Accept)"
+34 ; Hold for Future Fill Date
+35 IF $$GET1^DIQ(52.45,$PIECE(ZAUD,"^",2),.01)="HFF"
SET X2=X2_" ("_$$FMTE^XLFDT($PIECE(ZAUD,"^",5))_")"
+36 ;eRx Status
SET $EXTRACT(X2,60)=$EXTRACT($$GET1^DIQ(200,EDITEDBY,.01),1,19)
+37 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+38 SET VAL1=$$GET1^DIQ(52.4919,IENS,1,"E")
+39 IF $GET(VAL1)'=""
Begin DoDot:2
+40 KILL RET
DO TXT2ARY^PSOERXD1(.RET,VAL1,,60)
+41 FOR II=1:1:+$ORDER(RET(""),-1)
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=$SELECT(II=1:"Status Comments: ",1:"")_RET(II)
SET HIGHLN(LINE)="1^80"
End DoDot:2
End DoDot:1
+42 ;
+43 NEW OERR,ORSTAT,IEN,DATETM,FLGDT,FLGBY,FLGREA,UNFLGDT,UNFLGBY,UNFLGRE,X1,X2,FLG
+44 SET OERR=$$GET1^DIQ(52.49,PSOERXID,.12)
+45 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+46 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Order:"
SET REVLN(LINE)="1^6"
+47 SET X1="Date/Time"
SET $EXTRACT(X1,24)="Order#"
SET $EXTRACT(X1,43)="Status"
+48 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
SET UNDLN(LINE)="1^80"
+49 IF 'OERR
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="No Order History Available"
+50 IF OERR
Begin DoDot:1
+51 SET FLG=0
FOR
SET FLG=$ORDER(^OR(100,OERR,8,FLG))
if 'FLG
QUIT
Begin DoDot:2
+52 IF '$DATA(^OR(100,OERR,8,FLG,3))
QUIT
+53 ;Order Status
SET ORSTAT=$$GET1^DIQ(100,OERR,5,"E")
+54 ;Date/Time
SET DATETM=$$GET1^DIQ(100,OERR,31,"I")
+55 SET X2=$$FMTE^XLFDT(DATETM,"2Z")
SET $EXTRACT(X2,24)=OERR
SET $EXTRACT(X2,43)=ORSTAT
+56 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+57 ;Date/Time Flagged
SET FLGDT=$$GET1^DIQ(100.008,FLG_","_OERR,33)
+58 ;Flagged By
SET FLGBY=$EXTRACT($$GET1^DIQ(100.008,FLG_","_OERR,34),1,26)
+59 ;Flagged Reason
SET FLGREA=$$GET1^DIQ(100.008,FLG_","_OERR,35)
+60 ;Date/Time Un-flagged
SET UNFLGDT=$$GET1^DIQ(100.008,FLG_","_OERR,36)
+61 ;Un-flagged By
SET UNFLGBY=$EXTRACT($$GET1^DIQ(100.008,FLG_","_OERR,37),1,26)
+62 ;Un-flagged Reason
SET UNFLGRE=$$GET1^DIQ(100.008,FLG_","_OERR,38)
+63 IF $GET(FLGDT)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Date/Time Flagged:"_" "_$$FMTE^XLFDT(FLGDT,"2Z")
SET HIGHLN(LINE)="20^18"
+64 IF $GET(FLGBY)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Flagged By:"_" "_FLGBY
SET HIGHLN(LINE)="13^50"
+65 IF $GET(FLGREA)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Reason for Flag:"_" "_$GET(FLGREA)
SET HIGHLN(LINE)="18^62"
+66 IF $GET(UNFLGDT)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Date/Time Unflagged:"_" "_$$FMTE^XLFDT(UNFLGDT,"2Z")
SET HIGHLN(LINE)="22^18"
+67 IF $GET(UNFLGBY)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Unflagged By:"_" "_UNFLGBY
SET HIGHLN(LINE)="15^50"
+68 IF $GET(UNFLGRE)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Reason for Unflag:"_" "_$GET(UNFLGRE)
SET HIGHLN(LINE)="20^60"
End DoDot:2
End DoDot:1
+69 ;
+70 NEW ERXHUB,PSRX,AUD,ZAUD,IENS,PRESE,PRESI,DATETIME,FLDNAME,EDITEDBY,FILL,COMMENT,X,X1,X2
+71 SET ERXHUB=$PIECE(^PS(52.49,PSOERXID,0),"^",1)
+72 ;RX ACTIVITY LOG
SET (PSRX,AUD,IEN)=0
+73 SET PRESE=$$GET1^DIQ(52.49,PSOERXID,.13,"E")
+74 SET PRESI=$$GET1^DIQ(52.49,PSOERXID,.13,"I")
+75 IF PRESE'=""
Begin DoDot:1
+76 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+77 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Prescription:"
SET REVLN(LINE)="1^13"
SET UNDLN(LINE)="14^80"
+78 SET X="Prescription#: "
SET $EXTRACT(X,16)=PRESE
SET $EXTRACT(X,38)="Status: "
SET $EXTRACT(X,47)=$$GET1^DIQ(52,PRESI,100,"E")
+79 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X
End DoDot:1
+80 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+81 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Activity Log:"
SET REVLN(LINE)="1^13"
+82 SET X1="Date/Time"
SET $EXTRACT(X1,19)="Reason"
SET $EXTRACT(X1,41)="Rx Ref"
SET $EXTRACT(X1,57)="Initiator Of Activity"
+83 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
+84 SET LINE=LINE+1
SET $PIECE(^TMP("PSOERXHL",$JOB,LINE,0),"=",79)="="
+85 IF '$DATA(^PSRX("D",ERXHUB,"PHARMACY"))
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="No Activity Log Available"
+86 FOR
SET PSRX=$ORDER(^PSRX("D",ERXHUB,"PHARMACY",PSRX))
if 'PSRX
QUIT
Begin DoDot:1
+87 IF '$DATA(^PSRX(PSRX,"A"))
QUIT
+88 FOR
SET AUD=$ORDER(^PSRX(PSRX,"A",AUD))
if 'AUD
QUIT
Begin DoDot:2
+89 SET ZAUD=$GET(^PSRX(PSRX,"A",AUD,0))
+90 SET IENS=AUD_","_PSRX_","
+91 IF $$GET1^DIQ(52.3,IENS,.02,"I")="M"
QUIT
+92 SET DATETIME=$PIECE(ZAUD,"^",1)
+93 SET EDITEDBY=$PIECE(ZAUD,"^",3)
+94 SET FILL=$PIECE(ZAUD,"^",4)
+95 SET COMMENT=$PIECE(ZAUD,"^",5)
+96 SET FILL=$SELECT(FILL>0&(FILL<6):"REFILL "_FILL,FILL=6:"PARTIAL",FILL>6:"REFILL "_(FILL-1),1:"ORIGINAL")
+97 SET X2=$$FMTE^XLFDT(DATETIME,"2Z")
SET $EXTRACT(X2,19)=$$GET1^DIQ(52.3,IENS,.02,"E")
SET $EXTRACT(X2,41)=FILL
SET $EXTRACT(X2,57)=$EXTRACT($$GET1^DIQ(200,EDITEDBY,.01),1,24)
+98 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+99 IF $GET(COMMENT)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Comments: "_$PIECE(ZAUD,"^",5)
SET HIGHLN(LINE)="1^80"
End DoDot:2
End DoDot:1
+100 ;
+101 NEW PSRX,AUD,ZAUD,ZAUD1,TRANS,SEQNO,FILL,FILLD,STAT,STATD,BREF,DATE,NDC,COMMENTS,CARR,PKGID,FLDNAME,X1,X2,X3
+102 SET PSRX=$$GET1^DIQ(52.49,PSOERXID,.13,"I")
+103 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+104 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="CMOP Event Log:"
SET REVLN(LINE)="1^15"
+105 SET X1="Date/Time"
SET $EXTRACT(X1,19)="Rx Ref"
SET $EXTRACT(X1,28)="TRN-Order"
SET $EXTRACT(X1,42)="Stat"
SET $EXTRACT(X1,62)="NDC"
+106 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
+107 SET LINE=LINE+1
SET $PIECE(^TMP("PSOERXHL",$JOB,LINE,0),"=",79)="="
+108 IF '$GET(PSRX)
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="No CMOP Log Available"
+109 IF $GET(PSRX)
IF '$DATA(^PSRX(PSRX,4))
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="No CMOP Log Available"
+110 IF $GET(PSRX)
IF $DATA(^PSRX(PSRX,4))
Begin DoDot:1
+111 ;CMOP LOOP
SET AUD=0
+112 FOR
SET AUD=$ORDER(^PSRX(PSRX,4,AUD))
if 'AUD
QUIT
Begin DoDot:2
+113 SET ZAUD=$GET(^PSRX(PSRX,4,AUD,0))
+114 SET ZAUD1=$GET(^PSRX(PSRX,4,AUD,1))
+115 ;Transmission #
SET TRANS=$PIECE(ZAUD,U)
+116 ;Sequence #
SET SEQNO=$PIECE(ZAUD,U,2)
+117 ;Rx Indicator
SET FILL=$PIECE(ZAUD,U,3)
+118 SET FILLD=$SELECT(FILL>0&(FILL<6):"REFILL "_FILL,FILL=6:"PARTIAL",FILL>6:"REFILL "_(FILL-1),1:"ORIGINAL")
+119 ;Status
SET STAT=$PIECE(ZAUD,U,4)
+120 SET STATD=$$STATDSP(STAT)
+121 SET BREF=$GET(TRANS)_"-"_$GET(SEQNO)
+122 ;Date
SET DATE=$$CMOPDT(PSRX,FILL)
+123 ;NDC Received
SET NDC=$PIECE(ZAUD,U,8)
+124 ;They only want to see comments if STATUS=3/Not Dispensed
SET COMMENTS=$SELECT($GET(STAT)=3:$EXTRACT($PIECE($GET(ZAUD1),"^"),1,35),$GET(NDC)'="":"NDC: "_NDC,1:"")
+125 ;Carrier
SET CARR=$PIECE(ZAUD1,U,3)
+126 ;Package ID
SET PKGID=$PIECE(ZAUD1,U,4)
+127 SET X2=$$FMTE^XLFDT(DATE,"2Z")
SET $EXTRACT(X2,19)=FILLD
SET $EXTRACT(X2,28)=BREF
SET $EXTRACT(X2,42)=STATD
SET $EXTRACT(X2,62)=NDC
+128 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+129 SET X3="Carrier: "_CARR
SET $EXTRACT(X3,28)="Package ID: "_PKGID
+130 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X3
+131 IF $GET(COMMENTS)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Comments: "_COMMENTS
SET HIGHLN(LINE)="1^80"
End DoDot:2
End DoDot:1
+132 ;
+133 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+134 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Change, Cancel, Renewal Log:"
SET REVLN(LINE)="1^28"
+135 SET X1="Date/Time"
SET $EXTRACT(X1,19)="MessageType"
SET $EXTRACT(X1,37)="eRx ID"
SET $EXTRACT(X1,63)="eRx Order Status"
+136 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
SET UNDLN(LINE)="1^80"
+137 NEW FLAG,MTYPE,REQIEN,REQID,RESIEN,RESID,RELERX,RELMES,RELTYPE,RESTYPE,REQTYPE
+138 SET (FLAG,RELMES)=0
+139 SET MTYPE=$$GET1^DIQ(52.49,PSOERXID,.08,"I")
+140 IF ",RR,CA,CR,"[(","_MTYPE_",")
Begin DoDot:1
+141 ;If the message is a Request
SET FLAG=1
SET REQIEN=PSOERXID
SET RESIEN=$$GETRESP^PSOERXU2(PSOERXID)
+142 SET RESTYPE=$$GET1^DIQ(52.49,RESIEN,.08,"I")
+143 IF ",N,RR,CA,CR,"[(","_RESTYPE_",")
SET RESIEN=""
End DoDot:1
+144 IF ",RE,CN,CX,"[(","_MTYPE_",")
Begin DoDot:1
+145 ;If the message is a Response
SET FLAG=1
SET RESIEN=PSOERXID
SET REQIEN=$$RESOLV^PSOERXU2(PSOERXID)
+146 SET REQTYPE=$$GET1^DIQ(52.49,REQIEN,.08,"I")
+147 IF ",N,RE,CN,CX,"[(","_REQTYPE_",")
SET REQIEN=""
End DoDot:1
+148 ;If the message is a New eRx
IF ",N,RE,"[(","_MTYPE_",")
Begin DoDot:1
+149 DO GETDATA^PSOERHL1(PSOERXID)
+150 FOR
SET RELMES=$ORDER(^PS(52.49,PSOERXID,201,"B",RELMES))
if 'RELMES
QUIT
Begin DoDot:2
+151 SET RELTYPE=$$GET1^DIQ(52.49,RELMES,.08,"I")
+152 IF ",RR,CA,CR,RE,CN,CX,"[(","_RELTYPE_",")
Begin DoDot:3
+153 DO GETDATA^PSOERHL1(RELMES)
End DoDot:3
End DoDot:2
End DoDot:1
+154 ;If the message is an Inbound Error
IF MTYPE="IE"
SET FLAG=1
SET RESIEN=PSOERXID
SET REQIEN=$$RESOLV^PSOERXU2(PSOERXID)
+155 ;Inbound Error, Request and Response below
+156 IF $GET(FLAG)
Begin DoDot:1
+157 IF $GET(REQIEN)'=""
SET REQID=$$GET1^DIQ(52.49,REQIEN,.01,"E")
SET RELERX=$$GET1^DIQ(52.49,REQIEN,.14)
+158 IF $GET(RESIEN)'=""
SET RESID=$$GET1^DIQ(52.49,RESIEN,.01,"E")
+159 ;New eRX
IF $GET(RELERX)'=""
Begin DoDot:2
+160 NEW ERXIEN
SET ERXIEN=$ORDER(^PS(52.49,"B",RELERX,0))
+161 DO GETDATA^PSOERHL1(ERXIEN)
End DoDot:2
+162 ;Request
IF $GET(REQID)'=""
Begin DoDot:2
+163 NEW ERXIEN
SET ERXIEN=$ORDER(^PS(52.49,"B",REQID,0))
+164 DO GETDATA^PSOERHL1(ERXIEN)
End DoDot:2
+165 ;Response
IF $GET(RESID)'=""
Begin DoDot:2
+166 NEW ERXIEN
SET ERXIEN=$ORDER(^PS(52.49,"B",RESID,0))
+167 DO GETDATA^PSOERHL1(ERXIEN)
End DoDot:2
End DoDot:1
+168 QUIT
+169 ;
STATDSP(STAT) ;Determine Status to display
+1 ;0:TRANSMITTED
+2 ;1:DISPENSED
+3 ;2:RETRANSMITTED
+4 ;3:NOT DISPENSED
+5 NEW STATD
+6 if STAT=0
SET STATD="TRAN"
+7 if STAT=1
SET STATD="DISP"
+8 IF $GET(STATD)="DISP"
Begin DoDot:1
+9 IF FILL>0
IF ('$DATA(^PSRX(PSRX,1,FILL,0)))
SET STATD="DISP Refill Deleted"
QUIT
End DoDot:1
+10 if STAT=2
SET STATD="RTRN"
+11 if STAT=3
SET STATD="NDISP"
+12 QUIT STATD
+13 ;
CMOPDT(PSRX,FILL) ;Determine date to display
+1 ;Use Cancelled DT/TM first if available
+2 ;If Cancelled DT/TM is not populated, use Release DT/TM
+3 ;If Release DT/TM is not populated, use Transmission Create DT/TM
+4 ;
+5 NEW CANDT,CDATE
+6 ;Cancelled DT/TM
IF $GET(STAT)=3
SET CANDT=$PIECE(ZAUD,U,5)
IF CANDT'=""
QUIT CANDT
+7 ;If status = 3 (not dispensed) and there is a cancelled date/time then quit with the cancelled date/time
+8 IF $GET(STAT)=1
Begin DoDot:1
+9 SET CDATE=$SELECT(FILL=0:$PIECE(^PSRX(PSRX,2),"^",13),1:$PIECE(^PSRX(PSRX,1,FILL,0),"^",18))
+10 ;If Original Fill set to Released Date/Time (node 2 piece 13)
+11 ;If Fill greater than 0 (not Original) set to Released Date in the Refill Node (node 1 piece 18)
End DoDot:1
+12 ;If original fill and RTS
IF $GET(STAT)=3
IF 'FILL
IF $$GET1^DIQ(52,PSRX,32.1,"I")
QUIT $$FMTE^XLFDT($$GET1^DIQ(52,PSRX,32.1,"I"),2)
+13 ;If refill and there is a lot#
IF $GET(STAT)=3
IF FILL
IF $$GET1^DIQ(52.1,FILL_","_PSRX,5,"I")
QUIT $$FMTE^XLFDT($$GET1^DIQ(52.1,FILL_","_PSRX,32.1,"I"),2)
+14 IF '$GET(CDATE)
Begin DoDot:1
+15 ;Transmission DT/TM
SET CDATE=$PIECE(^PSX(550.2,TRANS,0),"^",6)
End DoDot:1
+16 QUIT $GET(CDATE)
+17 ;
REFRESH ;Screen Refresh
+1 WRITE ?52,"Please wait..."
DO INIT
DO HDR
SET VALMBCK="R"
+2 QUIT
+3 ;
EXIT ;
+1 KILL ^TMP("PSOERXHL",$JOB)
+2 QUIT
+3 ;
HELP QUIT
