- 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 Feb 18, 2025@23:54:48 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