PSOERXA3 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
;;7.0;OUTPATIENT PHARMACY;**467,508,617**;DEC 1997;Build 110
;
Q
HDR(MTYPE) ; header information
N GL,GL2,FQUAL,TQUAL,FROM,TO,MID,PONUM,SRTID,SSTID,SENTTIME,RTMID,FDA,ERXIEN,FMID,NEWERX,MES,ERXIENS,SSSID,SRSID,MTVALS
N UPMTYPE,DONE,I,ERXISTAT,MTCODE,COMPSTR,RTHID,RTHIEN,RTMIEN,SIGVAL,X509DATA
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Header",0))
S GL2=$NA(^TMP($J,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
; from and to qualifiers
S FQUAL=$G(@GL2@("From","A","Qualifier"))
S TQUAL=$G(@GL2@("To","A","Qualifier"))
; from, to, message id, prescriber order number
S FROM=$G(@GL@("From",0))
S TO=$G(@GL@("To",0))
S MID=$G(@GL@("MessageID",0))
; set up the full message id
S FMID=MID
S ERXIENS="+1,"
; quit and return a message back if this eRx exists.
I $D(^PS(52.49,"FMID",$P(ERXHID,U))) D Q MES
.S MES="0^This message already exists. Changes must occur via a change request XML message."
S PONUM=$G(@GL@("PrescriberOrderNumber",0))
; security receiver tertiary identification
S SRSID=$G(@GL@("Security",0,"Receiver",0,"SecondaryIdentification",0))
S SRTID=$G(@GL@("Security",0,"Receiver",0,"TertiaryIdentification,",0))
; security sender tertiary identification
S SSSID=$G(@GL@("Security",0,"Sender",0,"SecondaryIdentification",0))
S SSTID=$G(@GL@("Security",0,"Sender",0,"TertiaryIdentification,",0))
; convert senttime to file manager dt/tm
S SENTTIME=$G(@GL@("SentTime",0)),SENTTIME=$$CONVDTTM^PSOERXA1(SENTTIME)
S RTMID=$G(@GL@("RelatesToMessageID",0))
S RTHID=$P(ERXHID,U,3)
S RTHIEN=""
I $L(RTHID) S RTHIEN=$O(^PS(52.49,"FMID",RTHID,0))
D FIELD^DID(52.49,.08,"","POINTER","MTVALS")
S UPMTYPE=$$UP^XLFSTR(MTYPE)
I UPMTYPE="REFILLREQUEST" S UPMTYPE="RXRENEWALREQUEST"
S DONE=0
F I=1:1 D Q:DONE
.S COMPSTR=$P(MTVALS("POINTER"),";",I)
.I COMPSTR="" S DONE=1 Q
.I COMPSTR[UPMTYPE S MTCODE=$P(COMPSTR,":"),DONE=1
I $G(MTCODE)']"" Q "0^Message type could not be resolved."
S FDA(52.49,ERXIENS,.08)=MTCODE
; erx hub message id
S FDA(52.49,ERXIENS,.01)=$P(ERXHID,U)
; change healthcare message id
S FDA(52.49,ERXIENS,25)=FMID
S FDA(52.49,ERXIENS,.02)=RTMID
S FDA(52.49,ERXIENS,.03)=$$NOW^XLFDT
S FDA(52.49,ERXIENS,.09)=PONUM
;RELATES TO HUB ID
S FDA(52.49,ERXIENS,.14)=RTHID
S ERXISTAT=$$GETSTAT^PSOERXU2(MTCODE,RTHIEN,RTMID)
S FDA(52.49,ERXIENS,1)=ERXISTAT
S FDA(52.49,ERXIENS,22.1)=FROM
S FDA(52.49,ERXIENS,22.2)=FQUAL
S FDA(52.49,ERXIENS,22.3)=TO
S FDA(52.49,ERXIENS,22.4)=TQUAL
S FDA(52.49,ERXIENS,22.5)=SENTTIME
S FDA(52.49,ERXIENS,24.3)=SSSID
S FDA(52.49,ERXIENS,24.4)=SSTID
S FDA(52.49,ERXIENS,24.5)=SRSID
S FDA(52.49,ERXIENS,24.6)=SRTID
; Controlled Substance eRx
S FDA(52.49,ERXIENS,95.1)=$$CSERX^PSOERXA1()
I $$CSERX^PSOERXA1() D
. S FDA(52.49,ERXIENS,95.2)=$G(@GL@("DigitalSignature",0,"DigestMethod",0))
. S FDA(52.49,ERXIENS,95.3)=$G(@GL@("DigitalSignature",0,"DigestValue",0))
. K SIGVAL S SIGVAL(1)=$G(@GL@("DigitalSignature",0,"SignatureValue",0))
. S FDA(52.49,ERXIENS,95.4)="SIGVAL"
. K X509DAT S X509DAT(1)=$G(@GL@("DigitalSignature",0,"X509Data",0))
. S FDA(52.49,ERXIENS,95.5)="X509DAT"
; if this is an existing record, file the updates to the erx and return the IEN
D UPDATE^DIE(,"FDA","NEWERX","EERR") K FDA
S ERXIEN=""
S ERXIEN=$O(NEWERX(0)),ERXIEN=$G(NEWERX(ERXIEN))
I 'ERXIEN Q ""
I $G(RTHIEN)]"" D
.N REFREQ,NRXIEN
.S NRXIEN=$$FINDNRX^PSOERXU6(ERXIEN)
.I MTCODE="RE" D
..S REFREQ=$$GETREQ^PSOERXU2(ERXIEN)
..I REFREQ S NRXIEN=$$FINDNRX^PSOERXU6(REFREQ)
..I $D(^PS(52.49,NRXIEN,201,"B",ERXIEN)) Q
..I $G(NRXIEN) S FDA2(52.49201,"+1,"_NRXIEN_",",.01)=ERXIEN D UPDATE^DIE(,"FDA2") K FDA2
.; link this message to the original
.I $G(NRXIEN) D
..I $D(^PS(52.49,NRXIEN,201,"B",ERXIEN)) Q
..S FDA2(52.49201,"+1,"_NRXIEN_",",.01)=ERXIEN D UPDATE^DIE(,"FDA2") K FDA2
.I '$D(^PS(52.49,RTHIEN,201,"B",ERXIEN)) D
..S FDA2(52.49201,"+1,"_RTHIEN_",",.01)=ERXIEN D UPDATE^DIE(,"FDA2") K FDA2
.; link original message to this erxien
.I '$D(^PS(52.49,ERXIEN,201,"B",RTHIEN)) D
..S FDA2(52.49201,"+1,"_ERXIEN_",",.01)=RTHIEN D UPDATE^DIE(,"FDA2") K FDA2
I MTYPE["Error" D ERR^PSOERXU2(ERXIEN,MTYPE)
; Future consideration - XSD shows digital signature. Do we need to collect this?
Q ERXIEN
;
MED(ERXIEN,ERXVALS,MTYPE) ; medication prescribed
N GL,VALDT,DAYS,CIQUAL,PQUAL,PDIAG,SQUAL,DIAG,SDIAG,DIRECT,DCSTAT,DCSCODE,DDESC,DUE,CAID,CAQUAL,PSC,SREACODE,SRESCODE
N EFFDT,EXPDT,NOTE,PEDT,PAUTHQ,PAUTHV,PAUTHS,QCLQ,QPUC,QUSC,QTY,REFQUAL,REFILLS,WRITDT,SUBS,STOPIND,CLINSIG,ACKREA
N F,EIENS,SFDA,FDA,DIENS,DCCNT,VALDATE,DCDBCOD,DCDBCODQ,DCDEASCH,DCFC,DCFSC,DCPCODE,DCPCQUAL,DCSTR,DCSTRC,DCSTSC,GL2
N DONOTFIL
I 'ERXIEN Q
S EIENS=ERXIEN_","
S F=52.49
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"MedicationPrescribed",0))
S GL2=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"MedicationDispensed",0))
S VALDT=$G(@GL@("DateValidated",0,"Date",0)),VALDATE=$$CONVDTTM^PSOERXA1(VALDT),FDA(52.49,EIENS,6.6)=VALDATE
S DAYS=$G(@GL@("DaysSupply",0)) I DAYS S FDA(F,EIENS,5.5)=+$G(DAYS)
; force to numeric
I +$G(DAYS)<366 S FDA(F,EIENS,20.2)=+$G(DAYS)
S FDA(F,EIENS,20.4)="M"
S DIRECT=$G(@GL@("Directions",0)),FDA(F,EIENS,7)=DIRECT
S DDESC=$$UP^XLFSTR($G(@GL@("DrugDescription",0))),FDA(52.49,EIENS,3.1)=DDESC
; drugCoded
S DCPCODE=$G(@GL@("DrugCoded",0,"ProductCode",0)),FDA(F,EIENS,4.1)=DCPCODE
S DCPCQUAL=$G(@GL@("DrugCoded",0,"ProductCodeQualifier",0)),FDA(F,EIENS,4.2)=DCPCQUAL
S DCSTR=$G(@GL@("DrugCoded",0,"Strength",0)),FDA(F,EIENS,4.3)=DCSTR
S DCDBCOD=$G(@GL@("DrugCoded",0,"DrugDBCode",0)),FDA(F,EIENS,4.4)=DCDBCOD
S DCDBCODQ=$G(@GL@("DrugCoded",0,"DrugDBCodeQualifier",0)),FDA(F,EIENS,4.11)=$$PRESOLV^PSOERXA1(DCDBCODQ,"DDB")
S DCFSC=$G(@GL@("DrugCoded",0,"FormSourceCode",0)),FDA(F,EIENS,4.5)=DCFSC
S DCFC=$G(@GL@("DrugCoded",0,"FormCode",0)),FDA(F,EIENS,4.6)=DCFC
S DCSTSC=$G(@GL@("DrugCoded",0,"StrengthSourceCode",0)),FDA(F,EIENS,4.7)=DCSTSC
S DCSTRC=$G(@GL@("DrugCoded",0,"StrengthCode",0)),FDA(F,EIENS,4.8)=DCSTRC
S DCDEASCH=$G(@GL@("DrugCoded",0,"DEASchedule",0)),FDA(F,EIENS,4.9)=DCDEASCH
; end drugCoded
S EFFDT=$G(@GL@("EffectiveDate",0,"Date",0))
I EFFDT="" S EFFDT=$G(@GL@("EffectiveDate",0,"DateTime",0))
S EFFDT=$$CONVDTTM^PSOERXA1(EFFDT),FDA(F,EIENS,6.3)=EFFDT
S EXPDT=$G(@GL@("ExpirationDate",0,"Date",0))
I EXPDT="" S EXPDT=$G(@GL@("ExpirationDate",0,"DateTime",0))
S EXPDT=$$CONVDTTM^PSOERXA1(EXPDT),FDA(F,EIENS,6.2)=EXPDT
S NOTE=$G(@GL@("Note",0)),FDA(F,EIENS,8)=NOTE
; Future enhancement - no place to store period end date as of now, add in the future if needed
S PEDT=$G(@GL@("PeriodEnd",0,"Date",0))
I PEDT="" S PEDT=$G(@GL@("PeriodEnd",0,"DateTime",0))
S PEDT=$$CONVDTTM^PSOERXA1(PEDT),FDA(F,EIENS,6.4)=PEDT
S WRITDT=$G(@GL@("WrittenDate",0,"Date",0))
I WRITDT="" S WRITDT=$G(@GL@("WrittenDate",0,"DateTime",0))
S WRITDT=$$CONVDTTM^PSOERXA1(WRITDT),FDA(F,EIENS,5.9)=WRITDT
;DoNotFill Indicator
S DONOTFIL=$G(@GL@("DoNotFill",0)) I $G(DONOTFIL)'="" S FDA(F,EIENS,10.5)=$S(DONOTFIL="Y":1,DONOTFIL="E":2,DONOTFIL="H":3,1:"")
; dispense notes
S SUBS=$G(@GL@("Substitutions",0)),FDA(F,EIENS,5.8)=SUBS
; Future enhancement - store stop indicator
;S STOPIND=$G(@GL@("Stop",0,"StopIndicator",0)),FDA(F,EIENS,12.7)=STOPIND
; prior authorization
S PAUTHQ=$G(@GL@("PriorAuthorization",0,"Qualifier",0)),PAUTHQ=$$PRESOLV^PSOERXA1(PAUTHQ,"PAV"),FDA(F,EIENS,10.3)=PAUTHQ
S PAUTHV=$G(@GL@("PriorAuthorization",0,"Value",0)),FDA(F,EIENS,10.2)=PAUTHV
S PAUTHS=$G(@GL@("PriorAuthorizationStatus",0)),FDA(F,EIENS,10.4)=PAUTHS
; quantity
S QCLQ=$G(@GL@("Quantity",0,"CodeListQualifier",0)),FDA(F,EIENS,5.2)=QCLQ
S QPUC=$G(@GL@("Quantity",0,"PotencyUnitCode",0)),FDA(F,EIENS,5.4)=QPUC
S QUSC=$G(@GL@("Quantity",0,"UnitSourceCode",0)),FDA(F,EIENS,5.3)=QUSC
S QTY=$G(@GL@("Quantity",0,"Value",0)),FDA(F,EIENS,5.1)=QTY
; future consideration:
; need to look into quantity multiplier on the VA side of things. It looks like the
; ncpdp quantity multiplier is for billing purposes only.
I $L($P(QTY,".",2))<3 S FDA(F,EIENS,20.1)=QTY
; refills
S REFQUAL=$G(@GL@("Refills",0,"Qualifier",0)),FDA(F,EIENS,5.7)=REFQUAL
S REFILLS=$G(@GL@("Refills",0,"Value",0))
S FDA(F,EIENS,5.6)=REFILLS
; ensure vista refills can be exacly what is passed in, as long as it is not greater than 11
I REFILLS<12 S FDA(F,EIENS,20.5)=REFILLS
S FDA(F,EIENS,20.4)="M"
S FDA(F,EIENS,41)=$P($G(ERXVALS("FormCode")),U,2)
S FDA(F,EIENS,42)=$P($G(ERXVALS("PotencyUnitCode")),U,2)
S FDA(F,EIENS,43)=$P($G(ERXVALS("StrengthCode")),U,2)
; file what we currently have
D FILE^DIE(,"FDA") K FDA
; diagnosis - primary and secondary
N DIAGCNT,STORCODE,DIAFDA
S DIAGCNT=0
S DIAG=-1 F S DIAG=$O(@GL@("Diagnosis",DIAG)) Q:DIAG="" D
.S DIAGCNT=DIAGCNT+1
.S DIENS="+"_DIAGCNT_","_EIENS
.S CIQUAL=$G(@GL@("Diagnosis",DIAG,"ClinicalInformationQualifier",0))
.S PQUAL=$G(@GL@("Diagnosis",DIAG,"Primary",0,"Qualifier",0))
.S PDIAG=$G(@GL@("Diagnosis",DIAG,"Primary",0,"Value",0))
.S SQUAL=$G(@GL@("Diagnosis",DIAG,"Secondary",0,"Qualifier",0))
.S SDIAG=$G(@GL@("Diagnosis",DIAG,"Secondary",0,"Value",0))
.S DIAFDA(52.499,"+1,"_EIENS,.01)=DIAGCNT,DIAFDA(52.499,"+1,"_EIENS,.02)=CIQUAL
.S DIAFDA(52.499,"+1,"_EIENS,.03)=PQUAL,DIAFDA(52.499,"+1,"_EIENS,.04)=PDIAG
.S DIAFDA(52.499,"+1,"_EIENS,.05)=SQUAL,DIAFDA(52.499,"+1,"_EIENS,.06)=SDIAG
.D UPDATE^DIE(,"DIAFDA") K DIAFDA
; drug coverage status codes
S DCCNT=0
S DCSTAT=-1 F S DCSTAT=$O(@GL@("DrugCoverageStatusCode",DCSTAT)) Q:DCSTAT="" D
.S DCSCODE=$G(@GL@("DrugCoverageStatusCode",DCSTAT))
.S STORCODE=$$PRESOLV^PSOERXA1(DCSCODE,"DCS") Q:'$L(STORCODE)
.S DCCNT=DCCNT+1
.S DCFDA(52.4928,"+1,"_EIENS,.01)=DCCNT
.S DCFDA(52.4928,"+1,"_EIENS,.02)=STORCODE D UPDATE^DIE(,"DCFDA") K DCFDA
; if the service reason code (.01) be the same value more than once, convert the .01 field to a sequence
S DUE=-1 F S DUE=$O(@GL@("DrugUseEvaluation",DUE)) Q:DUE="" D
.S CAID=$G(@GL@("DrugUseEvaluation",DUE,"CoAgent",0,"CoAgentID",0)),DUEFDA(52.4916,"+1,"_EIENS,.04)=CAID
.S CAQUAL=$G(@GL@("DrugUseEvaluation",DUE,"CoAgent",0,"CoAgentQualifier",0)),CAQUAL=$$PRESOLV^PSOERXA1(CAQUAL,"CAQ"),DUEFDA(52.4916,"+1,"_EIENS,.05)=CAQUAL
.S PSC=$G(@GL@("DrugUseEvaluation",DUE,"ProfessionalServiceCode",0)),PSC=$$PRESOLV^PSOERXA1(PSC,"PSC"),DUEFDA(52.4916,"+1,"_EIENS,.02)=PSC
.S SREACODE=$G(@GL@("DrugUseEvaluation",DUE,"ServiceReasonCode",0)),SREACODE=$$PRESOLV^PSOERXA1(SREACODE,"REA"),DUEFDA(52.4916,"+1,"_EIENS,.01)=SREACODE
.S SRESCODE=$G(@GL@("DrugUseEvaluation",DUE,"ServiceResultCode",0)),SRESCODE=$$PRESOLV^PSOERXA1(SRESCODE,"RES"),DUEFDA(52.4916,"+1,"_EIENS,.03)=SRESCODE
.S CLINSIG=$G(@GL@("DrugUseEvaluation",DUE,"ClinicalSignificanceCode",0)),DUEFDA(52.4916,"+1,"_EIENS,.06)=CLINSIG
.S ACKREA=$G(@GL@("DrugUseEvaluation",DUE,"AcknowledgementReason",0)),DUEFDA(52.4916,"+1,"_EIENS,1)=ACKREA
.D UPDATE^DIE(,"DUEFDA") K DUEFDA
D SS^PSOERXA4(EIENS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXA3 11157 printed Apr 09, 2024@21:37:04 Page 2
PSOERXA3 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**467,508,617**;DEC 1997;Build 110
+2 ;
+3 QUIT
HDR(MTYPE) ; header information
+1 NEW GL,GL2,FQUAL,TQUAL,FROM,TO,MID,PONUM,SRTID,SSTID,SENTTIME,RTMID,FDA,ERXIEN,FMID,NEWERX,MES,ERXIENS,SSSID,SRSID,MTVALS
+2 NEW UPMTYPE,DONE,I,ERXISTAT,MTCODE,COMPSTR,RTHID,RTHIEN,RTMIEN,SIGVAL,X509DATA
+3 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Header",0))
+4 SET GL2=$NAME(^TMP($JOB,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
+5 ; from and to qualifiers
+6 SET FQUAL=$GET(@GL2@("From","A","Qualifier"))
+7 SET TQUAL=$GET(@GL2@("To","A","Qualifier"))
+8 ; from, to, message id, prescriber order number
+9 SET FROM=$GET(@GL@("From",0))
+10 SET TO=$GET(@GL@("To",0))
+11 SET MID=$GET(@GL@("MessageID",0))
+12 ; set up the full message id
+13 SET FMID=MID
+14 SET ERXIENS="+1,"
+15 ; quit and return a message back if this eRx exists.
+16 IF $DATA(^PS(52.49,"FMID",$PIECE(ERXHID,U)))
Begin DoDot:1
+17 SET MES="0^This message already exists. Changes must occur via a change request XML message."
End DoDot:1
QUIT MES
+18 SET PONUM=$GET(@GL@("PrescriberOrderNumber",0))
+19 ; security receiver tertiary identification
+20 SET SRSID=$GET(@GL@("Security",0,"Receiver",0,"SecondaryIdentification",0))
+21 SET SRTID=$GET(@GL@("Security",0,"Receiver",0,"TertiaryIdentification,",0))
+22 ; security sender tertiary identification
+23 SET SSSID=$GET(@GL@("Security",0,"Sender",0,"SecondaryIdentification",0))
+24 SET SSTID=$GET(@GL@("Security",0,"Sender",0,"TertiaryIdentification,",0))
+25 ; convert senttime to file manager dt/tm
+26 SET SENTTIME=$GET(@GL@("SentTime",0))
SET SENTTIME=$$CONVDTTM^PSOERXA1(SENTTIME)
+27 SET RTMID=$GET(@GL@("RelatesToMessageID",0))
+28 SET RTHID=$PIECE(ERXHID,U,3)
+29 SET RTHIEN=""
+30 IF $LENGTH(RTHID)
SET RTHIEN=$ORDER(^PS(52.49,"FMID",RTHID,0))
+31 DO FIELD^DID(52.49,.08,"","POINTER","MTVALS")
+32 SET UPMTYPE=$$UP^XLFSTR(MTYPE)
+33 IF UPMTYPE="REFILLREQUEST"
SET UPMTYPE="RXRENEWALREQUEST"
+34 SET DONE=0
+35 FOR I=1:1
Begin DoDot:1
+36 SET COMPSTR=$PIECE(MTVALS("POINTER"),";",I)
+37 IF COMPSTR=""
SET DONE=1
QUIT
+38 IF COMPSTR[UPMTYPE
SET MTCODE=$PIECE(COMPSTR,":")
SET DONE=1
End DoDot:1
if DONE
QUIT
+39 IF $GET(MTCODE)']""
QUIT "0^Message type could not be resolved."
+40 SET FDA(52.49,ERXIENS,.08)=MTCODE
+41 ; erx hub message id
+42 SET FDA(52.49,ERXIENS,.01)=$PIECE(ERXHID,U)
+43 ; change healthcare message id
+44 SET FDA(52.49,ERXIENS,25)=FMID
+45 SET FDA(52.49,ERXIENS,.02)=RTMID
+46 SET FDA(52.49,ERXIENS,.03)=$$NOW^XLFDT
+47 SET FDA(52.49,ERXIENS,.09)=PONUM
+48 ;RELATES TO HUB ID
+49 SET FDA(52.49,ERXIENS,.14)=RTHID
+50 SET ERXISTAT=$$GETSTAT^PSOERXU2(MTCODE,RTHIEN,RTMID)
+51 SET FDA(52.49,ERXIENS,1)=ERXISTAT
+52 SET FDA(52.49,ERXIENS,22.1)=FROM
+53 SET FDA(52.49,ERXIENS,22.2)=FQUAL
+54 SET FDA(52.49,ERXIENS,22.3)=TO
+55 SET FDA(52.49,ERXIENS,22.4)=TQUAL
+56 SET FDA(52.49,ERXIENS,22.5)=SENTTIME
+57 SET FDA(52.49,ERXIENS,24.3)=SSSID
+58 SET FDA(52.49,ERXIENS,24.4)=SSTID
+59 SET FDA(52.49,ERXIENS,24.5)=SRSID
+60 SET FDA(52.49,ERXIENS,24.6)=SRTID
+61 ; Controlled Substance eRx
+62 SET FDA(52.49,ERXIENS,95.1)=$$CSERX^PSOERXA1()
+63 IF $$CSERX^PSOERXA1()
Begin DoDot:1
+64 SET FDA(52.49,ERXIENS,95.2)=$GET(@GL@("DigitalSignature",0,"DigestMethod",0))
+65 SET FDA(52.49,ERXIENS,95.3)=$GET(@GL@("DigitalSignature",0,"DigestValue",0))
+66 KILL SIGVAL
SET SIGVAL(1)=$GET(@GL@("DigitalSignature",0,"SignatureValue",0))
+67 SET FDA(52.49,ERXIENS,95.4)="SIGVAL"
+68 KILL X509DAT
SET X509DAT(1)=$GET(@GL@("DigitalSignature",0,"X509Data",0))
+69 SET FDA(52.49,ERXIENS,95.5)="X509DAT"
End DoDot:1
+70 ; if this is an existing record, file the updates to the erx and return the IEN
+71 DO UPDATE^DIE(,"FDA","NEWERX","EERR")
KILL FDA
+72 SET ERXIEN=""
+73 SET ERXIEN=$ORDER(NEWERX(0))
SET ERXIEN=$GET(NEWERX(ERXIEN))
+74 IF 'ERXIEN
QUIT ""
+75 IF $GET(RTHIEN)]""
Begin DoDot:1
+76 NEW REFREQ,NRXIEN
+77 SET NRXIEN=$$FINDNRX^PSOERXU6(ERXIEN)
+78 IF MTCODE="RE"
Begin DoDot:2
+79 SET REFREQ=$$GETREQ^PSOERXU2(ERXIEN)
+80 IF REFREQ
SET NRXIEN=$$FINDNRX^PSOERXU6(REFREQ)
+81 IF $DATA(^PS(52.49,NRXIEN,201,"B",ERXIEN))
QUIT
+82 IF $GET(NRXIEN)
SET FDA2(52.49201,"+1,"_NRXIEN_",",.01)=ERXIEN
DO UPDATE^DIE(,"FDA2")
KILL FDA2
End DoDot:2
+83 ; link this message to the original
+84 IF $GET(NRXIEN)
Begin DoDot:2
+85 IF $DATA(^PS(52.49,NRXIEN,201,"B",ERXIEN))
QUIT
+86 SET FDA2(52.49201,"+1,"_NRXIEN_",",.01)=ERXIEN
DO UPDATE^DIE(,"FDA2")
KILL FDA2
End DoDot:2
+87 IF '$DATA(^PS(52.49,RTHIEN,201,"B",ERXIEN))
Begin DoDot:2
+88 SET FDA2(52.49201,"+1,"_RTHIEN_",",.01)=ERXIEN
DO UPDATE^DIE(,"FDA2")
KILL FDA2
End DoDot:2
+89 ; link original message to this erxien
+90 IF '$DATA(^PS(52.49,ERXIEN,201,"B",RTHIEN))
Begin DoDot:2
+91 SET FDA2(52.49201,"+1,"_ERXIEN_",",.01)=RTHIEN
DO UPDATE^DIE(,"FDA2")
KILL FDA2
End DoDot:2
End DoDot:1
+92 IF MTYPE["Error"
DO ERR^PSOERXU2(ERXIEN,MTYPE)
+93 ; Future consideration - XSD shows digital signature. Do we need to collect this?
+94 QUIT ERXIEN
+95 ;
MED(ERXIEN,ERXVALS,MTYPE) ; medication prescribed
+1 NEW GL,VALDT,DAYS,CIQUAL,PQUAL,PDIAG,SQUAL,DIAG,SDIAG,DIRECT,DCSTAT,DCSCODE,DDESC,DUE,CAID,CAQUAL,PSC,SREACODE,SRESCODE
+2 NEW EFFDT,EXPDT,NOTE,PEDT,PAUTHQ,PAUTHV,PAUTHS,QCLQ,QPUC,QUSC,QTY,REFQUAL,REFILLS,WRITDT,SUBS,STOPIND,CLINSIG,ACKREA
+3 NEW F,EIENS,SFDA,FDA,DIENS,DCCNT,VALDATE,DCDBCOD,DCDBCODQ,DCDEASCH,DCFC,DCFSC,DCPCODE,DCPCQUAL,DCSTR,DCSTRC,DCSTSC,GL2
+4 NEW DONOTFIL
+5 IF 'ERXIEN
QUIT
+6 SET EIENS=ERXIEN_","
+7 SET F=52.49
+8 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"MedicationPrescribed",0))
+9 SET GL2=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"MedicationDispensed",0))
+10 SET VALDT=$GET(@GL@("DateValidated",0,"Date",0))
SET VALDATE=$$CONVDTTM^PSOERXA1(VALDT)
SET FDA(52.49,EIENS,6.6)=VALDATE
+11 SET DAYS=$GET(@GL@("DaysSupply",0))
IF DAYS
SET FDA(F,EIENS,5.5)=+$GET(DAYS)
+12 ; force to numeric
+13 IF +$GET(DAYS)<366
SET FDA(F,EIENS,20.2)=+$GET(DAYS)
+14 SET FDA(F,EIENS,20.4)="M"
+15 SET DIRECT=$GET(@GL@("Directions",0))
SET FDA(F,EIENS,7)=DIRECT
+16 SET DDESC=$$UP^XLFSTR($GET(@GL@("DrugDescription",0)))
SET FDA(52.49,EIENS,3.1)=DDESC
+17 ; drugCoded
+18 SET DCPCODE=$GET(@GL@("DrugCoded",0,"ProductCode",0))
SET FDA(F,EIENS,4.1)=DCPCODE
+19 SET DCPCQUAL=$GET(@GL@("DrugCoded",0,"ProductCodeQualifier",0))
SET FDA(F,EIENS,4.2)=DCPCQUAL
+20 SET DCSTR=$GET(@GL@("DrugCoded",0,"Strength",0))
SET FDA(F,EIENS,4.3)=DCSTR
+21 SET DCDBCOD=$GET(@GL@("DrugCoded",0,"DrugDBCode",0))
SET FDA(F,EIENS,4.4)=DCDBCOD
+22 SET DCDBCODQ=$GET(@GL@("DrugCoded",0,"DrugDBCodeQualifier",0))
SET FDA(F,EIENS,4.11)=$$PRESOLV^PSOERXA1(DCDBCODQ,"DDB")
+23 SET DCFSC=$GET(@GL@("DrugCoded",0,"FormSourceCode",0))
SET FDA(F,EIENS,4.5)=DCFSC
+24 SET DCFC=$GET(@GL@("DrugCoded",0,"FormCode",0))
SET FDA(F,EIENS,4.6)=DCFC
+25 SET DCSTSC=$GET(@GL@("DrugCoded",0,"StrengthSourceCode",0))
SET FDA(F,EIENS,4.7)=DCSTSC
+26 SET DCSTRC=$GET(@GL@("DrugCoded",0,"StrengthCode",0))
SET FDA(F,EIENS,4.8)=DCSTRC
+27 SET DCDEASCH=$GET(@GL@("DrugCoded",0,"DEASchedule",0))
SET FDA(F,EIENS,4.9)=DCDEASCH
+28 ; end drugCoded
+29 SET EFFDT=$GET(@GL@("EffectiveDate",0,"Date",0))
+30 IF EFFDT=""
SET EFFDT=$GET(@GL@("EffectiveDate",0,"DateTime",0))
+31 SET EFFDT=$$CONVDTTM^PSOERXA1(EFFDT)
SET FDA(F,EIENS,6.3)=EFFDT
+32 SET EXPDT=$GET(@GL@("ExpirationDate",0,"Date",0))
+33 IF EXPDT=""
SET EXPDT=$GET(@GL@("ExpirationDate",0,"DateTime",0))
+34 SET EXPDT=$$CONVDTTM^PSOERXA1(EXPDT)
SET FDA(F,EIENS,6.2)=EXPDT
+35 SET NOTE=$GET(@GL@("Note",0))
SET FDA(F,EIENS,8)=NOTE
+36 ; Future enhancement - no place to store period end date as of now, add in the future if needed
+37 SET PEDT=$GET(@GL@("PeriodEnd",0,"Date",0))
+38 IF PEDT=""
SET PEDT=$GET(@GL@("PeriodEnd",0,"DateTime",0))
+39 SET PEDT=$$CONVDTTM^PSOERXA1(PEDT)
SET FDA(F,EIENS,6.4)=PEDT
+40 SET WRITDT=$GET(@GL@("WrittenDate",0,"Date",0))
+41 IF WRITDT=""
SET WRITDT=$GET(@GL@("WrittenDate",0,"DateTime",0))
+42 SET WRITDT=$$CONVDTTM^PSOERXA1(WRITDT)
SET FDA(F,EIENS,5.9)=WRITDT
+43 ;DoNotFill Indicator
+44 SET DONOTFIL=$GET(@GL@("DoNotFill",0))
IF $GET(DONOTFIL)'=""
SET FDA(F,EIENS,10.5)=$SELECT(DONOTFIL="Y":1,DONOTFIL="E":2,DONOTFIL="H":3,1:"")
+45 ; dispense notes
+46 SET SUBS=$GET(@GL@("Substitutions",0))
SET FDA(F,EIENS,5.8)=SUBS
+47 ; Future enhancement - store stop indicator
+48 ;S STOPIND=$G(@GL@("Stop",0,"StopIndicator",0)),FDA(F,EIENS,12.7)=STOPIND
+49 ; prior authorization
+50 SET PAUTHQ=$GET(@GL@("PriorAuthorization",0,"Qualifier",0))
SET PAUTHQ=$$PRESOLV^PSOERXA1(PAUTHQ,"PAV")
SET FDA(F,EIENS,10.3)=PAUTHQ
+51 SET PAUTHV=$GET(@GL@("PriorAuthorization",0,"Value",0))
SET FDA(F,EIENS,10.2)=PAUTHV
+52 SET PAUTHS=$GET(@GL@("PriorAuthorizationStatus",0))
SET FDA(F,EIENS,10.4)=PAUTHS
+53 ; quantity
+54 SET QCLQ=$GET(@GL@("Quantity",0,"CodeListQualifier",0))
SET FDA(F,EIENS,5.2)=QCLQ
+55 SET QPUC=$GET(@GL@("Quantity",0,"PotencyUnitCode",0))
SET FDA(F,EIENS,5.4)=QPUC
+56 SET QUSC=$GET(@GL@("Quantity",0,"UnitSourceCode",0))
SET FDA(F,EIENS,5.3)=QUSC
+57 SET QTY=$GET(@GL@("Quantity",0,"Value",0))
SET FDA(F,EIENS,5.1)=QTY
+58 ; future consideration:
+59 ; need to look into quantity multiplier on the VA side of things. It looks like the
+60 ; ncpdp quantity multiplier is for billing purposes only.
+61 IF $LENGTH($PIECE(QTY,".",2))<3
SET FDA(F,EIENS,20.1)=QTY
+62 ; refills
+63 SET REFQUAL=$GET(@GL@("Refills",0,"Qualifier",0))
SET FDA(F,EIENS,5.7)=REFQUAL
+64 SET REFILLS=$GET(@GL@("Refills",0,"Value",0))
+65 SET FDA(F,EIENS,5.6)=REFILLS
+66 ; ensure vista refills can be exacly what is passed in, as long as it is not greater than 11
+67 IF REFILLS<12
SET FDA(F,EIENS,20.5)=REFILLS
+68 SET FDA(F,EIENS,20.4)="M"
+69 SET FDA(F,EIENS,41)=$PIECE($GET(ERXVALS("FormCode")),U,2)
+70 SET FDA(F,EIENS,42)=$PIECE($GET(ERXVALS("PotencyUnitCode")),U,2)
+71 SET FDA(F,EIENS,43)=$PIECE($GET(ERXVALS("StrengthCode")),U,2)
+72 ; file what we currently have
+73 DO FILE^DIE(,"FDA")
KILL FDA
+74 ; diagnosis - primary and secondary
+75 NEW DIAGCNT,STORCODE,DIAFDA
+76 SET DIAGCNT=0
+77 SET DIAG=-1
FOR
SET DIAG=$ORDER(@GL@("Diagnosis",DIAG))
if DIAG=""
QUIT
Begin DoDot:1
+78 SET DIAGCNT=DIAGCNT+1
+79 SET DIENS="+"_DIAGCNT_","_EIENS
+80 SET CIQUAL=$GET(@GL@("Diagnosis",DIAG,"ClinicalInformationQualifier",0))
+81 SET PQUAL=$GET(@GL@("Diagnosis",DIAG,"Primary",0,"Qualifier",0))
+82 SET PDIAG=$GET(@GL@("Diagnosis",DIAG,"Primary",0,"Value",0))
+83 SET SQUAL=$GET(@GL@("Diagnosis",DIAG,"Secondary",0,"Qualifier",0))
+84 SET SDIAG=$GET(@GL@("Diagnosis",DIAG,"Secondary",0,"Value",0))
+85 SET DIAFDA(52.499,"+1,"_EIENS,.01)=DIAGCNT
SET DIAFDA(52.499,"+1,"_EIENS,.02)=CIQUAL
+86 SET DIAFDA(52.499,"+1,"_EIENS,.03)=PQUAL
SET DIAFDA(52.499,"+1,"_EIENS,.04)=PDIAG
+87 SET DIAFDA(52.499,"+1,"_EIENS,.05)=SQUAL
SET DIAFDA(52.499,"+1,"_EIENS,.06)=SDIAG
+88 DO UPDATE^DIE(,"DIAFDA")
KILL DIAFDA
End DoDot:1
+89 ; drug coverage status codes
+90 SET DCCNT=0
+91 SET DCSTAT=-1
FOR
SET DCSTAT=$ORDER(@GL@("DrugCoverageStatusCode",DCSTAT))
if DCSTAT=""
QUIT
Begin DoDot:1
+92 SET DCSCODE=$GET(@GL@("DrugCoverageStatusCode",DCSTAT))
+93 SET STORCODE=$$PRESOLV^PSOERXA1(DCSCODE,"DCS")
if '$LENGTH(STORCODE)
QUIT
+94 SET DCCNT=DCCNT+1
+95 SET DCFDA(52.4928,"+1,"_EIENS,.01)=DCCNT
+96 SET DCFDA(52.4928,"+1,"_EIENS,.02)=STORCODE
DO UPDATE^DIE(,"DCFDA")
KILL DCFDA
End DoDot:1
+97 ; if the service reason code (.01) be the same value more than once, convert the .01 field to a sequence
+98 SET DUE=-1
FOR
SET DUE=$ORDER(@GL@("DrugUseEvaluation",DUE))
if DUE=""
QUIT
Begin DoDot:1
+99 SET CAID=$GET(@GL@("DrugUseEvaluation",DUE,"CoAgent",0,"CoAgentID",0))
SET DUEFDA(52.4916,"+1,"_EIENS,.04)=CAID
+100 SET CAQUAL=$GET(@GL@("DrugUseEvaluation",DUE,"CoAgent",0,"CoAgentQualifier",0))
SET CAQUAL=$$PRESOLV^PSOERXA1(CAQUAL,"CAQ")
SET DUEFDA(52.4916,"+1,"_EIENS,.05)=CAQUAL
+101 SET PSC=$GET(@GL@("DrugUseEvaluation",DUE,"ProfessionalServiceCode",0))
SET PSC=$$PRESOLV^PSOERXA1(PSC,"PSC")
SET DUEFDA(52.4916,"+1,"_EIENS,.02)=PSC
+102 SET SREACODE=$GET(@GL@("DrugUseEvaluation",DUE,"ServiceReasonCode",0))
SET SREACODE=$$PRESOLV^PSOERXA1(SREACODE,"REA")
SET DUEFDA(52.4916,"+1,"_EIENS,.01)=SREACODE
+103 SET SRESCODE=$GET(@GL@("DrugUseEvaluation",DUE,"ServiceResultCode",0))
SET SRESCODE=$$PRESOLV^PSOERXA1(SRESCODE,"RES")
SET DUEFDA(52.4916,"+1,"_EIENS,.03)=SRESCODE
+104 SET CLINSIG=$GET(@GL@("DrugUseEvaluation",DUE,"ClinicalSignificanceCode",0))
SET DUEFDA(52.4916,"+1,"_EIENS,.06)=CLINSIG
+105 SET ACKREA=$GET(@GL@("DrugUseEvaluation",DUE,"AcknowledgementReason",0))
SET DUEFDA(52.4916,"+1,"_EIENS,1)=ACKREA
+106 DO UPDATE^DIE(,"DUEFDA")
KILL DUEFDA
End DoDot:1
+107 DO SS^PSOERXA4(EIENS)
+108 QUIT
