PSOERXU7 ;ALB/BLB,RM - eRx Utilities/RPC's ; 11/27/2019 11:02am
;;7.0;OUTPATIENT PHARMACY;**581,617,700,746,769**;DEC 1997;Build 26
;
Q
MEDDIS(ERXIEN,LINE) ;
N DRUG,DIEN,QTY,DAYS,WDATE,EFDATE,REFILL,EXDATE,LFDATE,DIRECT,CLQ,USC,PUC,F,IENS,I,LTXT
N RXIEN,RXNUM,INS,DDAT,PARIEN,OREFILL,DLOOP,DIARY,MIEN,MTYPE,DATAIEN,QUOM,SIG1TXT,SIG1ARY,II
S F=52.49311
I '$G(SDERXFLG) S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"****************************MEDICATION DISPENSED****************************")
I $G(SDERXFLG) D SET^VALM10(LINE," MEDICATION DISPENSED "),CNTRL^VALM10(LINE,1,80,$G(IOUON)_$G(IOINHI),$G(IOUOFF)_$G(IOINORM))
S PARIEN=$$RESOLV^PSOERXU2(ERXIEN)
I PARIEN S RXIEN=$$GET1^DIQ(52.49,PARIEN,.13,"I")
I $G(RXIEN) S OREFILL=$$GET1^DIQ(52,RXIEN,9,"E")
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
I MTYPE="RE" S DATAIEN=$$GETREQ^PSOERXU2(ERXIEN)
I MTYPE="RR" S DATAIEN=ERXIEN
S MIEN=0 F S MIEN=$O(^PS(52.49,DATAIEN,311,"C","D",MIEN)) Q:'MIEN D
.S IENS=MIEN_","_DATAIEN_","
.D GETS^DIQ(F,IENS,".03;2.1;2.3;2.4;2.5;2.8","IE","DDAT")
.S DRUG=$G(DDAT(F,IENS,.03,"E"))
.S:DRUG'="" DIEN=$O(^PSDRUG("B",DRUG,0))
.S QTY=$G(DDAT(F,IENS,2.1,"E"))
.S DAYS=$G(DDAT(F,IENS,2.4,"E"))
.S REFILL=$G(DDAT(F,IENS,2.8,"E"))
.S WDATE=$G(DDAT(F,IENS,2.5,"E"))
.S I=$G(DDAT(F,IENS,2.3,"I"))
.S QUOM=$$CODEDESC(I)
.; if there is an RX ien, reset the refills to that value - may need to adjust other fields as well
.I $G(RXIEN) S REFILL=$$GET1^DIQ(52,RXIEN,9,"E")
.S LINE=LINE+1 D SET^VALM10(LINE,"Vista Drug: "_DRUG_" "_$P($$VADRSCH^PSOERXUT(+$G(DIEN)),"^",3)),CNTRL^VALM10(LINE,13,68,$G(IOINHI),$G(IOINORM))
.S LINE=LINE+1
.D ADDITEM^PSOERX1A(.LTXT,"Vista Qty: ",$G(QTY),1,25)
.D ADDITEM^PSOERX1A(.LTXT,"Vista Refills: ",$G(REFILL),27,18)
.D ADDITEM^PSOERX1A(.LTXT,"Vista Days Supply: ",$G(DAYS),54,22)
.D SET^VALM10(LINE,LTXT)
.I $G(SDERXFLG) D
. . D CNTRL^VALM10(LINE,12,10,$G(IOINHI),$G(IOINORM)) ;Vista Qty
. . D CNTRL^VALM10(LINE,43,10,$G(IOINHI),$G(IOINORM)) ;Vista Refills
. . D CNTRL^VALM10(LINE,74,7,$G(IOINHI),$G(IOINORM)) ;Vista Days Supply
.S LTXT=""
.S LINE=LINE+1 D SET^VALM10(LINE,"Quantity Unit Of Measure: "_QUOM),CNTRL^VALM10(LINE,27,$L($G(QUOM)),$G(IOINHI),$G(IOINORM))
I $G(RXIEN) D
.S RXNUM=$$GET1^DIQ(52,RXIEN,.01,"E"),SIG1TXT=""
.S INS=0 F S INS=$O(^PSRX(RXIEN,"SIG1",INS)) Q:'INS S SIG1TXT=SIG1TXT_$G(^PSRX(RXIEN,"SIG1",INS,0))_" "
.D TXT2ARY^PSOERXD1(.SIG1ARY,SIG1TXT," ",75)
.S II=0 F S II=$O(SIG1ARY(II)) Q:'II D
..S LINE=LINE+1 D SET^VALM10(LINE,$S(II=1:"Vista Sig: ",1:$J("",11))_SIG1ARY(II)),CNTRL^VALM10(LINE,11,80,$G(IOINHI),$G(IOINORM))
I '$L($G(RXNUM)) S RXNUM="Unable to resolve."
S LINE=LINE+1 D SET^VALM10(LINE,"VA Rx#: "_$G(RXNUM)),CNTRL^VALM10(LINE,9,$L($G(RXNUM)),$G(IOINHI),$G(IOINORM))
Q
; CODE - code value such as C12345 (.01 value in file 52.45)
; TYPE - The type of code you are looking for such as "NCI", "CLQ", "RES", etc.
CODERES(CODE,TYPE) ;
Q:TYPE=""!(CODE="") ""
N IEN
S IEN=$O(^PS(52.45,"C",TYPE,CODE,0))
Q $$CODEDESC(IEN)
; IEN - ien of the code in file 52.45
CODEDESC(IEN) ;
Q $$GET1^DIQ(52.45,IEN,.02,"E")
GETPTPH(PATIEN,S2017,CODES) ; Get Patient primary telephone
N CIEN,CODE,EXT,FILE,IENS,PATEL,SUB,TYPE
I S2017 D
.S CODE=$P(CODES,",")
.S PATEL=$$COMMVAL^PSOERXU5(PATIEN,52.46,13,CODE)
I 'S2017 D
.S SUB=3,CODE=$P(CODES,",",2),FILE=52.462
.S PATEL=""
.S CIEN=$O(^PS(52.46,PATIEN,SUB,"C",CODE,0))
.I CIEN D
..S IENS=CIEN_","_PATIEN_","
..S PATEL=$$GET1^DIQ(FILE,IENS,.01,"I")
.I 'CIEN D
..S CIEN=0
..F S CIEN=$O(^PS(52.46,PATIEN,SUB,CIEN)) Q:CIEN'?1.N D Q:PATEL]""
...S IENS=CIEN_","_PATIEN_","
...S PATEL=$$GET1^DIQ(FILE,IENS,.01,"I")
...S TYPE=$$GET1^DIQ(FILE,IENS,.02,"I")
...S:TYPE="EM" PATEL=""
.I PATEL]"" D
..S EXT=$$GET1^DIQ(FILE,IENS,.03,"I")
..S:EXT]"" PATEL=PATEL_"X"_EXT
;/JSG/ PSO*7.0*581 - END CHANGE
Q PATEL
RXEPRMT(ERXIEN) ;
N DIR,Y,RES,ERXSTAT,MTYPE,NSTAT
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
S RES=""
S DIR(0)="YO"
W !,"There was a processing error."
W !,"Please validate that the eRx was discontinued in Outpatient Pharmacy and/or"
W !,"canceled in the Holding Queue."
S DIR("A")="Would you like to continue to process the record?"
S DIR("B")="YES"
D ^DIR
; if they wish to continue, update the status to RXI
S NSTAT=$S(MTYPE="RE":"RXI",1:"CXI")
I Y S RES=Y D UPDSTAT^PSOERXU1(ERXIEN,NSTAT)
Q RES
OPACCESS(OPTION,DUZ,ERXIEN) ;
N MTYPE,EVAL,RESVAL,MSTAT,DELTA,RET,RESIEN,REQIEN,RESCHECK,MESREQ,MBMALLOW
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
S MSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
S RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
I MSTAT="CXE",($G(OPTION)'["PSO ERX VALIDATE") Q 0
S MESREQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"E")
I MTYPE="CX"!(MTYPE="CR"),$E(RESVAL)'="V",($E(RESVAL)'="A"!(",G,T,S,OS,D,"'[MESREQ)) Q 0
I MSTAT="CXP"!(MSTAT="CXQ")!(MSTAT="CXC") Q 0
I MSTAT="CRE" Q 0
I MSTAT="RRE"!(MSTAT="RRN") Q 0
I MTYPE="RE",((RESVAL="D")!(RESVAL="DNP"))!(RESVAL="A") Q 0
I MTYPE="RE",(MSTAT="RXP")!(MSTAT="RXC")!(MSTAT="RRC") Q 0
I MTYPE="RE",$G(OPTION)["HOLD",MSTAT="RXE" Q 0
I MTYPE="RR",(MSTAT="RRC")!(MSTAT="RRR") Q 0
I (MTYPE="RE")!(MTYPE="RR"),(MSTAT="CAN")!(MSTAT="RXD")!(MSTAT="RRP") Q 0
I MTYPE="CA"!(MTYPE="CN")!(MTYPE="IE") Q 0
I MTYPE="N",$$GET1^DIQ(52.49,PSOIEN,1,"E")="CAN" Q 0
; MbM Only - Change to allow users to validate Patient, Provider and Drug for records on Hold, as well as Accept Validation
S MBMALLOW=0
I $$GET1^DIQ(59.7,1,102,"I")="MBM",$E(MSTAT)="H",'$D(^XUSEC("PSO ERX VIEW",DUZ)) D I $G(MBMALLOW) Q 1
. I OPTION="PSO ERX VALIDATE PATIENT" S MBMALLOW=1
. I OPTION="PSO ERX VALIDATE PROVIDER" S MBMALLOW=1
. I OPTION="PSO ERX VALIDATE DRUG" S MBMALLOW=1
. I OPTION="PSO ERX ACCEPT VALIDATION" S MBMALLOW=1
I $E(MSTAT)="H",OPTION'["HOLD",OPTION'["UNHOLD",OPTION'["PRINT",OPTION'["HISTORY",OPTION'["REMOVE" Q 0
I OPTION="PSO ERX ACCEPT ERX",(RESVAL="AWC"!(RESVAL="R")),MTYPE="RE",(MSTAT="RXN"!(MSTAT="RXW")) D Q RET
.S RET=0 I ('$D(^XUSEC("PSDRPH",DUZ))),('$D(^XUSEC("PSO ERX ADV TECH",DUZ))) Q
.I MSTAT="RXW" S RET=1 Q
.S RESIEN=PSOIEN,REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
.D RRDELTA^PSOERXU2(.DELTA,REQIEN,RESIEN)
.I $D(DELTA(52.49,"EXTERNAL PROVIDER")) S RET=1
; block all but accept erx on eRx's in RXW status
I OPTION'="PSO ERX ACCEPT ERX",MSTAT="RXW",RESVAL'="R" Q 0
;
I OPTION="PSO ERX UNHOLD",($D(^XUSEC("PSO ERX VIEW",DUZ))) Q 0
I OPTION="PSO ERX REJECT"!(OPTION="PSO ERX REMOVE"),MSTAT="RXE" Q 0
I OPTION="PSO ERX REJECT"!(OPTION="PSO ERX REMOVE")!(OPTION="PSO ERX HOLD")!(OPTION="PSO ERX UNHOLD"),MSTAT="RXN" Q 0
I OPTION="PSO ERX ACCEPT ERX",('$D(^XUSEC("PSDRPH",DUZ))),('$D(^XUSEC("PSO ERX ADV TECH",DUZ))) Q 0
I OPTION="PSO ERX ACCEPT VALIDATION",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
I OPTION="PSO ERX REJECT",($D(^XUSEC("PSO ERX VIEW",DUZ))) Q 0
I OPTION="PSO ERX REMOVE",($D(^XUSEC("PSO ERX VIEW",DUZ))) Q 0
I OPTION="PSO ERX VALIDATE PATIENT",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
I OPTION="PSO ERX VALIDATE PROVIDER",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
I OPTION="PSO ERX VALIDATE DRUG",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
I OPTION="PSO ERX HOLD",$D(^XUSEC("PSO ERX VIEW",DUZ)) Q 0
Q 1
ERRDISP(ERXIEN,LINE) ;
N ECODE,ETEXT,EDECODE,EDICODE,I,ERRDTTM
S ECODE=$$GET1^DIQ(52.49,ERXIEN,60.1,"E")
S ETEXT=$$GET1^DIQ(52.49,ERXIEN,60,"E")
S ERRDTTM=$$GET1^DIQ(52.49,ERXIEN,.03,"E")
S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"*****************************ERROR DETAILS********************************")
I $G(SDERXFLG) D SET^VALM10(LINE," ERROR DETAILS "),CNTRL^VALM10(LINE,1,80,$G(IOUON)_$G(IOINHI),$G(IOUOFF)_$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"Error Date/Time: "_ERRDTTM),CNTRL^VALM10(LINE,18,$L(ERRDTTM),$G(IOINHI),$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"Code: "_ECODE),CNTRL^VALM10(LINE,7,$L(ECODE),$G(IOINHI),$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"Details: "_ETEXT),CNTRL^VALM10(LINE,10,$L(ETEXT),$G(IOINHI),$G(IOINORM))
I $D(^PS(52.49,ERXIEN,61)) D
.I '$G(SDERXFLG) S LINE=LINE+1 D SET^VALM10(LINE,"")
.S LINE=LINE+1 D SET^VALM10(LINE,"Description Codes")
.S LINE=LINE+1 D SET^VALM10(LINE,"=================")
.I '$G(SDERXFLG) S LINE=LINE+1 D SET^VALM10(LINE,"")
S I=0 F S I=$O(^PS(52.49,ERXIEN,61,I)) Q:'I D
.S EDECODE=$$GET1^DIQ(52.4961,I_","_ERXIEN_",",.01,"E")
.S EDICODE=$$GET1^DIQ(52.4961,I_","_ERXIEN_",",.01,"I")
.S LINE=LINE+1 D SET^VALM10(LINE,EDICODE_" - "_EDECODE),CNTRL^VALM10(LINE,1,$L(EDICODE_" - "_EDECODE),$G(IOINHI),$G(IOINORM))
Q
;
; refill request information
RRREQ(ERXIEN,LINE) ;
N REQBY,REQDTTM,REFREQ,COMM,COMMARY,I,COMMBY,COMMDTTM,CTXT,REQIEN,S2017
S REQIEN=ERXIEN
I $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE" S REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
S REQBY=$$GET1^DIQ(52.49,REQIEN,51.1,"E")
S REFREQ=$$GET1^DIQ(52.49,REQIEN,51.2,"E")
S REQDTTM=$$GET1^DIQ(52.49,REQIEN,.03,"E")
S COMM=$$GET1^DIQ(52.49,REQIEN,50,"E")
S S2017=$$GET1^DIQ(52.49,ERXIEN,312.1)
I '$G(SDERXFLG) S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"************************RXRENEWAL REQUEST INFORMATION**************************")
I $G(SDERXFLG) D SET^VALM10(LINE," RXRENEWAL REQUEST INFORMATION "),CNTRL^VALM10(LINE,1,80,$G(IOUON)_$G(IOINHI),$G(IOUOFF)_$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"Requested By: "_REQBY),CNTRL^VALM10(LINE,15,$L(REQBY),$G(IOINHI),$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"Request Date/Time: "_REQDTTM),CNTRL^VALM10(LINE,20,$L(REQDTTM),$G(IOINHI),$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"# of Refills Requested: "_REFREQ),CNTRL^VALM10(LINE,25,$L(REFREQ),$G(IOINHI),$G(IOINORM))
I '$G(SDERXFLG) S LINE=LINE+1 D SET^VALM10(LINE,"")
S COMM="RxRenewal Request Comments: "_COMM
D TXT2ARY^PSOERXD1(.COMMARY,COMM," ",80)
S I=0 F S I=$O(COMMARY(I)) Q:'I D
.S CTXT=$G(COMMARY(I))
.S LINE=LINE+1 D SET^VALM10(LINE,CTXT)
.I I=1 D CNTRL^VALM10(LINE,29,$L($P(CTXT,":",2)),$G(IOINHI),$G(IOINORM)) Q
.D CNTRL^VALM10(LINE,1,$L(CTXT),$G(IOINHI),$G(IOINORM))
S COMMBY=$$GET1^DIQ(52.49,REQIEN,50.1,"E")
S COMMDTTM=$$GET1^DIQ(52.49,REQIEN,50.2,"E")
S LINE=LINE+1 D SET^VALM10(LINE,"Comments By: "_COMMBY),CNTRL^VALM10(LINE,14,$L(COMMBY),$G(IOINHI),$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"Comments Date/Time: "_COMMDTTM),CNTRL^VALM10(LINE,21,$L(COMMDTTM),$G(IOINHI),$G(IOINORM))
Q
;
MSGHIS(ERXIEN,LINE) ;
N FLAG
S FLAG=+$G(FLAG)
N ERXREF,RELERX,ERXRES,I,ERXHID,FOUND,REQID,RESID,MTYPE
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
I ",RR,CA,CR,"[(","_MTYPE_",") S REQIEN=ERXIEN,RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
I ",RE,CN,CX,"[(","_MTYPE_",") S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
I MTYPE="IE" S RESIEN=ERXIEN,REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
S RESID=$$GET1^DIQ(52.49,RESIEN,.01,"E")
S REQID=$$GET1^DIQ(52.49,REQIEN,.01,"E")
S RELERX=$$GET1^DIQ(52.49,REQIEN,.14)
S FOUND=0
S I=ERXIEN F S I=$O(^PS(52.49,ERXIEN,201,"B",I)) Q:'I!(FOUND) D
.I $$GET1^DIQ(52.49,I,.08,"E")="RE",$$GET1^DIQ(52.49,I,.14,"E")=$$GET1^DIQ(52.49,ERXIEN,.01,"E") S ERXRES=$$GET1^DIQ(52.49,I,.14,"E"),FOUND=1
I '$G(SDERXFLG) S LINE=LINE+1 D SET^VALM10(LINE,"")
S LINE=LINE+1 D SET^VALM10(LINE,"*****************************MESSAGE HISTORY********************************")
I $G(SDERXFLG) D SET^VALM10(LINE," MESSAGE HISTORY "),CNTRL^VALM10(LINE,1,80,$G(IOUON)_$G(IOINHI),$G(IOUOFF)_$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"Request Reference #: "_$G(REQID)),CNTRL^VALM10(LINE,22,$L(REQID),$G(IOINHI),$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"New eRx Reference #: "_RELERX),CNTRL^VALM10(LINE,22,$L(RELERX),$G(IOINHI),$G(IOINORM))
S LINE=LINE+1 D SET^VALM10(LINE,"Response eRx Reference #: "_$G(RESID)),CNTRL^VALM10(LINE,27,$L(RESID),$G(IOINHI),$G(IOINORM))
Q
; displays processing errors
PROCERR(ERXIEN,LINE) ;
N ERRIEN,ERRIENS,ERRTXT,ERRTARY
; quit if there are no processing errors
Q:'$D(^PS(52.49,ERXIEN,100,"C","PX"))
S LINE=LINE+1
I $G(SDERXFLG) D SET^VALM10(LINE," PROCESSING ERRORS "),CNTRL^VALM10(LINE,1,80,$G(IOUON)_$G(IOINHI),$G(IOUOFF)_$G(IOINORM))
E D
.D SET^VALM10(LINE,"")
.S LINE=LINE+1 D SET^VALM10(LINE,"****************************PROCESSING ERRORS*******************************")
S ERRIEN=0 F S ERRIEN=$O(^PS(52.49,ERXIEN,100,ERRIEN)) Q:'ERRIEN D
.S ERRIENS=ERRIEN_","_ERXIEN_","
.S ERRTXT=$$GET1^DIQ(52.49101,ERRIENS,1,"E")
.S ERRTXT="Error Details: "_ERRTXT
.D TXT2ARY^PSOERXD1(.ERRTARY,ERRTXT," ",78)
.S I=0 F S I=$O(ERRTARY(I)) Q:'I D
..S LINE=LINE+1 D SET^VALM10(LINE,$G(ERRTARY(I))),CNTRL^VALM10(LINE,15,$L($G(ERRTARY(I))),$G(IORVON),$G(IORVOFF))
.K ERRTXT,ERRTARY
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXU7 13041 printed Dec 13, 2024@02:29:08 Page 2
PSOERXU7 ;ALB/BLB,RM - eRx Utilities/RPC's ; 11/27/2019 11:02am
+1 ;;7.0;OUTPATIENT PHARMACY;**581,617,700,746,769**;DEC 1997;Build 26
+2 ;
+3 QUIT
MEDDIS(ERXIEN,LINE) ;
+1 NEW DRUG,DIEN,QTY,DAYS,WDATE,EFDATE,REFILL,EXDATE,LFDATE,DIRECT,CLQ,USC,PUC,F,IENS,I,LTXT
+2 NEW RXIEN,RXNUM,INS,DDAT,PARIEN,OREFILL,DLOOP,DIARY,MIEN,MTYPE,DATAIEN,QUOM,SIG1TXT,SIG1ARY,II
+3 SET F=52.49311
+4 IF '$GET(SDERXFLG)
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+5 SET LINE=LINE+1
DO SET^VALM10(LINE,"****************************MEDICATION DISPENSED****************************")
+6 IF $GET(SDERXFLG)
DO SET^VALM10(LINE," MEDICATION DISPENSED ")
DO CNTRL^VALM10(LINE,1,80,$GET(IOUON)_$GET(IOINHI),$GET(IOUOFF)_$GET(IOINORM))
+7 SET PARIEN=$$RESOLV^PSOERXU2(ERXIEN)
+8 IF PARIEN
SET RXIEN=$$GET1^DIQ(52.49,PARIEN,.13,"I")
+9 IF $GET(RXIEN)
SET OREFILL=$$GET1^DIQ(52,RXIEN,9,"E")
+10 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+11 IF MTYPE="RE"
SET DATAIEN=$$GETREQ^PSOERXU2(ERXIEN)
+12 IF MTYPE="RR"
SET DATAIEN=ERXIEN
+13 SET MIEN=0
FOR
SET MIEN=$ORDER(^PS(52.49,DATAIEN,311,"C","D",MIEN))
if 'MIEN
QUIT
Begin DoDot:1
+14 SET IENS=MIEN_","_DATAIEN_","
+15 DO GETS^DIQ(F,IENS,".03;2.1;2.3;2.4;2.5;2.8","IE","DDAT")
+16 SET DRUG=$GET(DDAT(F,IENS,.03,"E"))
+17 if DRUG'=""
SET DIEN=$ORDER(^PSDRUG("B",DRUG,0))
+18 SET QTY=$GET(DDAT(F,IENS,2.1,"E"))
+19 SET DAYS=$GET(DDAT(F,IENS,2.4,"E"))
+20 SET REFILL=$GET(DDAT(F,IENS,2.8,"E"))
+21 SET WDATE=$GET(DDAT(F,IENS,2.5,"E"))
+22 SET I=$GET(DDAT(F,IENS,2.3,"I"))
+23 SET QUOM=$$CODEDESC(I)
+24 ; if there is an RX ien, reset the refills to that value - may need to adjust other fields as well
+25 IF $GET(RXIEN)
SET REFILL=$$GET1^DIQ(52,RXIEN,9,"E")
+26 SET LINE=LINE+1
DO SET^VALM10(LINE,"Vista Drug: "_DRUG_" "_$PIECE($$VADRSCH^PSOERXUT(+$GET(DIEN)),"^",3))
DO CNTRL^VALM10(LINE,13,68,$GET(IOINHI),$GET(IOINORM))
+27 SET LINE=LINE+1
+28 DO ADDITEM^PSOERX1A(.LTXT,"Vista Qty: ",$GET(QTY),1,25)
+29 DO ADDITEM^PSOERX1A(.LTXT,"Vista Refills: ",$GET(REFILL),27,18)
+30 DO ADDITEM^PSOERX1A(.LTXT,"Vista Days Supply: ",$GET(DAYS),54,22)
+31 DO SET^VALM10(LINE,LTXT)
+32 IF $GET(SDERXFLG)
Begin DoDot:2
+33 ;Vista Qty
DO CNTRL^VALM10(LINE,12,10,$GET(IOINHI),$GET(IOINORM))
+34 ;Vista Refills
DO CNTRL^VALM10(LINE,43,10,$GET(IOINHI),$GET(IOINORM))
+35 ;Vista Days Supply
DO CNTRL^VALM10(LINE,74,7,$GET(IOINHI),$GET(IOINORM))
End DoDot:2
+36 SET LTXT=""
+37 SET LINE=LINE+1
DO SET^VALM10(LINE,"Quantity Unit Of Measure: "_QUOM)
DO CNTRL^VALM10(LINE,27,$LENGTH($GET(QUOM)),$GET(IOINHI),$GET(IOINORM))
End DoDot:1
+38 IF $GET(RXIEN)
Begin DoDot:1
+39 SET RXNUM=$$GET1^DIQ(52,RXIEN,.01,"E")
SET SIG1TXT=""
+40 SET INS=0
FOR
SET INS=$ORDER(^PSRX(RXIEN,"SIG1",INS))
if 'INS
QUIT
SET SIG1TXT=SIG1TXT_$GET(^PSRX(RXIEN,"SIG1",INS,0))_" "
+41 DO TXT2ARY^PSOERXD1(.SIG1ARY,SIG1TXT," ",75)
+42 SET II=0
FOR
SET II=$ORDER(SIG1ARY(II))
if 'II
QUIT
Begin DoDot:2
+43 SET LINE=LINE+1
DO SET^VALM10(LINE,$SELECT(II=1:"Vista Sig: ",1:$JUSTIFY("",11))_SIG1ARY(II))
DO CNTRL^VALM10(LINE,11,80,$GET(IOINHI),$GET(IOINORM))
End DoDot:2
End DoDot:1
+44 IF '$LENGTH($GET(RXNUM))
SET RXNUM="Unable to resolve."
+45 SET LINE=LINE+1
DO SET^VALM10(LINE,"VA Rx#: "_$GET(RXNUM))
DO CNTRL^VALM10(LINE,9,$LENGTH($GET(RXNUM)),$GET(IOINHI),$GET(IOINORM))
+46 QUIT
+47 ; CODE - code value such as C12345 (.01 value in file 52.45)
+48 ; TYPE - The type of code you are looking for such as "NCI", "CLQ", "RES", etc.
CODERES(CODE,TYPE) ;
+1 if TYPE=""!(CODE="")
QUIT ""
+2 NEW IEN
+3 SET IEN=$ORDER(^PS(52.45,"C",TYPE,CODE,0))
+4 QUIT $$CODEDESC(IEN)
+5 ; IEN - ien of the code in file 52.45
CODEDESC(IEN) ;
+1 QUIT $$GET1^DIQ(52.45,IEN,.02,"E")
GETPTPH(PATIEN,S2017,CODES) ; Get Patient primary telephone
+1 NEW CIEN,CODE,EXT,FILE,IENS,PATEL,SUB,TYPE
+2 IF S2017
Begin DoDot:1
+3 SET CODE=$PIECE(CODES,",")
+4 SET PATEL=$$COMMVAL^PSOERXU5(PATIEN,52.46,13,CODE)
End DoDot:1
+5 IF 'S2017
Begin DoDot:1
+6 SET SUB=3
SET CODE=$PIECE(CODES,",",2)
SET FILE=52.462
+7 SET PATEL=""
+8 SET CIEN=$ORDER(^PS(52.46,PATIEN,SUB,"C",CODE,0))
+9 IF CIEN
Begin DoDot:2
+10 SET IENS=CIEN_","_PATIEN_","
+11 SET PATEL=$$GET1^DIQ(FILE,IENS,.01,"I")
End DoDot:2
+12 IF 'CIEN
Begin DoDot:2
+13 SET CIEN=0
+14 FOR
SET CIEN=$ORDER(^PS(52.46,PATIEN,SUB,CIEN))
if CIEN'?1.N
QUIT
Begin DoDot:3
+15 SET IENS=CIEN_","_PATIEN_","
+16 SET PATEL=$$GET1^DIQ(FILE,IENS,.01,"I")
+17 SET TYPE=$$GET1^DIQ(FILE,IENS,.02,"I")
+18 if TYPE="EM"
SET PATEL=""
End DoDot:3
if PATEL]""
QUIT
End DoDot:2
+19 IF PATEL]""
Begin DoDot:2
+20 SET EXT=$$GET1^DIQ(FILE,IENS,.03,"I")
+21 if EXT]""
SET PATEL=PATEL_"X"_EXT
End DoDot:2
End DoDot:1
+22 ;/JSG/ PSO*7.0*581 - END CHANGE
+23 QUIT PATEL
RXEPRMT(ERXIEN) ;
+1 NEW DIR,Y,RES,ERXSTAT,MTYPE,NSTAT
+2 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+3 SET RES=""
+4 SET DIR(0)="YO"
+5 WRITE !,"There was a processing error."
+6 WRITE !,"Please validate that the eRx was discontinued in Outpatient Pharmacy and/or"
+7 WRITE !,"canceled in the Holding Queue."
+8 SET DIR("A")="Would you like to continue to process the record?"
+9 SET DIR("B")="YES"
+10 DO ^DIR
+11 ; if they wish to continue, update the status to RXI
+12 SET NSTAT=$SELECT(MTYPE="RE":"RXI",1:"CXI")
+13 IF Y
SET RES=Y
DO UPDSTAT^PSOERXU1(ERXIEN,NSTAT)
+14 QUIT RES
OPACCESS(OPTION,DUZ,ERXIEN) ;
+1 NEW MTYPE,EVAL,RESVAL,MSTAT,DELTA,RET,RESIEN,REQIEN,RESCHECK,MESREQ,MBMALLOW
+2 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+3 SET MSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+4 SET RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+5 IF MSTAT="CXE"
IF ($GET(OPTION)'["PSO ERX VALIDATE")
QUIT 0
+6 SET MESREQ=$$GET1^DIQ(52.49,PSOIEN,315.1,"E")
+7 IF MTYPE="CX"!(MTYPE="CR")
IF $EXTRACT(RESVAL)'="V"
IF ($EXTRACT(RESVAL)'="A"!(",G,T,S,OS,D,"'[MESREQ))
QUIT 0
+8 IF MSTAT="CXP"!(MSTAT="CXQ")!(MSTAT="CXC")
QUIT 0
+9 IF MSTAT="CRE"
QUIT 0
+10 IF MSTAT="RRE"!(MSTAT="RRN")
QUIT 0
+11 IF MTYPE="RE"
IF ((RESVAL="D")!(RESVAL="DNP"))!(RESVAL="A")
QUIT 0
+12 IF MTYPE="RE"
IF (MSTAT="RXP")!(MSTAT="RXC")!(MSTAT="RRC")
QUIT 0
+13 IF MTYPE="RE"
IF $GET(OPTION)["HOLD"
IF MSTAT="RXE"
QUIT 0
+14 IF MTYPE="RR"
IF (MSTAT="RRC")!(MSTAT="RRR")
QUIT 0
+15 IF (MTYPE="RE")!(MTYPE="RR")
IF (MSTAT="CAN")!(MSTAT="RXD")!(MSTAT="RRP")
QUIT 0
+16 IF MTYPE="CA"!(MTYPE="CN")!(MTYPE="IE")
QUIT 0
+17 IF MTYPE="N"
IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="CAN"
QUIT 0
+18 ; MbM Only - Change to allow users to validate Patient, Provider and Drug for records on Hold, as well as Accept Validation
+19 SET MBMALLOW=0
+20 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
IF $EXTRACT(MSTAT)="H"
IF '$DATA(^XUSEC("PSO ERX VIEW",DUZ))
Begin DoDot:1
+21 IF OPTION="PSO ERX VALIDATE PATIENT"
SET MBMALLOW=1
+22 IF OPTION="PSO ERX VALIDATE PROVIDER"
SET MBMALLOW=1
+23 IF OPTION="PSO ERX VALIDATE DRUG"
SET MBMALLOW=1
+24 IF OPTION="PSO ERX ACCEPT VALIDATION"
SET MBMALLOW=1
End DoDot:1
IF $GET(MBMALLOW)
QUIT 1
+25 IF $EXTRACT(MSTAT)="H"
IF OPTION'["HOLD"
IF OPTION'["UNHOLD"
IF OPTION'["PRINT"
IF OPTION'["HISTORY"
IF OPTION'["REMOVE"
QUIT 0
+26 IF OPTION="PSO ERX ACCEPT ERX"
IF (RESVAL="AWC"!(RESVAL="R"))
IF MTYPE="RE"
IF (MSTAT="RXN"!(MSTAT="RXW"))
Begin DoDot:1
+27 SET RET=0
IF ('$DATA(^XUSEC("PSDRPH",DUZ)))
IF ('$DATA(^XUSEC("PSO ERX ADV TECH",DUZ)))
QUIT
+28 IF MSTAT="RXW"
SET RET=1
QUIT
+29 SET RESIEN=PSOIEN
SET REQIEN=$$GETREQ^PSOERXU2(PSOIEN)
+30 DO RRDELTA^PSOERXU2(.DELTA,REQIEN,RESIEN)
+31 IF $DATA(DELTA(52.49,"EXTERNAL PROVIDER"))
SET RET=1
End DoDot:1
QUIT RET
+32 ; block all but accept erx on eRx's in RXW status
+33 IF OPTION'="PSO ERX ACCEPT ERX"
IF MSTAT="RXW"
IF RESVAL'="R"
QUIT 0
+34 ;
+35 IF OPTION="PSO ERX UNHOLD"
IF ($DATA(^XUSEC("PSO ERX VIEW",DUZ)))
QUIT 0
+36 IF OPTION="PSO ERX REJECT"!(OPTION="PSO ERX REMOVE")
IF MSTAT="RXE"
QUIT 0
+37 IF OPTION="PSO ERX REJECT"!(OPTION="PSO ERX REMOVE")!(OPTION="PSO ERX HOLD")!(OPTION="PSO ERX UNHOLD")
IF MSTAT="RXN"
QUIT 0
+38 IF OPTION="PSO ERX ACCEPT ERX"
IF ('$DATA(^XUSEC("PSDRPH",DUZ)))
IF ('$DATA(^XUSEC("PSO ERX ADV TECH",DUZ)))
QUIT 0
+39 IF OPTION="PSO ERX ACCEPT VALIDATION"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+40 IF OPTION="PSO ERX REJECT"
IF ($DATA(^XUSEC("PSO ERX VIEW",DUZ)))
QUIT 0
+41 IF OPTION="PSO ERX REMOVE"
IF ($DATA(^XUSEC("PSO ERX VIEW",DUZ)))
QUIT 0
+42 IF OPTION="PSO ERX VALIDATE PATIENT"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+43 IF OPTION="PSO ERX VALIDATE PROVIDER"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+44 IF OPTION="PSO ERX VALIDATE DRUG"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+45 IF OPTION="PSO ERX HOLD"
IF $DATA(^XUSEC("PSO ERX VIEW",DUZ))
QUIT 0
+46 QUIT 1
ERRDISP(ERXIEN,LINE) ;
+1 NEW ECODE,ETEXT,EDECODE,EDICODE,I,ERRDTTM
+2 SET ECODE=$$GET1^DIQ(52.49,ERXIEN,60.1,"E")
+3 SET ETEXT=$$GET1^DIQ(52.49,ERXIEN,60,"E")
+4 SET ERRDTTM=$$GET1^DIQ(52.49,ERXIEN,.03,"E")
+5 SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+6 SET LINE=LINE+1
DO SET^VALM10(LINE,"*****************************ERROR DETAILS********************************")
+7 IF $GET(SDERXFLG)
DO SET^VALM10(LINE," ERROR DETAILS ")
DO CNTRL^VALM10(LINE,1,80,$GET(IOUON)_$GET(IOINHI),$GET(IOUOFF)_$GET(IOINORM))
+8 SET LINE=LINE+1
DO SET^VALM10(LINE,"Error Date/Time: "_ERRDTTM)
DO CNTRL^VALM10(LINE,18,$LENGTH(ERRDTTM),$GET(IOINHI),$GET(IOINORM))
+9 SET LINE=LINE+1
DO SET^VALM10(LINE,"Code: "_ECODE)
DO CNTRL^VALM10(LINE,7,$LENGTH(ECODE),$GET(IOINHI),$GET(IOINORM))
+10 SET LINE=LINE+1
DO SET^VALM10(LINE,"Details: "_ETEXT)
DO CNTRL^VALM10(LINE,10,$LENGTH(ETEXT),$GET(IOINHI),$GET(IOINORM))
+11 IF $DATA(^PS(52.49,ERXIEN,61))
Begin DoDot:1
+12 IF '$GET(SDERXFLG)
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+13 SET LINE=LINE+1
DO SET^VALM10(LINE,"Description Codes")
+14 SET LINE=LINE+1
DO SET^VALM10(LINE,"=================")
+15 IF '$GET(SDERXFLG)
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
End DoDot:1
+16 SET I=0
FOR
SET I=$ORDER(^PS(52.49,ERXIEN,61,I))
if 'I
QUIT
Begin DoDot:1
+17 SET EDECODE=$$GET1^DIQ(52.4961,I_","_ERXIEN_",",.01,"E")
+18 SET EDICODE=$$GET1^DIQ(52.4961,I_","_ERXIEN_",",.01,"I")
+19 SET LINE=LINE+1
DO SET^VALM10(LINE,EDICODE_" - "_EDECODE)
DO CNTRL^VALM10(LINE,1,$LENGTH(EDICODE_" - "_EDECODE),$GET(IOINHI),$GET(IOINORM))
End DoDot:1
+20 QUIT
+21 ;
+22 ; refill request information
RRREQ(ERXIEN,LINE) ;
+1 NEW REQBY,REQDTTM,REFREQ,COMM,COMMARY,I,COMMBY,COMMDTTM,CTXT,REQIEN,S2017
+2 SET REQIEN=ERXIEN
+3 IF $$GET1^DIQ(52.49,ERXIEN,.08,"I")="RE"
SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
+4 SET REQBY=$$GET1^DIQ(52.49,REQIEN,51.1,"E")
+5 SET REFREQ=$$GET1^DIQ(52.49,REQIEN,51.2,"E")
+6 SET REQDTTM=$$GET1^DIQ(52.49,REQIEN,.03,"E")
+7 SET COMM=$$GET1^DIQ(52.49,REQIEN,50,"E")
+8 SET S2017=$$GET1^DIQ(52.49,ERXIEN,312.1)
+9 IF '$GET(SDERXFLG)
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+10 SET LINE=LINE+1
DO SET^VALM10(LINE,"************************RXRENEWAL REQUEST INFORMATION**************************")
+11 IF $GET(SDERXFLG)
DO SET^VALM10(LINE," RXRENEWAL REQUEST INFORMATION ")
DO CNTRL^VALM10(LINE,1,80,$GET(IOUON)_$GET(IOINHI),$GET(IOUOFF)_$GET(IOINORM))
+12 SET LINE=LINE+1
DO SET^VALM10(LINE,"Requested By: "_REQBY)
DO CNTRL^VALM10(LINE,15,$LENGTH(REQBY),$GET(IOINHI),$GET(IOINORM))
+13 SET LINE=LINE+1
DO SET^VALM10(LINE,"Request Date/Time: "_REQDTTM)
DO CNTRL^VALM10(LINE,20,$LENGTH(REQDTTM),$GET(IOINHI),$GET(IOINORM))
+14 SET LINE=LINE+1
DO SET^VALM10(LINE,"# of Refills Requested: "_REFREQ)
DO CNTRL^VALM10(LINE,25,$LENGTH(REFREQ),$GET(IOINHI),$GET(IOINORM))
+15 IF '$GET(SDERXFLG)
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+16 SET COMM="RxRenewal Request Comments: "_COMM
+17 DO TXT2ARY^PSOERXD1(.COMMARY,COMM," ",80)
+18 SET I=0
FOR
SET I=$ORDER(COMMARY(I))
if 'I
QUIT
Begin DoDot:1
+19 SET CTXT=$GET(COMMARY(I))
+20 SET LINE=LINE+1
DO SET^VALM10(LINE,CTXT)
+21 IF I=1
DO CNTRL^VALM10(LINE,29,$LENGTH($PIECE(CTXT,":",2)),$GET(IOINHI),$GET(IOINORM))
QUIT
+22 DO CNTRL^VALM10(LINE,1,$LENGTH(CTXT),$GET(IOINHI),$GET(IOINORM))
End DoDot:1
+23 SET COMMBY=$$GET1^DIQ(52.49,REQIEN,50.1,"E")
+24 SET COMMDTTM=$$GET1^DIQ(52.49,REQIEN,50.2,"E")
+25 SET LINE=LINE+1
DO SET^VALM10(LINE,"Comments By: "_COMMBY)
DO CNTRL^VALM10(LINE,14,$LENGTH(COMMBY),$GET(IOINHI),$GET(IOINORM))
+26 SET LINE=LINE+1
DO SET^VALM10(LINE,"Comments Date/Time: "_COMMDTTM)
DO CNTRL^VALM10(LINE,21,$LENGTH(COMMDTTM),$GET(IOINHI),$GET(IOINORM))
+27 QUIT
+28 ;
MSGHIS(ERXIEN,LINE) ;
+1 NEW FLAG
+2 SET FLAG=+$GET(FLAG)
+3 NEW ERXREF,RELERX,ERXRES,I,ERXHID,FOUND,REQID,RESID,MTYPE
+4 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+5 IF ",RR,CA,CR,"[(","_MTYPE_",")
SET REQIEN=ERXIEN
SET RESIEN=$$GETRESP^PSOERXU2(ERXIEN)
+6 IF ",RE,CN,CX,"[(","_MTYPE_",")
SET RESIEN=ERXIEN
SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
+7 IF MTYPE="IE"
SET RESIEN=ERXIEN
SET REQIEN=$$RESOLV^PSOERXU2(ERXIEN)
+8 SET RESID=$$GET1^DIQ(52.49,RESIEN,.01,"E")
+9 SET REQID=$$GET1^DIQ(52.49,REQIEN,.01,"E")
+10 SET RELERX=$$GET1^DIQ(52.49,REQIEN,.14)
+11 SET FOUND=0
+12 SET I=ERXIEN
FOR
SET I=$ORDER(^PS(52.49,ERXIEN,201,"B",I))
if 'I!(FOUND)
QUIT
Begin DoDot:1
+13 IF $$GET1^DIQ(52.49,I,.08,"E")="RE"
IF $$GET1^DIQ(52.49,I,.14,"E")=$$GET1^DIQ(52.49,ERXIEN,.01,"E")
SET ERXRES=$$GET1^DIQ(52.49,I,.14,"E")
SET FOUND=1
End DoDot:1
+14 IF '$GET(SDERXFLG)
SET LINE=LINE+1
DO SET^VALM10(LINE,"")
+15 SET LINE=LINE+1
DO SET^VALM10(LINE,"*****************************MESSAGE HISTORY********************************")
+16 IF $GET(SDERXFLG)
DO SET^VALM10(LINE," MESSAGE HISTORY ")
DO CNTRL^VALM10(LINE,1,80,$GET(IOUON)_$GET(IOINHI),$GET(IOUOFF)_$GET(IOINORM))
+17 SET LINE=LINE+1
DO SET^VALM10(LINE,"Request Reference #: "_$GET(REQID))
DO CNTRL^VALM10(LINE,22,$LENGTH(REQID),$GET(IOINHI),$GET(IOINORM))
+18 SET LINE=LINE+1
DO SET^VALM10(LINE,"New eRx Reference #: "_RELERX)
DO CNTRL^VALM10(LINE,22,$LENGTH(RELERX),$GET(IOINHI),$GET(IOINORM))
+19 SET LINE=LINE+1
DO SET^VALM10(LINE,"Response eRx Reference #: "_$GET(RESID))
DO CNTRL^VALM10(LINE,27,$LENGTH(RESID),$GET(IOINHI),$GET(IOINORM))
+20 QUIT
+21 ; displays processing errors
PROCERR(ERXIEN,LINE) ;
+1 NEW ERRIEN,ERRIENS,ERRTXT,ERRTARY
+2 ; quit if there are no processing errors
+3 if '$DATA(^PS(52.49,ERXIEN,100,"C","PX"))
QUIT
+4 SET LINE=LINE+1
+5 IF $GET(SDERXFLG)
DO SET^VALM10(LINE," PROCESSING ERRORS ")
DO CNTRL^VALM10(LINE,1,80,$GET(IOUON)_$GET(IOINHI),$GET(IOUOFF)_$GET(IOINORM))
+6 IF '$TEST
Begin DoDot:1
+7 DO SET^VALM10(LINE,"")
+8 SET LINE=LINE+1
DO SET^VALM10(LINE,"****************************PROCESSING ERRORS*******************************")
End DoDot:1
+9 SET ERRIEN=0
FOR
SET ERRIEN=$ORDER(^PS(52.49,ERXIEN,100,ERRIEN))
if 'ERRIEN
QUIT
Begin DoDot:1
+10 SET ERRIENS=ERRIEN_","_ERXIEN_","
+11 SET ERRTXT=$$GET1^DIQ(52.49101,ERRIENS,1,"E")
+12 SET ERRTXT="Error Details: "_ERRTXT
+13 DO TXT2ARY^PSOERXD1(.ERRTARY,ERRTXT," ",78)
+14 SET I=0
FOR
SET I=$ORDER(ERRTARY(I))
if 'I
QUIT
Begin DoDot:2
+15 SET LINE=LINE+1
DO SET^VALM10(LINE,$GET(ERRTARY(I)))
DO CNTRL^VALM10(LINE,15,$LENGTH($GET(ERRTARY(I))),$GET(IORVON),$GET(IORVOFF))
End DoDot:2
+16 KILL ERRTXT,ERRTARY
End DoDot:1
+17 QUIT
+18 ;
