PSOERXI1 ;ALB/BWF - eRx Utilities/RPC's ; 12/10/22 11:24am
;;7.0;OUTPATIENT PHARMACY;**581,617,692,706,700**;DEC 1997;Build 261
;
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) S FDA(52.49,CURREC,27)=VPATINST
;
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 (MbM sites only)
. ;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(59.7,1,102,"I")="MBM",'$$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#: "_$$DEA^XUSER(0,PRCHK("IEN"))_")"_$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."
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 7620 printed Mar 13, 2024@23:38:48 Page 2
PSOERXI1 ;ALB/BWF - eRx Utilities/RPC's ; 12/10/22 11:24am
+1 ;;7.0;OUTPATIENT PHARMACY;**581,617,692,706,700**;DEC 1997;Build 261
+2 ;
+3 QUIT
+4 ; File incoming XML into appropriate file
+5 ; XML - xml text
+6 ; PRCHK - provider check information
+7 ; PACHK - patient check information
+8 ; DACHK - drug auto check
+9 ; STATION - station #
+10 ; DIV - institution name^NPI
+11 ; ERXHID - eRx processing hub id^CANCEL/CHANGE REQUEST DENIED BY HUB (1=YES)^relates to hub ID
+12 ; ERXVALS - code values for NIST codes (potency unit code^form code^strength code^prohibit renewals - change response (y/n))
+13 ; XML2 - structured sig from the medication prescribed segment
+14 ; VADAT - DUZ^RXIEN
+15 ; 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)
SET FDA(52.49,CURREC,27)=VPATINST
End DoDot:2
End DoDot:1
+47 ;
+48 IF $GET(DACHK("success"))="false"
Begin DoDot:1
+49 SET ERRTXT=$GET(DACHK("error"))
+50 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+51 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)
End DoDot:1
+52 ;
+53 ;Provider Auto-Check (Moved from Hub to VistA - P-692)
+54 IF $GET(PRCHK("success"))="false"
Begin DoDot:1
+55 NEW TMP,MSGTYPE,MTCHPROV,TMP,NPI,DEA,CS
+56 SET MSGTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))
IF MSGTYPE=""
QUIT
+57 SET DEA=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"DEANumber",0))
+58 SET NPI=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MSGTYPE,0,"Prescriber",0,"NonVeterinarian",0,"Identification",0,"NPI",0))
+59 SET CS=($GET(^TMP($JOB,"PSOERXO1","Message",0,"Header",0,"DigitalSignature",0,"SignatureValue",0))'="")
+60 DO PRVMTCH^PSOERXA0(.MTCHPROV,NPI,DEA,CS)
+61 IF +$GET(MTCHPROV)
Begin DoDot:2
+62 KILL PRCHK
SET PRCHK("success")="true"
SET PRCHK("IEN")=+MTCHPROV
End DoDot:2
End DoDot:1
+63 ;
+64 ;Auto-Matching Provider
+65 IF $GET(PRCHK("success"))="true"
IF PRCHK("IEN")
Begin DoDot:1
+66 SET FDA(52.49,CURREC,1.2)=1
+67 SET FDA(52.49,CURREC,2.3)=PRCHK("IEN")
+68 ;Auto-Validating Provider if auto-match was successful (MbM sites only)
+69 ;Condition: Non-CS eRx only & Last name, first letter of first name and zip code 5 digits must match
+70 SET PRVAUTOV=0
+71 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
IF '$$GET1^DIQ(52.49,CURREC,95.1,"I")
Begin DoDot:2
+72 NEW EPRVIEN,EPRVNAM,EPRVZC,VPRVIEN,VPRVNAM,VPRVZC
+73 SET EPRVIEN=$$GET1^DIQ(52.49,CURREC,2.1,"I")
+74 SET EPRVNAM=$$UP^XLFSTR($TRANSLATE($$GET1^DIQ(52.48,EPRVIEN,.01)," "))
+75 SET EPRVZC=$PIECE($$GET1^DIQ(52.48,EPRVIEN,4.5),"-")
+76 SET VPRVIEN=PRCHK("IEN")
IF '$$CHKPRV2^PSOERX1A(VPRVIEN)
QUIT
+77 SET VPRVNAM=$$UP^XLFSTR($TRANSLATE($$GET1^DIQ(200,VPRVIEN,.01)," "))
+78 SET VPRVZC=$PIECE($$GET1^DIQ(200,VPRVIEN,.116),"-")
+79 IF $EXTRACT(EPRVNAM,1,$FIND(EPRVNAM,","))'=$EXTRACT(VPRVNAM,1,$FIND(VPRVNAM,","))
QUIT
+80 IF $EXTRACT(EPRVZC,1,5)'=$EXTRACT(VPRVZC,1,5)
QUIT
+81 SET FDA(52.49,CURREC,1.3)=1
+82 SET FDA(52.49,CURREC,1.8)=$$PROXYDUZ^PSOERXUT()
+83 SET FDA(52.49,CURREC,1.9)=$$NOW^XLFDT()
+84 SET FDA(52.49,CURREC,2.7)=1
+85 SET PRVAUTOV=1
End DoDot:2
+86 ;Saving the eRx Audit Log for the Auto-Matched Provider
+87 SET NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$$DEA^XUSER(0,PRCHK("IEN"))_")"_$SELECT(PRVAUTOV:" - AUTO-VALIDATED",1:"")
+88 DO AUDLOG^PSOERXUT(+CURREC,"PROVIDER",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:1
+89 ;
+90 IF $GET(PRCHK("success"))="false"
Begin DoDot:1
+91 SET ERRTXT=$GET(PRCHK("error"))
+92 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+93 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PR","E",ERRTXT)
End DoDot:1
+94 ;
+95 IF $GET(PACHK("MVIerror"))']""
Begin DoDot:1
+96 SET PAICN=+$PIECE($GET(PACHK("ICN")),"V")
+97 IF PAICN
Begin DoDot:2
+98 SET (PAIEN,PACNT)=0
FOR
SET PAIEN=$ORDER(^DPT("AICN",PAICN,PAIEN))
if 'PAIEN
QUIT
Begin DoDot:3
+99 SET PACNT=PACNT+1
+100 ;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
+101 IF $GET(PACNT)=1
Begin DoDot:2
+102 SET FDA(52.49,CURREC,1.6)=1
+103 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("AICN",PAICN,0))
End DoDot:2
QUIT
+104 IF $LENGTH(PACHK("ssn"))
Begin DoDot:2
+105 SET (PASCNT,PAIEN)=0
FOR
SET PAIEN=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),PAIEN))
if 'PAIEN
QUIT
Begin DoDot:3
+106 SET PASCNT=PASCNT+1
End DoDot:3
End DoDot:2
+107 IF $GET(PASCNT)=1
Begin DoDot:2
+108 SET FDA(52.49,CURREC,1.6)=1
+109 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),0))
End DoDot:2
QUIT
End DoDot:1
+110 ;
+111 ;Saving the eRx Audit Log For Auto-Matched Patient
+112 IF $GET(FDA(52.49,CURREC,.05))
Begin DoDot:1
+113 NEW DFN,VADM
SET DFN=+FDA(52.49,CURREC,.05)
DO DEM^VADPT
+114 SET NEWVAL(1)=$$GET1^DIQ(2,DFN,.01)_" (L4SSN: "_$PIECE($PIECE(VADM(2),"^",2),"-",3)_" | DOB: "_$PIECE(VADM(3),"^",2)_")"
+115 DO AUDLOG^PSOERXUT(+CURREC,"PATIENT",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
End DoDot:1
+116 ;
+117 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
KILL FDA
+118 ;
+119 IF $GET(PACHK("success"))="false"
Begin DoDot:1
+120 ; file e&e error
+121 SET ERRTXT=$GET(PACHK("EandEerror"))
IF ERRTXT]""
Begin DoDot:2
+122 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+123 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
End DoDot:2
+124 ; file mvi error
+125 SET ERRTXT=$GET(PACHK("MVIerror"))
IF ERRTXT]""
Begin DoDot:2
+126 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
if 'ERRSEQ
QUIT
+127 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
End DoDot:2
End DoDot:1
+128 ;
+129 SET RES="1^Erx Received."
+130 QUIT
+131 ;
+132 ; VAL - value to resolve
+133 ; 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