PSOERXI1 ;ALB/BWF - eRx Utilities/RPC's ; Aug 01, 2025@11:00
;;7.0;OUTPATIENT PHARMACY;**581,617,692,706,700,743,746,783,770,800**;DEC 1997;Build 1
;
;Reference to MAKEADD^TIUSRVP2 in ICR #4795
Q
; File incoming XML into appropriate file
; XML - xml text
; PRCHK - provider check information
; PACHK - patient check information
; DACHK - drug auto check
; STATION - station #
; DIV - institution name^NPI
; ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID
; ERXVALS - code values for NIST codes (potency unit code^form code^strength code^prohibit renewals - change response (y/n))
; XML2 - structured sig from the medication prescribed segment
; VADAT - DUZ^RXIEN
; XML3 - third stream of XML
INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT,XML3) ;
N MBMSITE,CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,PRVAUTOV,VISTARX,VADRUG,DFN,ERXNDC,XMsgPos,XMsgEnd,XMsgSav,XVAR
; This error handling prevents delays at the eRx Hub because it always returns a result
N $ESTACK,$ETRAP S $ETRAP="D ERROR^PSOERXI1"
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
; PSO,800 carry forward xlsns definition if needed for xsi:type in subsequent split message blocks.
I XML["xmlns:xsi" S XMsgPos=$F(XML,"<Message ") I XMsgPos D
. S XMsgEnd=$F(XML,">",XMsgPos) I 'XMsgEnd Q
. S XMsgSav=$E(XML,XMsgPos-1,XMsgEnd-1)
. F XVAR="XML2","XML3" I (@XVAR["<Message>")&(@XVAR["xsi:") S $E(@XVAR,($F(@XVAR,"<Message>")-1))=XMsgSav
S NPI=$P($G(DIV),U,2),CURREC=$$PARSE^PSOERXI2(.XML,.ERXVALS,NPI,.XML2,.XML3)
I $P(CURREC,U)<1 D Q
. I $L($P(CURREC,U,2)) S RES=CURREC Q
. S RES="0^XML received. Error creating or finding associated record in the ERX Holding queue." Q
S EIEN=CURREC
S CURREC=CURREC_","
;If this is an outbound message, file the users DUZ and quit back the response. No drug, patient, or provider auto checks will occur
I $G(VADAT)]"" D Q
. I $P($G(VADAT),U)>1 D
. . S FDA(52.49,CURREC,51.1)=DUZ D FILE^DIE(,"FDA") K FDA
. I $P(VADAT,U,2) D
. . S FDA(52.49,CURREC,.13)=$P(VADAT,U,2) D FILE^DIE(,"FDA") K FDA
. S RES="1^Erx Received."
;Process auto-validation results. Only log positive results for now
K FDA
I $P($G(VADAT),U) S RES="1^Message Filed." Q
;
;Drug Auto-Match (Moved from Hub to VistA - P-692)
;Attempting auto-match based on VistA Drug Suggestions (Uses the lastest one)
N DRUGHASH,MTCHDRUG
S MTCHDRUG=$$MTCHDRUG(),DRUGHASH=$$DRUGHASH^PSOERUT(+CURREC)
I MTCHDRUG,DRUGHASH D
. I $$GET1^DIQ(52.49,CURREC,.08,"I")="RE",$$GET1^DIQ(52.49,CURREC,52.1,"I")'="R" Q
. I $$GET1^DIQ(52.49,CURREC,.08,"I")="CX",$$GET1^DIQ(52.49,CURREC,52.1,"I")'="A",$$GET1^DIQ(52.49,CURREC,52.1,"I")'="AWC" Q
. S ERXNDC=$TR($TR($$GET1^DIQ(52.49311,"1,"_CURREC_",",1.1,"I")," "),"-")
. S VISTARX="" F S VISTARX=$O(^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX),-1) Q:'VISTARX D I $$GET1^DIQ(52.49,+CURREC,3.2,"I") Q
. . S VADRUG=+$$GET1^DIQ(52,VISTARX,6,"I") I 'VADRUG Q
. . I $$GET1^DIQ(50,VADRUG,100,"I") D Q
. . . K ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
. . ; For pre-populating all drug fields, the incoming NDC/Name should match VistA DRUG/NDF files
. . I VADRUG'=MTCHDRUG Q
. . D SAVEDRUG^PSOERUT2(+CURREC,VISTARX)
. . I $$GET1^DIQ(52.49,+CURREC,3.2,"I") D
. . . K DACHK S DACHK("success")="true",FDA(52.49,CURREC,1.4)=1
;Auto-matching the Dispense Drug only
I '$$GET1^DIQ(52.49,+CURREC,3.2,"I"),+$G(MTCHDRUG) D
. K DACHK S DACHK("success")="true"
.;Saving the eRx Audit Log For Auto-Matched Drug
. S NEWVAL(1)=$$GET1^DIQ(50,MTCHDRUG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(MTCHDRUG)_")"
. D AUDLOG^PSOERXUT(+CURREC,"DRUG",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
.;Setting Matched Drug and Auto Match info
. S FDA(52.49,CURREC,3.2)=MTCHDRUG
. S FDA(52.49,CURREC,44)=1
. S VAOI=$$GET1^DIQ(50,MTCHDRUG,2.1,"I")
. S VPATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
. I $L(VPATINST) D
. . S (NEWVAL(1),FDA(52.49,CURREC,27))=VPATINST
. . D AUDLOG^PSOERXUT(+CURREC,"PATIENT INSTRUCTIONS",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
. ; Adjusting the # of refills field if over the maximum allowed
. I $$GET1^DIQ(52.49,+CURREC,20.5)>$$MAXNUMRF^PSOUTIL(MTCHDRUG,$$GET1^DIQ(52.49,+CURREC,20.2)) D
. . S FDA(52.49,+CURREC_",",20.5)=$$MAXNUMRF^PSOUTIL(MTCHDRUG,$$GET1^DIQ(52.49,+CURREC,20.2))
;
I $G(DACHK("success"))'="true" D
. S ERRTXT=$G(DACHK("error"))
. S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ
. D FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)
;
;Provider Auto-Match (Moved from Hub to VistA - P-692)
I $G(PRCHK("success"))="false" D
. N TMP,MSGTYPE,MTCHPROV,TMP,NPI,DEA,CS
. S MSGTYPE=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,"")) I MSGTYPE="" Q
. S DEA=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"DEANumber",0))
. S NPI=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"NPI",0))
. S CS=($G(^TMP($J,"PSOERXO1","Message",0,"Header",0,"DigitalSignature",0,"SignatureValue",0))'="")
. D PRVMTCH^PSOERXA0(.MTCHPROV,NPI,DEA,CS)
. I +$G(MTCHPROV) D
. . K PRCHK S PRCHK("success")="true",PRCHK("IEN")=+MTCHPROV
;Attempting auto-match based on VistA Provider Suggestions (Uses the lastest one)
I '$G(PRCHK("IEN")) D
. N EPRV,VPRV,SUGVPRV,MTCHDT S EPRV=+$$GET1^DIQ(52.49,+CURREC,2.1,"I"),(VPRV,SUGVPRV,MTCHDT)=0
. F S VPRV=$O(^PS(52.49,"APRVVPRV",EPRV,VPRV)) Q:'VPRV D
. . I $$GET1^DIQ(200,VPRV,53.4,"I") K ^PS(52.49,"APRVVPRV",EPRV,VPRV) Q ; VistA Provider is Inactive
. . I $O(^PS(52.49,"APRVVPRV",EPRV,VPRV,""),-1)>MTCHDT D
. . . S SUGVPRV=VPRV,MTCHDT=$O(^PS(52.49,"APRVVPRV",EPRV,VPRV,""),-1)
. I SUGVPRV D
. . K PRCHK S PRCHK("success")="true",FDA(52.49,CURREC,1.2)=1,(FDA(52.49,CURREC,2.3),PRCHK("IEN"))=SUGVPRV
;Auto-Validating Provider
S PRVAUTOV=0
I $G(PRCHK("success"))="true",$G(PRCHK("IEN")) D
. S FDA(52.49,CURREC,1.2)=1
. S FDA(52.49,CURREC,2.3)=PRCHK("IEN")
. ;Auto-Validating Provider if auto-match was successful
. ;Condition: Non-CS eRx only & Last name, first letter of first name and zip code 5 digits must match
. N EPRVIEN,EPRVNAM,EPRVZC,EPRVDEA,VPRVIEN,VPRVNAM,VPRVZC
. S EPRVIEN=$$GET1^DIQ(52.49,+CURREC,2.1,"I")
. S EPRVNAM=$$UP^XLFSTR($TR($$GET1^DIQ(52.48,EPRVIEN,.01)," "))
. S EPRVZC=$P($$GET1^DIQ(52.48,EPRVIEN,4.5),"-")
. S EPRVDEA=$$UP^XLFSTR($$GET1^DIQ(52.48,EPRVIEN,1.6))
. S VPRVIEN=PRCHK("IEN") I '$$CHKPRV2^PSOERX1A(VPRVIEN) Q
. S VPRVNAM=$$UP^XLFSTR($TR($$GET1^DIQ(200,VPRVIEN,.01)," "))
. S VPRVZC=$P($$GET1^DIQ(200,VPRVIEN,.116),"-")
. I $E(EPRVNAM,1,$F(EPRVNAM,","))'=$E(VPRVNAM,1,$F(VPRVNAM,",")) Q
. I $E(EPRVZC,1,5)'=$E(VPRVZC,1,5) Q
. I $$GET1^DIQ(52.49,+CURREC,95.1,"I"),'$$DEAFOUND^PSOERXU8(EPRVDEA,VPRVIEN) Q
. S FDA(52.49,CURREC,1.3)=1
. S FDA(52.49,CURREC,1.8)=$$PROXYDUZ^PSOERXUT()
. S FDA(52.49,CURREC,1.9)=$$NOW^XLFDT()
. S FDA(52.49,CURREC,2.7)=1
. S PRVAUTOV=1
I $G(PRCHK("success"))="true",$G(PRCHK("IEN")) D
. ;Saving the eRx Audit Log for the Auto-Matched Provider
. S NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$P($$VADEA^PSOERXU8(PRCHK("IEN"),+CURREC),"^",2)_")"_$S($G(PRVAUTOV):" - AUTO-VALIDATED",1:"")
. D AUDLOG^PSOERXUT(+CURREC,"PROVIDER",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
;
I $G(PRCHK("success"))="false" D
. S ERRTXT=$G(PRCHK("error"))
. S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ
. D FILERR^PSOERXU1(CURREC,ERRSEQ,"PR","E",ERRTXT)
;
I $G(PACHK("MVIerror"))']"" D
. S PAICN=+$P($G(PACHK("ICN")),"V")
. I PAICN D
. . S (PAIEN,PACNT)=0 F S PAIEN=$O(^DPT("AICN",PAICN,PAIEN)) Q:'PAIEN D
. . . S PACNT=PACNT+1
. . . ;revisit in future build - if we find more than one match in the local system, do we log some sort of an error?
. I $G(PACNT)=1 D Q
. . S FDA(52.49,CURREC,1.6)=1
. . S FDA(52.49,CURREC,.05)=$O(^DPT("AICN",PAICN,0))
. I $L(PACHK("ssn")) D
. . S (PASCNT,PAIEN)=0 F S PAIEN=$O(^DPT("SSN",$TR(PACHK("ssn"),"-",""),PAIEN)) Q:'PAIEN D
. . . S PASCNT=PASCNT+1
. I $G(PASCNT)=1 D Q
. . S FDA(52.49,CURREC,1.6)=1
. . S FDA(52.49,CURREC,.05)=$O(^DPT("SSN",$TR(PACHK("ssn"),"-",""),0))
;Attempting auto-match based on VistA Patient Suggestions (Uses the lastest one)
I '$G(FDA(52.49,CURREC,.05)) D
. N EPAT,VPAT,SUGVPAT,MTCHDT S EPAT=+$$GET1^DIQ(52.49,+CURREC,.04,"I"),(VPAT,SUGVPAT,MTCHDT)=0
. F S VPAT=$O(^PS(52.49,"APATVPAT",EPAT,VPAT)) Q:'VPAT D
. . I $O(^PS(52.49,"APATVPAT",EPAT,VPAT,""),-1)>MTCHDT D
. . . S SUGVPAT=VPAT,MTCHDT=$O(^PS(52.49,"APATVPAT",EPAT,VPAT,""),-1)
. I SUGVPAT S FDA(52.49,CURREC,1.6)=1,FDA(52.49,CURREC,.05)=SUGVPAT
;
;Saving the eRx Audit Log For Auto-Matched Patient
S DFN=+$G(FDA(52.49,CURREC,.05))
I DFN D
. N VADM D DEM^VADPT
. S NEWVAL(1)=$$GET1^DIQ(2,DFN,.01)_" (L4SSN: "_$P($P(VADM(2),"^",2),"-",3)_" | DOB: "_$P(VADM(3),"^",2)_")"
. D AUDLOG^PSOERXUT(+CURREC,"PATIENT",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
;
I $D(FDA) D FILE^DIE(,"FDA") K FDA
;
; Auto-holds for MbM
I $G(MBMSITE),DFN D
. I ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"'[(","_$$GET1^DIQ(52.49,CURREC,1,"I")_",") Q
. I '$$CHVAELIG^PSOERXU9(DFN) D Q
. . D UPDSTAT^PSOERXU1(CURREC,"HEL","Hold due to Eligibility Issue")
. N GMRA,GMRAL
. S GMRA="0^0^111" D EN1^GMRADPT I $G(GMRAL)'="" Q
. D UPDSTAT^PSOERXU1(CURREC,"HAL","Hold for Allergy Assessment")
;
I $G(PACHK("success"))="false" D
.; file e&e error
. S ERRTXT=$G(PACHK("EandEerror")) I ERRTXT]"" D
. . S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ
. . D FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
.; file mvi error
. S ERRTXT=$G(PACHK("MVIerror")) I ERRTXT]"" D
. . S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ
. . D FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
;
S RES="1^Erx Received."
;
;Create an Addendum for eRx Change Response Progress Note
I $G(EIEN)'="",$$GET1^DIQ(52.49,EIEN,.08,"I")="CX" D CREATEADD(ERXHID,EIEN)
Q
;
CREATEADD(ERXHID,EIEN) ;Create CPRS Progress Notes Addendum for this eRx Change Response
;Input: ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID
; EIEN - The eRx Change Response IEN, Pointer to ERX HOLDING QUEUE file (#52.49)
;Output: Create an Addendum and attach it to the parent eRx Change Request
;
I ($G(ERXHID)="")!($G(EIEN)="") Q
N CNT,CRERXIEN,ORGERXIEN,ERXDRUG,CRMEDS,CNT,CXTARGET,ERXDRUG,PSOTIUIEN,TIUDADD,ERXTIUX
;
S CRERXIEN=$O(^PS(52.49,"B",$P(ERXHID,"^",3),0))
S ORGERXIEN=$P($G(^PS(52.49,CRERXIEN,0)),"^",14)
S ORGERXIEN=$O(^PS(52.49,"B",ORGERXIEN,0))
;
;get the parent reference IEN TIU Document
S PSOTIUIEN=$$GET1^DIQ(52.49,CRERXIEN,320.1)
I '$G(PSOTIUIEN) D Q
. N TIUTITLE S TIUTITLE="PHARMACY ERX RX CHANGE REQUEST NOTE"
. I '+$$FIND1^DIC(8925.1,"","X",TIUTITLE,"B") S TIUTITLE="ERX RX CHANGE REQUEST NOTE"
. D BLDCRMEDS(ERXHID,+$G(MTCHDRUG),TIUTITLE)
;
S CXTARGET=$NA(^TMP("TIUP",$J)) K @CXTARGET
D BUILDLST^PSOERSE4(CXTARGET,EIEN)
Q:'$D(@CXTARGET)
K ERXTIUX M ERXTIUX("TEXT")=@CXTARGET
D MAKEADD^TIUSRVP2(.TIUDADD,PSOTIUIEN,.ERXTIUX) ;PSOTIUIEN is the parent IEN from The TIU Document Definition name in File #8925.1
D UPDATEPN^PSOERX1H(.TIUDADD,$G(ORGERXIEN)) ;TIUDADD is the Addendum IEN
Q
;
BLDCRMEDS(ERXHID,VDRUG,TIUTITLE) ;Build eRx Change Response Medication array
;get the original eRx
Q:$G(ERXHID)=""
N CRERXIEN,ORGERXIEN,ERXDRUG,CRMEDS
;
S CRERXIEN=$O(^PS(52.49,"B",$P(ERXHID,"^",3),0))
S ORGERXIEN=$P($G(^PS(52.49,CRERXIEN,0)),"^",14)
S ORGERXIEN=$O(^PS(52.49,"B",ORGERXIEN,0))
S CNT=0
I $G(VDRUG) D
. S ERXDRUG=$$GET1^DIQ(50,$G(VDRUG),.01)
. S CNT=CNT+1,CRMEDS(CNT)="^"_ERXDRUG
;
D CREATEPN^PSOERX1H(ORGERXIEN,EIEN,,.CRMEDS,TIUTITLE) ;create eRx Change Response PN
;
Q
; VAL - value to resolve
; TYPE - This is the code type, which will tell which 'C' index type to get the code from
PRESOLV(VAL,TYPE) ;
N MATCH
S MATCH=""
Q:'$L(TYPE)!('$L(VAL)) "" ; avoid null subscript
S MATCH=$O(^PS(52.45,"C",TYPE,VAL,0))
; return the match found, null if no match
Q MATCH
CONVDTTM(VAL) ;
N EDATE,ETIME,X,ETZ,Y,%DT,%
I '$L(VAL) Q ""
S EDATE=$P(VAL,"T"),ETIME=$P(VAL,"T",2)
; split off time zone
S ETZ=$P(ETIME,".",2)
S ETIME=$P(ETIME,".")
S X=EDATE D ^%DT I 'Y Q ""
S VAL=Y_$S($L(ETIME):"."_$TR(ETIME,":",""),1:"")
Q VAL
;
MTCHDRUG() ; Returns the Matched Dispensed Drug based on the NDF files
;Output: MTCHDRUG - VistA Dispense Drug associated with the Name/NDC from outside (Pointer to file #50)
N MSGTYPE,MEDSEG,MTCHDRUG,PRDCODE,PRDCOQL,DRGNAME
S MTCHDRUG=0
S MSGTYPE=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,"")) I MSGTYPE="" Q 0
S MEDSEG="MedicationPrescribed"
I '$D(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG)) D
. S MEDSEG="MedicationResponse"
S PRDCODE=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Code",0)) I PRDCODE="" Q 0
S PRDCOQL=$E($G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Qualifier",0)),1)
I PRDCOQL'="N",PRDCOQL'="U" Q 0
S DRGNAME=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugDescription",0))
D DRGMTCH^PSOERXA0(.MTCHDRUG,PRDCOQL_"^"_PRDCODE,DRGNAME)
Q +$G(MTCHDRUG)
;
ERROR ; Error Handling
D ^%ZTER
S RES="1^eRx received but there was an error. See error trap at "_$P($TR($$SITE^VASITE(),"^","-"),"-",1,2) Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXI1 13491 printed Jan 29, 2026@15:27:29 Page 2
PSOERXI1 ;ALB/BWF - eRx Utilities/RPC's ; Aug 01, 2025@11:00
+1 ;;7.0;OUTPATIENT PHARMACY;**581,617,692,706,700,743,746,783,770,800**;DEC 1997;Build 1
+2 ;
+3 ;Reference to MAKEADD^TIUSRVP2 in ICR #4795
+4 QUIT
+5 ; File incoming XML into appropriate file
+6 ; XML - xml text
+7 ; PRCHK - provider check information
+8 ; PACHK - patient check information
+9 ; DACHK - drug auto check
+10 ; STATION - station #
+11 ; DIV - institution name^NPI
+12 ; ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID
+13 ; ERXVALS - code values for NIST codes (potency unit code^form code^strength code^prohibit renewals - change response (y/n))
+14 ; XML2 - structured sig from the medication prescribed segment
+15 ; VADAT - DUZ^RXIEN
+16 ; XML3 - third stream of XML
INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT,XML3) ;
+1 NEW MBMSITE,CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,PRVAUTOV,VISTARX,VADRUG,DFN,ERXNDC,XMsgPos,XMsgEnd,XMsgSav,XVAR
+2 ; This error handling prevents delays at the eRx Hub because it always returns a result
+3 NEW $ESTACK,$ETRAP
SET $ETRAP="D ERROR^PSOERXI1"
+4 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+5 ; PSO,800 carry forward xlsns definition if needed for xsi:type in subsequent split message blocks.
+6 IF XML["xmlns:xsi"
SET XMsgPos=$FIND(XML,"<Message ")
IF XMsgPos
Begin DoDot:1
+7 SET XMsgEnd=$FIND(XML,">",XMsgPos)
IF 'XMsgEnd
QUIT
+8 SET XMsgSav=$EXTRACT(XML,XMsgPos-1,XMsgEnd-1)
+9 FOR XVAR="XML2","XML3"
IF (@XVAR["<Message>")&(@XVAR["xsi:")
SET $EXTRACT(@XVAR,($FIND(@XVAR,"<Message>")-1))=XMsgSav
End DoDot:1
+10 SET NPI=$PIECE($GET(DIV),U,2)
SET CURREC=$$PARSE^PSOERXI2(.XML,.ERXVALS,NPI,.XML2,.XML3)
+11 IF $PIECE(CURREC,U)<1
Begin DoDot:1
+12 IF $LENGTH($PIECE(CURREC,U,2))
SET RES=CURREC
QUIT
+13 SET RES="0^XML received. Error creating or finding associated record in the ERX Holding queue."
QUIT
End DoDot:1
QUIT
+14 SET EIEN=CURREC
+15 SET CURREC=CURREC_","
+16 ;If this is an outbound message, file the users DUZ and quit back the response. No drug, patient, or provider auto checks will occur
+17 IF $GET(VADAT)]""
Begin DoDot:1
+18 IF $PIECE($GET(VADAT),U)>1
Begin DoDot:2
+19 SET FDA(52.49,CURREC,51.1)=DUZ
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
+20 IF $PIECE(VADAT,U,2)
Begin DoDot:2
+21 SET FDA(52.49,CURREC,.13)=$PIECE(VADAT,U,2)
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
+22 SET RES="1^Erx Received."
End DoDot:1
QUIT
+23 ;Process auto-validation results. Only log positive results for now
+24 KILL FDA
+25 IF $PIECE($GET(VADAT),U)
SET RES="1^Message Filed."
QUIT
+26 ;
+27 ;Drug Auto-Match (Moved from Hub to VistA - P-692)
+28 ;Attempting auto-match based on VistA Drug Suggestions (Uses the lastest one)
+29 NEW DRUGHASH,MTCHDRUG
+30 SET MTCHDRUG=$$MTCHDRUG()
SET DRUGHASH=$$DRUGHASH^PSOERUT(+CURREC)
+31 IF MTCHDRUG
IF DRUGHASH
Begin DoDot:1
+32 IF $$GET1^DIQ(52.49,CURREC,.08,"I")="RE"
IF $$GET1^DIQ(52.49,CURREC,52.1,"I")'="R"
QUIT
+33 IF $$GET1^DIQ(52.49,CURREC,.08,"I")="CX"
IF $$GET1^DIQ(52.49,CURREC,52.1,"I")'="A"
IF $$GET1^DIQ(52.49,CURREC,52.1,"I")'="AWC"
QUIT
+34 SET ERXNDC=$TRANSLATE($TRANSLATE($$GET1^DIQ(52.49311,"1,"_CURREC_",",1.1,"I")," "),"-")
+35 SET VISTARX=""
FOR
SET VISTARX=$ORDER(^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX),-1)
if 'VISTARX
QUIT
Begin DoDot:2
+36 SET VADRUG=+$$GET1^DIQ(52,VISTARX,6,"I")
IF 'VADRUG
QUIT
+37 IF $$GET1^DIQ(50,VADRUG,100,"I")
Begin DoDot:3
+38 KILL ^PS(52.49,"ADRGVRX",DRUGHASH,VISTARX)
End DoDot:3
QUIT
+39 ; For pre-populating all drug fields, the incoming NDC/Name should match VistA DRUG/NDF files
+40 IF VADRUG'=MTCHDRUG
QUIT
+41 DO SAVEDRUG^PSOERUT2(+CURREC,VISTARX)
+42 IF $$GET1^DIQ(52.49,+CURREC,3.2,"I")
Begin DoDot:3
+43 KILL DACHK
SET DACHK("success")="true"
SET FDA(52.49,CURREC,1.4)=1
End DoDot:3
End DoDot:2
IF $$GET1^DIQ(52.49,+CURREC,3.2,"I")
QUIT
End DoDot:1
+44 ;Auto-matching the Dispense Drug only
+45 IF '$$GET1^DIQ(52.49,+CURREC,3.2,"I")
IF +$GET(MTCHDRUG)
Begin DoDot:1
+46 KILL DACHK
SET DACHK("success")="true"
+47 ;Saving the eRx Audit Log For Auto-Matched Drug
+48 SET NEWVAL(1)=$$GET1^DIQ(50,MTCHDRUG,.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(MTCHDRUG)_")"
+49 DO AUDLOG^PSOERXUT(+CURREC,"DRUG",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
+50 ;Setting Matched Drug and Auto Match info
+51 SET FDA(52.49,CURREC,3.2)=MTCHDRUG
+52 SET FDA(52.49,CURREC,44)=1
+53 SET VAOI=$$GET1^DIQ(50,MTCHDRUG,2.1,"I")
+54 SET VPATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
+55 IF $LENGTH(VPATINST)
Begin DoDot:2
+56 SET (NEWVAL(1),FDA(52.49,CURREC,27))=VPATINST
+57 DO AUDLOG^PSOERXUT(+CURREC,"PATIENT INSTRUCTIONS",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:2
+58 ; Adjusting the # of refills field if over the maximum allowed
+59 IF $$GET1^DIQ(52.49,+CURREC,20.5)>$$MAXNUMRF^PSOUTIL(MTCHDRUG,$$GET1^DIQ(52.49,+CURREC,20.2))
Begin DoDot:2
+60 SET FDA(52.49,+CURREC_",",20.5)=$$MAXNUMRF^PSOUTIL(MTCHDRUG,$$GET1^DIQ(52.49,+CURREC,20.2))
End DoDot:2
End DoDot:1
+61 ;
+62 IF $GET(DACHK("success"))'="true"
Begin DoDot:1
+63 SET ERRTXT=$GET(DACHK("error"))
+64 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+65 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)
End DoDot:1
+66 ;
+67 ;Provider Auto-Match (Moved from Hub to VistA - P-692)
+68 IF $GET(PRCHK("success"))="false"
Begin DoDot:1
+69 NEW TMP,MSGTYPE,MTCHPROV,TMP,NPI,DEA,CS
+70 SET MSGTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))
IF MSGTYPE=""
QUIT
+71 SET DEA=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"DEANumber",0))
+72 SET NPI=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"NPI",0))
+73 SET CS=($GET(^TMP($JOB,"PSOERXO1","Message",0,"Header",0,"DigitalSignature",0,"SignatureValue",0))'="")
+74 DO PRVMTCH^PSOERXA0(.MTCHPROV,NPI,DEA,CS)
+75 IF +$GET(MTCHPROV)
Begin DoDot:2
+76 KILL PRCHK
SET PRCHK("success")="true"
SET PRCHK("IEN")=+MTCHPROV
End DoDot:2
End DoDot:1
+77 ;Attempting auto-match based on VistA Provider Suggestions (Uses the lastest one)
+78 IF '$GET(PRCHK("IEN"))
Begin DoDot:1
+79 NEW EPRV,VPRV,SUGVPRV,MTCHDT
SET EPRV=+$$GET1^DIQ(52.49,+CURREC,2.1,"I")
SET (VPRV,SUGVPRV,MTCHDT)=0
+80 FOR
SET VPRV=$ORDER(^PS(52.49,"APRVVPRV",EPRV,VPRV))
if 'VPRV
QUIT
Begin DoDot:2
+81 ; VistA Provider is Inactive
IF $$GET1^DIQ(200,VPRV,53.4,"I")
KILL ^PS(52.49,"APRVVPRV",EPRV,VPRV)
QUIT
+82 IF $ORDER(^PS(52.49,"APRVVPRV",EPRV,VPRV,""),-1)>MTCHDT
Begin DoDot:3
+83 SET SUGVPRV=VPRV
SET MTCHDT=$ORDER(^PS(52.49,"APRVVPRV",EPRV,VPRV,""),-1)
End DoDot:3
End DoDot:2
+84 IF SUGVPRV
Begin DoDot:2
+85 KILL PRCHK
SET PRCHK("success")="true"
SET FDA(52.49,CURREC,1.2)=1
SET (FDA(52.49,CURREC,2.3),PRCHK("IEN"))=SUGVPRV
End DoDot:2
End DoDot:1
+86 ;Auto-Validating Provider
+87 SET PRVAUTOV=0
+88 IF $GET(PRCHK("success"))="true"
IF $GET(PRCHK("IEN"))
Begin DoDot:1
+89 SET FDA(52.49,CURREC,1.2)=1
+90 SET FDA(52.49,CURREC,2.3)=PRCHK("IEN")
+91 ;Auto-Validating Provider if auto-match was successful
+92 ;Condition: Non-CS eRx only & Last name, first letter of first name and zip code 5 digits must match
+93 NEW EPRVIEN,EPRVNAM,EPRVZC,EPRVDEA,VPRVIEN,VPRVNAM,VPRVZC
+94 SET EPRVIEN=$$GET1^DIQ(52.49,+CURREC,2.1,"I")
+95 SET EPRVNAM=$$UP^XLFSTR($TRANSLATE($$GET1^DIQ(52.48,EPRVIEN,.01)," "))
+96 SET EPRVZC=$PIECE($$GET1^DIQ(52.48,EPRVIEN,4.5),"-")
+97 SET EPRVDEA=$$UP^XLFSTR($$GET1^DIQ(52.48,EPRVIEN,1.6))
+98 SET VPRVIEN=PRCHK("IEN")
IF '$$CHKPRV2^PSOERX1A(VPRVIEN)
QUIT
+99 SET VPRVNAM=$$UP^XLFSTR($TRANSLATE($$GET1^DIQ(200,VPRVIEN,.01)," "))
+100 SET VPRVZC=$PIECE($$GET1^DIQ(200,VPRVIEN,.116),"-")
+101 IF $EXTRACT(EPRVNAM,1,$FIND(EPRVNAM,","))'=$EXTRACT(VPRVNAM,1,$FIND(VPRVNAM,","))
QUIT
+102 IF $EXTRACT(EPRVZC,1,5)'=$EXTRACT(VPRVZC,1,5)
QUIT
+103 IF $$GET1^DIQ(52.49,+CURREC,95.1,"I")
IF '$$DEAFOUND^PSOERXU8(EPRVDEA,VPRVIEN)
QUIT
+104 SET FDA(52.49,CURREC,1.3)=1
+105 SET FDA(52.49,CURREC,1.8)=$$PROXYDUZ^PSOERXUT()
+106 SET FDA(52.49,CURREC,1.9)=$$NOW^XLFDT()
+107 SET FDA(52.49,CURREC,2.7)=1
+108 SET PRVAUTOV=1
End DoDot:1
+109 IF $GET(PRCHK("success"))="true"
IF $GET(PRCHK("IEN"))
Begin DoDot:1
+110 ;Saving the eRx Audit Log for the Auto-Matched Provider
+111 SET NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$PIECE($$VADEA^PSOERXU8(PRCHK("IEN"),+CURREC),"^",2)_")"_$SELECT($GET(PRVAUTOV):" - AUTO-VALIDATED",1:"")
+112 DO AUDLOG^PSOERXUT(+CURREC,"PROVIDER",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:1
+113 ;
+114 IF $GET(PRCHK("success"))="false"
Begin DoDot:1
+115 SET ERRTXT=$GET(PRCHK("error"))
+116 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+117 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PR","E",ERRTXT)
End DoDot:1
+118 ;
+119 IF $GET(PACHK("MVIerror"))']""
Begin DoDot:1
+120 SET PAICN=+$PIECE($GET(PACHK("ICN")),"V")
+121 IF PAICN
Begin DoDot:2
+122 SET (PAIEN,PACNT)=0
FOR
SET PAIEN=$ORDER(^DPT("AICN",PAICN,PAIEN))
if 'PAIEN
QUIT
Begin DoDot:3
+123 SET PACNT=PACNT+1
+124 ;revisit in future build - if we find more than one match in the local system, do we log some sort of an error?
End DoDot:3
End DoDot:2
+125 IF $GET(PACNT)=1
Begin DoDot:2
+126 SET FDA(52.49,CURREC,1.6)=1
+127 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("AICN",PAICN,0))
End DoDot:2
QUIT
+128 IF $LENGTH(PACHK("ssn"))
Begin DoDot:2
+129 SET (PASCNT,PAIEN)=0
FOR
SET PAIEN=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),PAIEN))
if 'PAIEN
QUIT
Begin DoDot:3
+130 SET PASCNT=PASCNT+1
End DoDot:3
End DoDot:2
+131 IF $GET(PASCNT)=1
Begin DoDot:2
+132 SET FDA(52.49,CURREC,1.6)=1
+133 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),0))
End DoDot:2
QUIT
End DoDot:1
+134 ;Attempting auto-match based on VistA Patient Suggestions (Uses the lastest one)
+135 IF '$GET(FDA(52.49,CURREC,.05))
Begin DoDot:1
+136 NEW EPAT,VPAT,SUGVPAT,MTCHDT
SET EPAT=+$$GET1^DIQ(52.49,+CURREC,.04,"I")
SET (VPAT,SUGVPAT,MTCHDT)=0
+137 FOR
SET VPAT=$ORDER(^PS(52.49,"APATVPAT",EPAT,VPAT))
if 'VPAT
QUIT
Begin DoDot:2
+138 IF $ORDER(^PS(52.49,"APATVPAT",EPAT,VPAT,""),-1)>MTCHDT
Begin DoDot:3
+139 SET SUGVPAT=VPAT
SET MTCHDT=$ORDER(^PS(52.49,"APATVPAT",EPAT,VPAT,""),-1)
End DoDot:3
End DoDot:2
+140 IF SUGVPAT
SET FDA(52.49,CURREC,1.6)=1
SET FDA(52.49,CURREC,.05)=SUGVPAT
End DoDot:1
+141 ;
+142 ;Saving the eRx Audit Log For Auto-Matched Patient
+143 SET DFN=+$GET(FDA(52.49,CURREC,.05))
+144 IF DFN
Begin DoDot:1
+145 NEW VADM
DO DEM^VADPT
+146 SET NEWVAL(1)=$$GET1^DIQ(2,DFN,.01)_" (L4SSN: "_$PIECE($PIECE(VADM(2),"^",2),"-",3)_" | DOB: "_$PIECE(VADM(3),"^",2)_")"
+147 DO AUDLOG^PSOERXUT(+CURREC,"PATIENT",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:1
+148 ;
+149 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
KILL FDA
+150 ;
+151 ; Auto-holds for MbM
+152 IF $GET(MBMSITE)
IF DFN
Begin DoDot:1
+153 IF ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"'[(","_$$GET1^DIQ(52.49,CURREC,1,"I")_",")
QUIT
+154 IF '$$CHVAELIG^PSOERXU9(DFN)
Begin DoDot:2
+155 DO UPDSTAT^PSOERXU1(CURREC,"HEL","Hold due to Eligibility Issue")
End DoDot:2
QUIT
+156 NEW GMRA,GMRAL
+157 SET GMRA="0^0^111"
DO EN1^GMRADPT
IF $GET(GMRAL)'=""
QUIT
+158 DO UPDSTAT^PSOERXU1(CURREC,"HAL","Hold for Allergy Assessment")
End DoDot:1
+159 ;
+160 IF $GET(PACHK("success"))="false"
Begin DoDot:1
+161 ; file e&e error
+162 SET ERRTXT=$GET(PACHK("EandEerror"))
IF ERRTXT]""
Begin DoDot:2
+163 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+164 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
End DoDot:2
+165 ; file mvi error
+166 SET ERRTXT=$GET(PACHK("MVIerror"))
IF ERRTXT]""
Begin DoDot:2
+167 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+168 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
End DoDot:2
End DoDot:1
+169 ;
+170 SET RES="1^Erx Received."
+171 ;
+172 ;Create an Addendum for eRx Change Response Progress Note
+173 IF $GET(EIEN)'=""
IF $$GET1^DIQ(52.49,EIEN,.08,"I")="CX"
DO CREATEADD(ERXHID,EIEN)
+174 QUIT
+175 ;
CREATEADD(ERXHID,EIEN) ;Create CPRS Progress Notes Addendum for this eRx Change Response
+1 ;Input: ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID
+2 ; EIEN - The eRx Change Response IEN, Pointer to ERX HOLDING QUEUE file (#52.49)
+3 ;Output: Create an Addendum and attach it to the parent eRx Change Request
+4 ;
+5 IF ($GET(ERXHID)="")!($GET(EIEN)="")
QUIT
+6 NEW CNT,CRERXIEN,ORGERXIEN,ERXDRUG,CRMEDS,CNT,CXTARGET,ERXDRUG,PSOTIUIEN,TIUDADD,ERXTIUX
+7 ;
+8 SET CRERXIEN=$ORDER(^PS(52.49,"B",$PIECE(ERXHID,"^",3),0))
+9 SET ORGERXIEN=$PIECE($GET(^PS(52.49,CRERXIEN,0)),"^",14)
+10 SET ORGERXIEN=$ORDER(^PS(52.49,"B",ORGERXIEN,0))
+11 ;
+12 ;get the parent reference IEN TIU Document
+13 SET PSOTIUIEN=$$GET1^DIQ(52.49,CRERXIEN,320.1)
+14 IF '$GET(PSOTIUIEN)
Begin DoDot:1
+15 NEW TIUTITLE
SET TIUTITLE="PHARMACY ERX RX CHANGE REQUEST NOTE"
+16 IF '+$$FIND1^DIC(8925.1,"","X",TIUTITLE,"B")
SET TIUTITLE="ERX RX CHANGE REQUEST NOTE"
+17 DO BLDCRMEDS(ERXHID,+$GET(MTCHDRUG),TIUTITLE)
End DoDot:1
QUIT
+18 ;
+19 SET CXTARGET=$NAME(^TMP("TIUP",$JOB))
KILL @CXTARGET
+20 DO BUILDLST^PSOERSE4(CXTARGET,EIEN)
+21 if '$DATA(@CXTARGET)
QUIT
+22 KILL ERXTIUX
MERGE ERXTIUX("TEXT")=@CXTARGET
+23 ;PSOTIUIEN is the parent IEN from The TIU Document Definition name in File #8925.1
DO MAKEADD^TIUSRVP2(.TIUDADD,PSOTIUIEN,.ERXTIUX)
+24 ;TIUDADD is the Addendum IEN
DO UPDATEPN^PSOERX1H(.TIUDADD,$GET(ORGERXIEN))
+25 QUIT
+26 ;
BLDCRMEDS(ERXHID,VDRUG,TIUTITLE) ;Build eRx Change Response Medication array
+1 ;get the original eRx
+2 if $GET(ERXHID)=""
QUIT
+3 NEW CRERXIEN,ORGERXIEN,ERXDRUG,CRMEDS
+4 ;
+5 SET CRERXIEN=$ORDER(^PS(52.49,"B",$PIECE(ERXHID,"^",3),0))
+6 SET ORGERXIEN=$PIECE($GET(^PS(52.49,CRERXIEN,0)),"^",14)
+7 SET ORGERXIEN=$ORDER(^PS(52.49,"B",ORGERXIEN,0))
+8 SET CNT=0
+9 IF $GET(VDRUG)
Begin DoDot:1
+10 SET ERXDRUG=$$GET1^DIQ(50,$GET(VDRUG),.01)
+11 SET CNT=CNT+1
SET CRMEDS(CNT)="^"_ERXDRUG
End DoDot:1
+12 ;
+13 ;create eRx Change Response PN
DO CREATEPN^PSOERX1H(ORGERXIEN,EIEN,,.CRMEDS,TIUTITLE)
+14 ;
+15 QUIT
+16 ; VAL - value to resolve
+17 ; TYPE - This is the code type, which will tell which 'C' index type to get the code from
PRESOLV(VAL,TYPE) ;
+1 NEW MATCH
+2 SET MATCH=""
+3 ; avoid null subscript
if '$LENGTH(TYPE)!('$LENGTH(VAL))
QUIT ""
+4 SET MATCH=$ORDER(^PS(52.45,"C",TYPE,VAL,0))
+5 ; return the match found, null if no match
+6 QUIT MATCH
CONVDTTM(VAL) ;
+1 NEW EDATE,ETIME,X,ETZ,Y,%DT,%
+2 IF '$LENGTH(VAL)
QUIT ""
+3 SET EDATE=$PIECE(VAL,"T")
SET ETIME=$PIECE(VAL,"T",2)
+4 ; split off time zone
+5 SET ETZ=$PIECE(ETIME,".",2)
+6 SET ETIME=$PIECE(ETIME,".")
+7 SET X=EDATE
DO ^%DT
IF 'Y
QUIT ""
+8 SET VAL=Y_$SELECT($LENGTH(ETIME):"."_$TRANSLATE(ETIME,":",""),1:"")
+9 QUIT VAL
+10 ;
MTCHDRUG() ; Returns the Matched Dispensed Drug based on the NDF files
+1 ;Output: MTCHDRUG - VistA Dispense Drug associated with the Name/NDC from outside (Pointer to file #50)
+2 NEW MSGTYPE,MEDSEG,MTCHDRUG,PRDCODE,PRDCOQL,DRGNAME
+3 SET MTCHDRUG=0
+4 SET MSGTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))
IF MSGTYPE=""
QUIT 0
+5 SET MEDSEG="MedicationPrescribed"
+6 IF '$DATA(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG))
Begin DoDot:1
+7 SET MEDSEG="MedicationResponse"
End DoDot:1
+8 SET PRDCODE=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Code",0))
IF PRDCODE=""
QUIT 0
+9 SET PRDCOQL=$EXTRACT($GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Qualifier",0)),1)
+10 IF PRDCOQL'="N"
IF PRDCOQL'="U"
QUIT 0
+11 SET DRGNAME=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugDescription",0))
+12 DO DRGMTCH^PSOERXA0(.MTCHDRUG,PRDCOQL_"^"_PRDCODE,DRGNAME)
+13 QUIT +$GET(MTCHDRUG)
+14 ;
ERROR ; Error Handling
+1 DO ^%ZTER
+2 SET RES="1^eRx received but there was an error. See error trap at "_$PIECE($TRANSLATE($$SITE^VASITE(),"^","-"),"-",1,2)
QUIT
+3 QUIT
