PSOERXI1 ;ALB/BWF - eRx Utilities/RPC's ; 12/10/22 11:24am
;;7.0;OUTPATIENT PHARMACY;**581,617,692,706,700,743,746**;DEC 1997;Build 106
;
;
;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 CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,PRVAUTOV
S NPI=$P($G(DIV),U,2)
S 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-Check (Moved from Hub to VistA - P-692)
I $G(DACHK("success"))="false" D
. N MSGTYPE,MEDSEG,MTCHDRUG,PRDCODE,PRDCOQL,DRGNAME
. S MSGTYPE=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,"")) I MSGTYPE="" Q
. 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
. 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
. S DRGNAME=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugDescription",0))
. D DRGMTCH^PSOERXA0(.MTCHDRUG,PRDCOQL_"^"_PRDCODE,DRGNAME)
. I +$G(MTCHDRUG) D
. . K DACHK S DACHK("success")="true",DACHK("IEN")=+MTCHDRUG
;
I $G(DACHK("success"))="true" D
. I $G(DACHK("IEN")) D
. .;Saving the eRx Audit Log For Auto-Matched Drug
. . S NEWVAL(1)=$$GET1^DIQ(50,DACHK("IEN"),.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(DACHK("IEN"))_")"
. . D AUDLOG^PSOERXUT(+CURREC,"DRUG",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
. .;Setting Matched Drug and Auto Match info
. . S FDA(52.49,CURREC,1.4)=1
. . S FDA(52.49,CURREC,3.2)=DACHK("IEN")
. . S FDA(52.49,CURREC,44)=1
. . S VAOI=$$GET1^DIQ(50,DACHK("IEN"),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)
;
I $G(DACHK("success"))="false" D
. S ERRTXT=$G(DACHK("error"))
. S ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN) Q:'ERRSEQ
. D FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)
;
;Provider Auto-Check (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
;
;Auto-Matching Provider
I $G(PRCHK("success"))="true",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
. S PRVAUTOV=0
. I '$$GET1^DIQ(52.49,+CURREC,95.1,"I") D
. . N EPRVIEN,EPRVNAM,EPRVZC,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 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
. . 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
. ;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(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))
;
;Saving the eRx Audit Log For Auto-Matched Patient
I $G(FDA(52.49,CURREC,.05)) D
. N DFN,VADM S DFN=+FDA(52.49,CURREC,.05) 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
;
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
. D BLDCRMEDS(ERXHID,.DACHK,"ERX RX CHANGE REQUEST NOTE")
;
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,DACHK,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 $D(DACHK("IEN")) D
. S ERXDRUG=$$GET1^DIQ(50,DACHK("IEN"),.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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXI1 9613 printed Nov 22, 2024@17:38:33 Page 2
PSOERXI1 ;ALB/BWF - eRx Utilities/RPC's ; 12/10/22 11:24am
+1 ;;7.0;OUTPATIENT PHARMACY;**581,617,692,706,700,743,746**;DEC 1997;Build 106
+2 ;
+3 ;
+4 ;Reference to MAKEADD^TIUSRVP2 in ICR #4795
+5 QUIT
+6 ; File incoming XML into appropriate file
+7 ; XML - xml text
+8 ; PRCHK - provider check information
+9 ; PACHK - patient check information
+10 ; DACHK - drug auto check
+11 ; STATION - station #
+12 ; DIV - institution name^NPI
+13 ; ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID
+14 ; ERXVALS - code values for NIST codes (potency unit code^form code^strength code^prohibit renewals - change response (y/n))
+15 ; XML2 - structured sig from the medication prescribed segment
+16 ; VADAT - DUZ^RXIEN
+17 ; XML3 - third stream of XML
INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT,XML3) ;
+1 NEW CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,PRVAUTOV
+2 SET NPI=$PIECE($GET(DIV),U,2)
+3 SET CURREC=$$PARSE^PSOERXI2(.XML,.ERXVALS,NPI,.XML2,.XML3)
+4 IF $PIECE(CURREC,U)<1
Begin DoDot:1
+5 IF $LENGTH($PIECE(CURREC,U,2))
SET RES=CURREC
QUIT
+6 SET RES="0^XML received. Error creating or finding associated record in the ERX Holding queue."
QUIT
End DoDot:1
QUIT
+7 SET EIEN=CURREC
+8 SET CURREC=CURREC_","
+9 ;If this is an outbound message, file the users DUZ and quit back the response. no drug, patient, or provider auto checks will occur
+10 IF $GET(VADAT)]""
Begin DoDot:1
+11 IF $PIECE($GET(VADAT),U)>1
Begin DoDot:2
+12 SET FDA(52.49,CURREC,51.1)=DUZ
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
+13 IF $PIECE(VADAT,U,2)
Begin DoDot:2
+14 SET FDA(52.49,CURREC,.13)=$PIECE(VADAT,U,2)
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
+15 SET RES="1^Erx Received."
End DoDot:1
QUIT
+16 ;Process auto-validation results. Only log positive results for now
+17 KILL FDA
+18 IF $PIECE($GET(VADAT),U)
SET RES="1^Message Filed."
QUIT
+19 ;
+20 ;Drug Auto-Check (Moved from Hub to VistA - P-692)
+21 IF $GET(DACHK("success"))="false"
Begin DoDot:1
+22 NEW MSGTYPE,MEDSEG,MTCHDRUG,PRDCODE,PRDCOQL,DRGNAME
+23 SET MSGTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))
IF MSGTYPE=""
QUIT
+24 SET MEDSEG="MedicationPrescribed"
+25 IF '$DATA(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG))
Begin DoDot:2
+26 SET MEDSEG="MedicationResponse"
End DoDot:2
+27 SET PRDCODE=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Code",0))
IF PRDCODE=""
QUIT
+28 SET PRDCOQL=$EXTRACT($GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugCoded",0,"ProductCode",0,"Qualifier",0)),1)
+29 IF PRDCOQL'="N"
IF PRDCOQL'="U"
QUIT
+30 SET DRGNAME=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,MEDSEG,0,"DrugDescription",0))
+31 DO DRGMTCH^PSOERXA0(.MTCHDRUG,PRDCOQL_"^"_PRDCODE,DRGNAME)
+32 IF +$GET(MTCHDRUG)
Begin DoDot:2
+33 KILL DACHK
SET DACHK("success")="true"
SET DACHK("IEN")=+MTCHDRUG
End DoDot:2
End DoDot:1
+34 ;
+35 IF $GET(DACHK("success"))="true"
Begin DoDot:1
+36 IF $GET(DACHK("IEN"))
Begin DoDot:2
+37 ;Saving the eRx Audit Log For Auto-Matched Drug
+38 SET NEWVAL(1)=$$GET1^DIQ(50,DACHK("IEN"),.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(DACHK("IEN"))_")"
+39 DO AUDLOG^PSOERXUT(+CURREC,"DRUG",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
+40 ;Setting Matched Drug and Auto Match info
+41 SET FDA(52.49,CURREC,1.4)=1
+42 SET FDA(52.49,CURREC,3.2)=DACHK("IEN")
+43 SET FDA(52.49,CURREC,44)=1
+44 SET VAOI=$$GET1^DIQ(50,DACHK("IEN"),2.1,"I")
+45 SET VPATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
+46 IF $LENGTH(VPATINST)
Begin DoDot:3
+47 SET (NEWVAL(1),FDA(52.49,CURREC,27))=VPATINST
+48 DO AUDLOG^PSOERXUT(+CURREC,"PATIENT INSTRUCTIONS",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:3
End DoDot:2
End DoDot:1
+49 ;
+50 IF $GET(DACHK("success"))="false"
Begin DoDot:1
+51 SET ERRTXT=$GET(DACHK("error"))
+52 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+53 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)
End DoDot:1
+54 ;
+55 ;Provider Auto-Check (Moved from Hub to VistA - P-692)
+56 IF $GET(PRCHK("success"))="false"
Begin DoDot:1
+57 NEW TMP,MSGTYPE,MTCHPROV,TMP,NPI,DEA,CS
+58 SET MSGTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))
IF MSGTYPE=""
QUIT
+59 SET DEA=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"DEANumber",0))
+60 SET NPI=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"NPI",0))
+61 SET CS=($GET(^TMP($JOB,"PSOERXO1","Message",0,"Header",0,"DigitalSignature",0,"SignatureValue",0))'="")
+62 DO PRVMTCH^PSOERXA0(.MTCHPROV,NPI,DEA,CS)
+63 IF +$GET(MTCHPROV)
Begin DoDot:2
+64 KILL PRCHK
SET PRCHK("success")="true"
SET PRCHK("IEN")=+MTCHPROV
End DoDot:2
End DoDot:1
+65 ;
+66 ;Auto-Matching Provider
+67 IF $GET(PRCHK("success"))="true"
IF PRCHK("IEN")
Begin DoDot:1
+68 SET FDA(52.49,CURREC,1.2)=1
+69 SET FDA(52.49,CURREC,2.3)=PRCHK("IEN")
+70 ;Auto-Validating Provider if auto-match was successful
+71 ;Condition: Non-CS eRx only & Last name, first letter of first name and zip code 5 digits must match
+72 SET PRVAUTOV=0
+73 IF '$$GET1^DIQ(52.49,+CURREC,95.1,"I")
Begin DoDot:2
+74 NEW EPRVIEN,EPRVNAM,EPRVZC,VPRVIEN,VPRVNAM,VPRVZC
+75 SET EPRVIEN=$$GET1^DIQ(52.49,+CURREC,2.1,"I")
+76 SET EPRVNAM=$$UP^XLFSTR($TRANSLATE($$GET1^DIQ(52.48,EPRVIEN,.01)," "))
+77 SET EPRVZC=$PIECE($$GET1^DIQ(52.48,EPRVIEN,4.5),"-")
+78 SET VPRVIEN=PRCHK("IEN")
IF '$$CHKPRV2^PSOERX1A(VPRVIEN)
QUIT
+79 SET VPRVNAM=$$UP^XLFSTR($TRANSLATE($$GET1^DIQ(200,VPRVIEN,.01)," "))
+80 SET VPRVZC=$PIECE($$GET1^DIQ(200,VPRVIEN,.116),"-")
+81 IF $EXTRACT(EPRVNAM,1,$FIND(EPRVNAM,","))'=$EXTRACT(VPRVNAM,1,$FIND(VPRVNAM,","))
QUIT
+82 IF $EXTRACT(EPRVZC,1,5)'=$EXTRACT(VPRVZC,1,5)
QUIT
+83 SET FDA(52.49,CURREC,1.3)=1
+84 SET FDA(52.49,CURREC,1.8)=$$PROXYDUZ^PSOERXUT()
+85 SET FDA(52.49,CURREC,1.9)=$$NOW^XLFDT()
+86 SET FDA(52.49,CURREC,2.7)=1
+87 SET PRVAUTOV=1
End DoDot:2
+88 ;Saving the eRx Audit Log for the Auto-Matched Provider
+89 SET NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$PIECE($$VADEA^PSOERXU8(PRCHK("IEN"),+CURREC),"^",2)_")"_$SELECT(PRVAUTOV:" - AUTO-VALIDATED",1:"")
+90 DO AUDLOG^PSOERXUT(+CURREC,"PROVIDER",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:1
+91 ;
+92 IF $GET(PRCHK("success"))="false"
Begin DoDot:1
+93 SET ERRTXT=$GET(PRCHK("error"))
+94 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+95 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PR","E",ERRTXT)
End DoDot:1
+96 ;
+97 IF $GET(PACHK("MVIerror"))']""
Begin DoDot:1
+98 SET PAICN=+$PIECE($GET(PACHK("ICN")),"V")
+99 IF PAICN
Begin DoDot:2
+100 SET (PAIEN,PACNT)=0
FOR
SET PAIEN=$ORDER(^DPT("AICN",PAICN,PAIEN))
if 'PAIEN
QUIT
Begin DoDot:3
+101 SET PACNT=PACNT+1
+102 ;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
+103 IF $GET(PACNT)=1
Begin DoDot:2
+104 SET FDA(52.49,CURREC,1.6)=1
+105 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("AICN",PAICN,0))
End DoDot:2
QUIT
+106 IF $LENGTH(PACHK("ssn"))
Begin DoDot:2
+107 SET (PASCNT,PAIEN)=0
FOR
SET PAIEN=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),PAIEN))
if 'PAIEN
QUIT
Begin DoDot:3
+108 SET PASCNT=PASCNT+1
End DoDot:3
End DoDot:2
+109 IF $GET(PASCNT)=1
Begin DoDot:2
+110 SET FDA(52.49,CURREC,1.6)=1
+111 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),0))
End DoDot:2
QUIT
End DoDot:1
+112 ;
+113 ;Saving the eRx Audit Log For Auto-Matched Patient
+114 IF $GET(FDA(52.49,CURREC,.05))
Begin DoDot:1
+115 NEW DFN,VADM
SET DFN=+FDA(52.49,CURREC,.05)
DO DEM^VADPT
+116 SET NEWVAL(1)=$$GET1^DIQ(2,DFN,.01)_" (L4SSN: "_$PIECE($PIECE(VADM(2),"^",2),"-",3)_" | DOB: "_$PIECE(VADM(3),"^",2)_")"
+117 DO AUDLOG^PSOERXUT(+CURREC,"PATIENT",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:1
+118 ;
+119 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
KILL FDA
+120 ;
+121 IF $GET(PACHK("success"))="false"
Begin DoDot:1
+122 ; file e&e error
+123 SET ERRTXT=$GET(PACHK("EandEerror"))
IF ERRTXT]""
Begin DoDot:2
+124 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+125 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
End DoDot:2
+126 ; file mvi error
+127 SET ERRTXT=$GET(PACHK("MVIerror"))
IF ERRTXT]""
Begin DoDot:2
+128 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+129 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
End DoDot:2
End DoDot:1
+130 ;
+131 SET RES="1^Erx Received."
+132 ;
+133 ;Create an Addendum for eRx Change Response Progress Note
+134 IF $GET(EIEN)'=""
IF $$GET1^DIQ(52.49,EIEN,.08,"I")="CX"
DO CREATEADD(ERXHID,EIEN)
+135 QUIT
+136 ;
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 DO BLDCRMEDS(ERXHID,.DACHK,"ERX RX CHANGE REQUEST NOTE")
End DoDot:1
QUIT
+16 ;
+17 SET CXTARGET=$NAME(^TMP("TIUP",$JOB))
KILL @CXTARGET
+18 DO BUILDLST^PSOERSE4(CXTARGET,EIEN)
+19 if '$DATA(@CXTARGET)
QUIT
+20 KILL ERXTIUX
MERGE ERXTIUX("TEXT")=@CXTARGET
+21 ;PSOTIUIEN is the parent IEN from The TIU Document Definition name in File #8925.1
DO MAKEADD^TIUSRVP2(.TIUDADD,PSOTIUIEN,.ERXTIUX)
+22 ;TIUDADD is the Addendum IEN
DO UPDATEPN^PSOERX1H(.TIUDADD,$GET(ORGERXIEN))
+23 QUIT
+24 ;
BLDCRMEDS(ERXHID,DACHK,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 $DATA(DACHK("IEN"))
Begin DoDot:1
+10 SET ERXDRUG=$$GET1^DIQ(50,DACHK("IEN"),.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
+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
