PSOERHL0 ;BIRM/MFR - eRx History Log View - Listman Driver ;04/12/23
;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
;
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
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 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 IEN=0 ;ORDER LOOP
. S IEN=$O(^PS(52.41,"B",OERR,IEN))
. I IEN D
. . S FLGDT=$$GET1^DIQ(52.41,IEN,33) ;Date/Time FLAGGED ^PS(52.41, NODE FLG PIECE 1 FLD#33
. . S FLGBY=$$GET1^DIQ(52.41,IEN,34,"I") ;Flagged By ^PS(52.41, NODE FLG PIECE 2 FLD#34
. . S FLGREA=$$GET1^DIQ(52.41,IEN,35) ;Reason for FLAG ^PS(52.41, NODE FLG PIECE 3 FLD#35
. . S UNFLGDT=$$GET1^DIQ(52.41,IEN,36) ;Date/Time UNFLAGGED ^PS(52.41, NODE FLG PIECE 4 FLD#36
. . S UNFLGBY=$$GET1^DIQ(52.41,IEN,37,"I") ;UNFLAGGED By ^PS(52.41, NODE FLG PIECE 5 FLD#37
. . S UNFLGRE=$$GET1^DIQ(52.41,IEN,38) ;Reason for UNFLAG ^PS(52.41, NODE FLG PIECE 6 FLD#38
. . I $G(FLGDT)'="" S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)="Date/Time Flagged:"_" "_$$FMTE^XLFDT(FLGDT,"2Z")
. . I $G(FLGBY)'="" S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)="Flagged By:"_" "_$E($$GET1^DIQ(200,FLGBY,.01),1,26)
. . I $G(FLGREA)'="" S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)="Reason for Flag:"_" "_$G(FLGREA),HIGHLN(LINE)="1^80"
. . I $G(UNFLGDT)'="" S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)="Date/Time Unflagged:"_" "_$$FMTE^XLFDT(UNFLGDT,"2Z")
. . I $G(UNFLGBY)'="" S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)="Unflagged By:"_" "_$E($$GET1^DIQ(200,UNFLGBY,.01),1,26)
. . I $G(UNFLGRE)'="" S LINE=LINE+1 S ^TMP("PSOERXHL",$J,LINE,0)="Reason for Unflag:"_" "_$G(UNFLGRE),HIGHLN(LINE)="1^80"
;
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,"[(","_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 12951 printed Nov 22, 2024@17:37:41 Page 2
PSOERHL0 ;BIRM/MFR - eRx History Log View - Listman Driver ;04/12/23
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
+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
+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 ;Order Status
SET ORSTAT=$$GET1^DIQ(100,OERR_",",5,"E")
+52 ;Date/Time
SET DATETM=$$GET1^DIQ(100,OERR_",",31,"I")
+53 SET X2=$$FMTE^XLFDT(DATETM,"2Z")
SET $EXTRACT(X2,24)=OERR
SET $EXTRACT(X2,43)=ORSTAT
+54 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+55 ;ORDER LOOP
SET IEN=0
+56 SET IEN=$ORDER(^PS(52.41,"B",OERR,IEN))
+57 IF IEN
Begin DoDot:2
+58 ;Date/Time FLAGGED ^PS(52.41, NODE FLG PIECE 1 FLD#33
SET FLGDT=$$GET1^DIQ(52.41,IEN,33)
+59 ;Flagged By ^PS(52.41, NODE FLG PIECE 2 FLD#34
SET FLGBY=$$GET1^DIQ(52.41,IEN,34,"I")
+60 ;Reason for FLAG ^PS(52.41, NODE FLG PIECE 3 FLD#35
SET FLGREA=$$GET1^DIQ(52.41,IEN,35)
+61 ;Date/Time UNFLAGGED ^PS(52.41, NODE FLG PIECE 4 FLD#36
SET UNFLGDT=$$GET1^DIQ(52.41,IEN,36)
+62 ;UNFLAGGED By ^PS(52.41, NODE FLG PIECE 5 FLD#37
SET UNFLGBY=$$GET1^DIQ(52.41,IEN,37,"I")
+63 ;Reason for UNFLAG ^PS(52.41, NODE FLG PIECE 6 FLD#38
SET UNFLGRE=$$GET1^DIQ(52.41,IEN,38)
+64 IF $GET(FLGDT)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Date/Time Flagged:"_" "_$$FMTE^XLFDT(FLGDT,"2Z")
+65 IF $GET(FLGBY)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Flagged By:"_" "_$EXTRACT($$GET1^DIQ(200,FLGBY,.01),1,26)
+66 IF $GET(FLGREA)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Reason for Flag:"_" "_$GET(FLGREA)
SET HIGHLN(LINE)="1^80"
+67 IF $GET(UNFLGDT)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Date/Time Unflagged:"_" "_$$FMTE^XLFDT(UNFLGDT,"2Z")
+68 IF $GET(UNFLGBY)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Unflagged By:"_" "_$EXTRACT($$GET1^DIQ(200,UNFLGBY,.01),1,26)
+69 IF $GET(UNFLGRE)'=""
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Reason for Unflag:"_" "_$GET(UNFLGRE)
SET HIGHLN(LINE)="1^80"
End DoDot:2
End DoDot:1
+70 ;
+71 NEW ERXHUB,PSRX,AUD,ZAUD,IENS,PRESE,PRESI,DATETIME,FLDNAME,EDITEDBY,FILL,COMMENT,X,X1,X2
+72 SET ERXHUB=$PIECE(^PS(52.49,PSOERXID,0),"^",1)
+73 ;RX ACTIVITY LOG
SET (PSRX,AUD,IEN)=0
+74 SET PRESE=$$GET1^DIQ(52.49,PSOERXID,.13,"E")
+75 SET PRESI=$$GET1^DIQ(52.49,PSOERXID,.13,"I")
+76 IF PRESE'=""
Begin DoDot:1
+77 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+78 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Prescription:"
SET REVLN(LINE)="1^13"
SET UNDLN(LINE)="14^80"
+79 SET X="Prescription#: "
SET $EXTRACT(X,16)=PRESE
SET $EXTRACT(X,38)="Status: "
SET $EXTRACT(X,47)=$$GET1^DIQ(52,PRESI,100,"E")
+80 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X
End DoDot:1
+81 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+82 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Activity Log:"
SET REVLN(LINE)="1^13"
+83 SET X1="Date/Time"
SET $EXTRACT(X1,19)="Reason"
SET $EXTRACT(X1,41)="Rx Ref"
SET $EXTRACT(X1,57)="Initiator Of Activity"
+84 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
+85 SET LINE=LINE+1
SET $PIECE(^TMP("PSOERXHL",$JOB,LINE,0),"=",79)="="
+86 IF '$DATA(^PSRX("D",ERXHUB,"PHARMACY"))
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="No Activity Log Available"
+87 FOR
SET PSRX=$ORDER(^PSRX("D",ERXHUB,"PHARMACY",PSRX))
if 'PSRX
QUIT
Begin DoDot:1
+88 IF '$DATA(^PSRX(PSRX,"A"))
QUIT
+89 FOR
SET AUD=$ORDER(^PSRX(PSRX,"A",AUD))
if 'AUD
QUIT
Begin DoDot:2
+90 SET ZAUD=$GET(^PSRX(PSRX,"A",AUD,0))
+91 SET IENS=AUD_","_PSRX_","
+92 IF $$GET1^DIQ(52.3,IENS,.02,"I")="M"
QUIT
+93 SET DATETIME=$PIECE(ZAUD,"^",1)
+94 SET EDITEDBY=$PIECE(ZAUD,"^",3)
+95 SET FILL=$PIECE(ZAUD,"^",4)
+96 SET COMMENT=$PIECE(ZAUD,"^",5)
+97 SET FILL=$SELECT(FILL>0&(FILL<6):"REFILL "_FILL,FILL=6:"PARTIAL",FILL>6:"REFILL "_(FILL-1),1:"ORIGINAL")
+98 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)
+99 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+100 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
+101 ;
+102 NEW PSRX,AUD,ZAUD,ZAUD1,TRANS,SEQNO,FILL,FILLD,STAT,STATD,BREF,DATE,NDC,COMMENTS,CARR,PKGID,FLDNAME,X1,X2,X3
+103 SET PSRX=$$GET1^DIQ(52.49,PSOERXID,.13,"I")
+104 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+105 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="CMOP Event Log:"
SET REVLN(LINE)="1^15"
+106 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"
+107 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
+108 SET LINE=LINE+1
SET $PIECE(^TMP("PSOERXHL",$JOB,LINE,0),"=",79)="="
+109 IF '$GET(PSRX)
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="No CMOP Log Available"
+110 IF $GET(PSRX)
IF '$DATA(^PSRX(PSRX,4))
SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="No CMOP Log Available"
+111 IF $GET(PSRX)
IF $DATA(^PSRX(PSRX,4))
Begin DoDot:1
+112 ;CMOP LOOP
SET AUD=0
+113 FOR
SET AUD=$ORDER(^PSRX(PSRX,4,AUD))
if 'AUD
QUIT
Begin DoDot:2
+114 SET ZAUD=$GET(^PSRX(PSRX,4,AUD,0))
+115 SET ZAUD1=$GET(^PSRX(PSRX,4,AUD,1))
+116 ;Transmission #
SET TRANS=$PIECE(ZAUD,U)
+117 ;Sequence #
SET SEQNO=$PIECE(ZAUD,U,2)
+118 ;Rx Indicator
SET FILL=$PIECE(ZAUD,U,3)
+119 SET FILLD=$SELECT(FILL>0&(FILL<6):"REFILL "_FILL,FILL=6:"PARTIAL",FILL>6:"REFILL "_(FILL-1),1:"ORIGINAL")
+120 ;Status
SET STAT=$PIECE(ZAUD,U,4)
+121 SET STATD=$$STATDSP(STAT)
+122 SET BREF=$GET(TRANS)_"-"_$GET(SEQNO)
+123 ;Date
SET DATE=$$CMOPDT(PSRX,FILL)
+124 ;NDC Received
SET NDC=$PIECE(ZAUD,U,8)
+125 ;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:"")
+126 ;Carrier
SET CARR=$PIECE(ZAUD1,U,3)
+127 ;Package ID
SET PKGID=$PIECE(ZAUD1,U,4)
+128 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
+129 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X2
+130 SET X3="Carrier: "_CARR
SET $EXTRACT(X3,28)="Package ID: "_PKGID
+131 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X3
+132 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
+133 ;
+134 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=""
+135 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)="Change, Cancel, Renewal Log:"
SET REVLN(LINE)="1^28"
+136 SET X1="Date/Time"
SET $EXTRACT(X1,19)="MessageType"
SET $EXTRACT(X1,37)="eRx ID"
SET $EXTRACT(X1,63)="eRx Order Status"
+137 SET LINE=LINE+1
SET ^TMP("PSOERXHL",$JOB,LINE,0)=X1
SET UNDLN(LINE)="1^80"
+138 NEW FLAG,MTYPE,REQIEN,REQID,RESIEN,RESID,RELERX,RELMES,RELTYPE,RESTYPE,REQTYPE
+139 SET (FLAG,RELMES)=0
+140 SET MTYPE=$$GET1^DIQ(52.49,PSOERXID,.08,"I")
+141 IF ",RR,CA,CR,"[(","_MTYPE_",")
Begin DoDot:1
+142 ;If the message is a Request
SET FLAG=1
SET REQIEN=PSOERXID
SET RESIEN=$$GETRESP^PSOERXU2(PSOERXID)
+143 SET RESTYPE=$$GET1^DIQ(52.49,RESIEN,.08,"I")
+144 IF ",N,RR,CA,CR,"[(","_RESTYPE_",")
SET RESIEN=""
End DoDot:1
+145 IF ",RE,CN,CX,"[(","_MTYPE_",")
Begin DoDot:1
+146 ;If the message is a Response
SET FLAG=1
SET RESIEN=PSOERXID
SET REQIEN=$$RESOLV^PSOERXU2(PSOERXID)
+147 SET REQTYPE=$$GET1^DIQ(52.49,REQIEN,.08,"I")
+148 IF ",N,RE,CN,CX,"[(","_REQTYPE_",")
SET REQIEN=""
End DoDot:1
+149 ;If the message is a New eRx
IF ",N,"[(","_MTYPE_",")
Begin DoDot:1
+150 DO GETDATA^PSOERHL1(PSOERXID)
+151 FOR
SET RELMES=$ORDER(^PS(52.49,PSOERXID,201,"B",RELMES))
if 'RELMES
QUIT
Begin DoDot:2
+152 SET RELTYPE=$$GET1^DIQ(52.49,RELMES,.08,"I")
+153 IF ",RR,CA,CR,RE,CN,CX,"[(","_RELTYPE_",")
Begin DoDot:3
+154 DO GETDATA^PSOERHL1(RELMES)
End DoDot:3
End DoDot:2
End DoDot:1
+155 ;If the message is an Inbound Error
IF MTYPE="IE"
SET FLAG=1
SET RESIEN=PSOERXID
SET REQIEN=$$RESOLV^PSOERXU2(PSOERXID)
+156 ;Inbound Error, Request and Response below
+157 IF $GET(FLAG)
Begin DoDot:1
+158 IF $GET(REQIEN)'=""
SET REQID=$$GET1^DIQ(52.49,REQIEN,.01,"E")
SET RELERX=$$GET1^DIQ(52.49,REQIEN,.14)
+159 IF $GET(RESIEN)'=""
SET RESID=$$GET1^DIQ(52.49,RESIEN,.01,"E")
+160 ;New eRX
IF $GET(RELERX)'=""
Begin DoDot:2
+161 NEW ERXIEN
SET ERXIEN=$ORDER(^PS(52.49,"B",RELERX,0))
+162 DO GETDATA^PSOERHL1(ERXIEN)
End DoDot:2
+163 ;Request
IF $GET(REQID)'=""
Begin DoDot:2
+164 NEW ERXIEN
SET ERXIEN=$ORDER(^PS(52.49,"B",REQID,0))
+165 DO GETDATA^PSOERHL1(ERXIEN)
End DoDot:2
+166 ;Response
IF $GET(RESID)'=""
Begin DoDot:2
+167 NEW ERXIEN
SET ERXIEN=$ORDER(^PS(52.49,"B",RESID,0))
+168 DO GETDATA^PSOERHL1(ERXIEN)
End DoDot:2
End DoDot:1
+169 QUIT
+170 ;
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
+1 ;
