- PSOERXA1 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**467,520,508,551,581,617,743**;DEC 1997;Build 24
- ;
- 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)
- ; ERXVALS - code values for NIST codes
- ; XML2 - structured sig from the medication prescribed segment
- ; VADAT - DUZ^RXIEN
- INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT) ;
- N CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,NEWVAL
- S NPI=$P($G(DIV),U,2)
- S CURREC=$$PARSE(.XML,.ERXVALS,NPI,.XML2)
- 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 $D(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
- 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)
- I $G(PRCHK("success"))="true" D
- .I PRCHK("IEN") D
- ..S FDA(52.49,CURREC,1.2)=1
- ..S FDA(52.49,CURREC,2.3)=PRCHK("IEN")
- ..;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)_")" ; PSO*7*743
- ..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))
- I $D(FDA) D FILE^DIE(,"FDA") K FDA
- ;
- ;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
- PARSE(STREAM,ERXVALS,NPI,STREAM2) ;
- N %XML,GL,VAINST,MTYPE,HUBDENY
- S GL=$NA(^TMP($J,"PSOERXO1"))
- K @GL
- N STATUS,READER,XOBERR,S,ATTR,READER2,XOBERR2,STATUS2
- S STREAM=$TR(STREAM,"^","")
- I $L(STREAM2) S STREAM2=$TR(STREAM2,"^","")
- S STATUS=##class(%XML.TextReader).ParseStream(STREAM,.READER,,,,,1)
- I $L(STREAM2) S STATUS2=##class(%XML.TextReader).ParseStream(STREAM2,.READER2,,,,,1)
- I $$STATCHK^XOBWLIB(STATUS,.XOBERR,1) D
- .N BREAK
- .S BREAK=0 F Q:BREAK||READER.EOF||'READER.Read() D
- ..N X,PUSHED,PARENT
- ..I READER.AttributeCount D
- ...S PARENT=READER.LocalName
- ...D SPUSH(.S,PARENT) S PUSHED=1
- ...F ATTR=1:1:READER.AttributeCount D
- ....D READER.MoveToAttributeIndex(ATTR)
- ....I READER.NodeType="attribute" D APUT(.S,READER.Value,READER.LocalName)
- ..I READER.NodeType="element",'$G(PUSHED) D SPUSH(.S,READER.LocalName)
- ..; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
- ..I READER.NodeType="element",READER.IsEmptyElement D SPUT(.S,"")
- ..I READER.NodeType="endelement" D SPOP(.S,.X)
- ..I READER.NodeType="chars" D SPUT(.S,READER.Value)
- I $D(STATUS2) D
- .I $$STATCHK^XOBWLIB(STATUS2,.XOBERR2,1) D
- ..N BREAK,S
- ..S BREAK=0 F Q:BREAK||READER2.EOF||'READER2.Read() D
- ...N X,PUSHED,PARENT
- ...I READER2.AttributeCount D
- ....S PARENT=READER2.LocalName
- ....D SPUSH(.S,PARENT) S PUSHED=1
- ....F ATTR=1:1:READER2.AttributeCount D
- .....D READER2.MoveToAttributeIndex(ATTR)
- .....I READER2.NodeType="attribute" D APUT(.S,READER2.Value,READER2.LocalName)
- ...I READER2.NodeType="element",'$G(PUSHED) D SPUSH(.S,READER2.LocalName)
- ...; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
- ...I READER.NodeType="element",READER.IsEmptyElement D SPUT(.S,"")
- ...I READER2.NodeType="endelement" D SPOP(.S,.X)
- ...I READER2.NodeType="chars" D SPUT(.S,READER2.Value)
- S MTYPE=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,"")) Q:MTYPE']"" "0^Message type could not be identified."
- I '$L(NPI) S NPI=$G(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Identification",0,"NPI",0))
- I '$L(NPI) Q "0^Missing NPI. Institution could not be resolved. eRx not filed."
- S VAINST=$$FIND1^DIC(4,,"O",NPI,"ANPI")
- I '$G(VAINST) Q "0^Institution could not be resolved. eRx not filed."
- N NERXIEN,ERR,PATIEN
- S NERXIEN=$$HDR^PSOERXA3(MTYPE)
- I $P(NERXIEN,U)<1 Q NERXIEN
- I $G(VAINST) S FDA(52.49,NERXIEN_",",24.1)=VAINST D FILE^DIE(,"FDA") K FDA
- ; if message type is 'Error', do not try to file the other components.
- I MTYPE["Error" D Q NERXIEN
- .S PATIEN=$$GETPAT^PSOERXU5(NERXIEN) Q:'PATIEN
- .S FDA(52.49,NERXIEN_",",.04)=PATIEN D FILE^DIE(,"FDA") K FDA
- D PAT(NERXIEN,MTYPE),BFC^PSOERXA5(NERXIEN),PHR^PSOERXA2(NERXIEN,MTYPE),PRE^PSOERXA2(NERXIEN,MTYPE)
- D MED^PSOERXA3(NERXIEN,.ERXVALS,MTYPE),OBS(NERXIEN,MTYPE),SUP^PSOERXA2(NERXIEN,MTYPE)
- D MEDDISP^PSOERXA5(NERXIEN,MTYPE)
- I MTYPE="RefillResponse" D REFRESP^PSOERXA5(NERXIEN,MTYPE)
- I MTYPE["Cancel" D
- .S HUBDENY=$P(ERXHID,U,2)
- .D CANRX^PSOERXA5(NERXIEN,MTYPE,HUBDENY,VAINST)
- ; facility/request have no where to go at this point in time??
- D FAC^PSOERXA2(NERXIEN)
- Q NERXIEN
- ;
- OBS(ERXIEN,MTYPE) ; Observation
- N GL,I,LAST,DIM,MSOURCE,MUNIT,OBSDT,MVAL,OBSNOTE,OBSCNT,F,EIENS,FDA,MDQUAL
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Observation",0))
- S F=52.4914,EIENS=ERXIEN_","
- S I=-1,OBSCNT=0 F S I=$O(@GL@("Measurement",I)) Q:I="" D
- .S OBSCNT=OBSCNT+1,FDA(F,"+1,"_EIENS,.01)=OBSCNT
- .S DIM=$G(@GL@("Measurement",I,"Dimension",0)),FDA(F,"+1,"_EIENS,.02)=DIM
- .S MDQUAL=$G(@GL@("Measurement",I,"MeasurementDataQualifier",0)),FDA(F,"+1,"_EIENS,.05)=MDQUAL
- .S MSOURCE=$G(@GL@("Measurement",I,"MeasurementSourceCode",0)),FDA(F,"+1,"_EIENS,.06)=MSOURCE
- .S MUNIT=$G(@GL@("Measurement",I,"MeasurementUnitCode",0)),FDA(F,"+1,"_EIENS,.07)=MUNIT
- .S OBSDT=$G(@GL@("Measurement",I,"ObservationDate",0,"Date",0)),OBSDT=$$CONVDTTM^PSOERXA1(OBSDT),FDA(F,"+1,"_EIENS,.04)=OBSDT
- .S MVAL=$G(@GL@("Measurement",I,"Value",0)),FDA(F,"+1,"_EIENS,.03)=MVAL
- .D UPDATE^DIE(,"FDA") K FDA
- S OBSNOTE=$G(@GL@("ObservationNotes",0)),FDA(52.49,EIENS,15)=OBSNOTE D FILE^DIE(,"FDA") K FDA
- Q
- PAT(ERXIEN,MTYPE) ; patient
- N GL,AL1,AL2,CITY,STATE,ZIP,LN,FN,MN,PREF,SUFF,COMQUAL,COMVAL,PLQUAL,DOB,GEN,PRELATE,IDDONE,CDONE,I,C,CQUAL,CVAL
- N IDNM,IDVAL,PFN,ERXPAT,NEWPAT,F,EIENS,FDA,IDFND,SRCH,PIENS,NPIEN,PATSSN,PREL,SIEN
- S F=52.46
- S EIENS=ERXIEN_","
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0))
- S PREL=$G(@GL@("PatientRelationship",0))
- S FN=$$UP^XLFSTR($G(@GL@("Name",0,"FirstName",0)))
- S LN=$$UP^XLFSTR($G(@GL@("Name",0,"LastName",0)))
- S MN=$$UP^XLFSTR($G(@GL@("Name",0,"MiddleName",0)))
- S PFN=LN_","_FN_$S(MN]"":" "_MN,1:"")
- S SUFF=$$UP^XLFSTR($G(@GL@("Name",0,"Suffix",0)))
- S PREF=$$UP^XLFSTR($G(@GL@("Name",0,"Prefix",0)))
- S PRELATE=$G(@GL@("PatientRelationship",0))
- S GEN=$G(@GL@("Gender",0))
- S DOB=$G(@GL@("DateOfBirth",0,"Date",0)),DOB=$$CONVDTTM^PSOERXA1(DOB)
- I DOB<1 S DOB=""
- S AL1=$G(@GL@("Address",0,"AddressLine1",0))
- S AL2=$G(@GL@("Address",0,"AddressLine2",0))
- S CITY=$G(@GL@("Address",0,"City",0))
- S STATE=$G(@GL@("Address",0,"State",0))
- S ZIP=$G(@GL@("Address",0,"ZipCode",0))
- S SIEN=$$STRES^PSOERXA2(ZIP,STATE)
- ; need to check for SSN before trying to match the patient. This needs to be stored in an array for later processing
- ; check 52.46 for a match before filing
- S PATSSN=$G(@GL@("Identification",0,"SocialSecurity",0))
- S ERXPAT=$$FINDPAT^PSOERXU2(PFN,DOB,GEN,$G(PATSSN),$G(AL1)) S PIENS=$S(ERXPAT:ERXPAT_",",1:"+1,")
- ; first, lets set up the main part
- S FDA(F,PIENS,.01)=PFN,FDA(F,PIENS,.02)=LN,FDA(F,PIENS,.03)=FN,FDA(F,PIENS,.04)=MN,FDA(F,PIENS,.05)=SUFF,FDA(F,PIENS,.06)=PREF
- S FDA(F,PIENS,.07)=GEN,FDA(F,PIENS,.08)=DOB
- S FDA(F,PIENS,1.4)=PATSSN,FDA(F,PIENS,1.7)=PREL
- S FDA(F,PIENS,3.1)=AL1,FDA(F,PIENS,3.2)=AL2,FDA(F,PIENS,3.3)=CITY
- S FDA(F,PIENS,3.4)=SIEN
- S FDA(F,PIENS,3.5)=ZIP
- I PIENS["+" D Q
- .D UPDATE^DIE(,"FDA","NEWPAT") K FDA
- .S NPIEN=$O(NEWPAT(0)),NPIEN=$G(NEWPAT(NPIEN))
- .Q:'NPIEN
- .S NPIEN=NPIEN
- .D PATC(NPIEN)
- .S FDA(52.49,EIENS,.04)=NPIEN D FILE^DIE(,"FDA") K FDA
- D FILE^DIE(,"FDA") K FDA D PATC(ERXPAT)
- S FDA(52.49,EIENS,.04)=ERXPAT D FILE^DIE(,"FDA") K FDA
- Q
- PATC(IEN) ; patient communication
- N IENS,CQUAL,CVAL,COMARY,FDA,SRCH,IDFND,IDNM,IDVAL,IDARY,PATSSN
- Q:'IEN
- S IENS=IEN_","
- ; Kill off existing communication values
- K ^PS(52.46,IEN,3)
- S C=-1 F S C=$O(@GL@("CommunicationNumbers",0,"Communication",C)) Q:C="" D
- .S CQUAL=$G(@GL@("CommunicationNumbers",0,"Communication",C,"Qualifier",0))
- .S CVAL=$G(@GL@("CommunicationNumbers",0,"Communication",C,"Number",0))
- .S COMARY(CQUAL)=CVAL
- .S FDA(52.462,"+1,"_IENS,.01)=CVAL
- .S FDA(52.462,"+1,"_IENS,.02)=CQUAL
- .D UPDATE^DIE(,"FDA") K FDA
- ; kill existing identification values in multiple
- K ^PS(52.46,IEN,5)
- S IDNM="" F S IDNM=$O(@GL@("Identification",0,IDNM)) Q:IDNM="" D
- .S IDVAL=$G(@GL@("Identification",0,IDNM,0))
- .I IDNM="SocialSecurity" S PATSSN=IDVAL
- .S IDARY(IDNM)=IDVAL
- .S IDFND=0
- .S SRCH=0 F S SRCH=$O(^PS(52.46,IEN,5,SRCH)) Q:'SRCH D
- ..I $$GET1^DIQ(52.465,SRCH_","_IEN_",",.01)=IDNM D
- ...S IDFND=1
- ...S FDA(52.465,SRCH_","_IEN_",",.02)=IDVAL D FILE^DIE(,"FDA") K FDA
- .Q:IDFND
- .S FDA(52.465,"+1,"_IEN_",",.01)=IDNM
- .S FDA(52.465,"+1,"_IEN_",",.02)=IDVAL
- .D UPDATE^DIE(,"FDA") K FDA
- I $G(PATSSN)]"" S FDA(52.46,IENS,1.4)=PATSSN D FILE^DIE(,"FDA") K FDA
- Q
- SPUSH(S,X) ;places X on the stack S and returns the current level of the stack
- N I S I=$O(S(""),-1)+1,S(I)=X
- Q I
- ;
- SPOP(S,X) ;removes the top item from the stack S and put it into the variable X and returns the level that X was at
- N I S I=$O(S(""),-1)
- I I S X=S(I) K S(I)
- N J S J=$O(S(I),-1) I J S S(J,X)=$G(S(J,X))+1
- Q I
- ;
- SPEEK(S,X) ;same as SPOP except the top item is not removed
- N I S I=$O(S(""),-1)
- I I S X=S(I)
- Q I
- ;
- SPUT(S,X) ;implementation specific, uses the stack to form a global node
- N I,STR
- S X=$TR(X,";","")
- S STR=$P(GL,")")
- S I=0 F S I=$O(S(I)) Q:'I D
- .S STR=STR_","_""""_S(I)_""""_","
- .N NUM S NUM=0
- .I $D(S(I-1,S(I))) S NUM=+$G(S(I-1,S(I)))
- .S STR=STR_NUM
- S STR=STR_")"
- I $D(@STR) S @STR=@STR_X
- I '$D(@STR) S @STR=X
- Q STR
- APUT(S,X,LN) ; what am i doing here?
- N I,STR
- S X=$TR(X,";","")
- S STR=$P(GL,")")
- S I=0 F S I=$O(S(I)) Q:'I D
- .S STR=STR_","_""""_S(I)_""""_","
- .N NUM S NUM="""A"""
- .S STR=STR_NUM_","_""""_LN_""""
- S STR=STR_")"
- I $D(@STR) S @STR=@STR_X
- I '$D(@STR) S @STR=X
- Q STR
- ;
- ; 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 ""
- I VAL'["T" D Q VAL
- .S X=$E(VAL,1,10),X=$TR(X,"-","")
- .D ^%DT I 'Y S VAL="" Q
- .I $P(VAL,"-",4) S ETIME=$TR($P(VAL,"-",4),":","")
- .I $P(VAL,"+",2) S ETIME=$TR($P(VAL,"+",2),":","")
- .I '$G(ETIME) S VAL=Y Q
- .S VAL=Y_"."_ETIME
- 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
- ;
- CSERX() ; Determine if an Incoming eRx is for a Controlled Substance Medication or not
- ; Output: "1" (Controlled Substance) or "0" (Non-Controlled Substance)
- ;
- N DIGSIGVA
- S DIGSIGVA=$G(@GL@("DigitalSignature",0,"SignatureValue",0))
- I DIGSIGVA'="" Q 1
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXA1 13927 printed Jan 18, 2025@03:29:29 Page 2
- PSOERXA1 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**467,520,508,551,581,617,743**;DEC 1997;Build 24
- +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)
- +12 ; ERXVALS - code values for NIST codes
- +13 ; XML2 - structured sig from the medication prescribed segment
- +14 ; VADAT - DUZ^RXIEN
- INCERX(RES,XML,PRCHK,PACHK,DACHK,STATION,DIV,ERXHID,ERXVALS,XML2,VADAT) ;
- +1 NEW CURREC,FDA,EIEN,ERRTXT,ERRSEQ,PACNT,PASCNT,PAICN,PAIEN,VAINST,NPI,VAOI,VPATINST,NEWVAL
- +2 SET NPI=$PIECE($GET(DIV),U,2)
- +3 SET CURREC=$$PARSE(.XML,.ERXVALS,NPI,.XML2)
- +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 $DATA(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 IF $GET(DACHK("success"))="true"
- Begin DoDot:1
- +20 IF $GET(DACHK("IEN"))
- Begin DoDot:2
- +21 ;Saving the eRx Audit Log For Auto-Matched Drug
- +22 SET NEWVAL(1)=$$GET1^DIQ(50,DACHK("IEN"),.01)_" (NDC#: "_$$GETNDC^PSSNDCUT(DACHK("IEN"))_")"
- +23 DO AUDLOG^PSOERXUT(+CURREC,"DRUG",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
- +24 ;Setting Matched Drug and Auto Match info
- +25 SET FDA(52.49,CURREC,1.4)=1
- +26 SET FDA(52.49,CURREC,3.2)=DACHK("IEN")
- +27 SET FDA(52.49,CURREC,44)=1
- +28 SET VAOI=$$GET1^DIQ(50,DACHK("IEN"),2.1,"I")
- +29 SET VPATINST=$$GET1^DIQ(50.7,VAOI,7,"E")
- +30 IF $LENGTH(VPATINST)
- SET FDA(52.49,CURREC,27)=VPATINST
- End DoDot:2
- End DoDot:1
- +31 IF $GET(DACHK("success"))="false"
- Begin DoDot:1
- +32 SET ERRTXT=$GET(DACHK("error"))
- +33 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
- if 'ERRSEQ
- QUIT
- +34 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"D","E",ERRTXT)
- End DoDot:1
- +35 IF $GET(PRCHK("success"))="true"
- Begin DoDot:1
- +36 IF PRCHK("IEN")
- Begin DoDot:2
- +37 SET FDA(52.49,CURREC,1.2)=1
- +38 SET FDA(52.49,CURREC,2.3)=PRCHK("IEN")
- +39 ;Saving the eRx Audit Log for the Auto-Matched Provider
- +40 ; PSO*7*743
- SET NEWVAL(1)=$$GET1^DIQ(200,PRCHK("IEN"),.01)_" (DEA#: "_$PIECE($$VADEA^PSOERXU8(PRCHK("IEN"),CURREC),"^",2)_")"
- +41 DO AUDLOG^PSOERXUT(+CURREC,"PROVIDER",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
- End DoDot:2
- End DoDot:1
- +42 IF $GET(PRCHK("success"))="false"
- Begin DoDot:1
- +43 SET ERRTXT=$GET(PRCHK("error"))
- +44 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
- if 'ERRSEQ
- QUIT
- +45 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PR","E",ERRTXT)
- End DoDot:1
- +46 IF $GET(PACHK("MVIerror"))']""
- Begin DoDot:1
- +47 SET PAICN=+$PIECE($GET(PACHK("ICN")),"V")
- +48 IF PAICN
- Begin DoDot:2
- +49 SET (PAIEN,PACNT)=0
- FOR
- SET PAIEN=$ORDER(^DPT("AICN",PAICN,PAIEN))
- if 'PAIEN
- QUIT
- Begin DoDot:3
- +50 SET PACNT=PACNT+1
- +51 ; 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
- +52 IF $GET(PACNT)=1
- Begin DoDot:2
- +53 SET FDA(52.49,CURREC,1.6)=1
- +54 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("AICN",PAICN,0))
- End DoDot:2
- QUIT
- +55 IF $LENGTH(PACHK("ssn"))
- Begin DoDot:2
- +56 SET (PASCNT,PAIEN)=0
- FOR
- SET PAIEN=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),PAIEN))
- if 'PAIEN
- QUIT
- Begin DoDot:3
- +57 SET PASCNT=PASCNT+1
- End DoDot:3
- End DoDot:2
- +58 IF $GET(PASCNT)=1
- Begin DoDot:2
- +59 SET FDA(52.49,CURREC,1.6)=1
- +60 SET FDA(52.49,CURREC,.05)=$ORDER(^DPT("SSN",$TRANSLATE(PACHK("ssn"),"-",""),0))
- End DoDot:2
- QUIT
- End DoDot:1
- +61 IF $DATA(FDA)
- DO FILE^DIE(,"FDA")
- KILL FDA
- +62 ;
- +63 ;Saving the eRx Audit Log For Auto-Matched Patient
- +64 IF $GET(FDA(52.49,CURREC,.05))
- Begin DoDot:1
- +65 NEW DFN,VADM
- SET DFN=+FDA(52.49,CURREC,.05)
- DO DEM^VADPT
- +66 SET NEWVAL(1)=$$GET1^DIQ(2,DFN,.01)_" (L4SSN: "_$PIECE($PIECE(VADM(2),"^",2),"-",3)_" | DOB: "_$PIECE(VADM(3),"^",2)_")"
- +67 DO AUDLOG^PSOERXUT(+CURREC,"PATIENT",$$PROXYDUZ^PSOERXUT(),.NEWVAL)
- End DoDot:1
- +68 ;
- +69 IF $DATA(FDA)
- DO FILE^DIE(,"FDA")
- KILL FDA
- +70 IF $GET(PACHK("success"))="false"
- Begin DoDot:1
- +71 ; file e&e error
- +72 SET ERRTXT=$GET(PACHK("EandEerror"))
- IF ERRTXT]""
- Begin DoDot:2
- +73 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
- if 'ERRSEQ
- QUIT
- +74 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
- End DoDot:2
- +75 ; file mvi error
- +76 SET ERRTXT=$GET(PACHK("MVIerror"))
- IF ERRTXT]""
- Begin DoDot:2
- +77 SET ERRSEQ=$$ERRSEQ^PSOERXU1(EIEN)
- if 'ERRSEQ
- QUIT
- +78 DO FILERR^PSOERXU1(CURREC,ERRSEQ,"PA","E",ERRTXT)
- End DoDot:2
- End DoDot:1
- +79 SET RES="1^Erx Received."
- +80 QUIT
- PARSE(STREAM,ERXVALS,NPI,STREAM2) ;
- +1 NEW %XML,GL,VAINST,MTYPE,HUBDENY
- +2 SET GL=$NAME(^TMP($JOB,"PSOERXO1"))
- +3 KILL @GL
- +4 NEW STATUS,READER,XOBERR,S,ATTR,READER2,XOBERR2,STATUS2
- +5 SET STREAM=$TRANSLATE(STREAM,"^","")
- +6 IF $LENGTH(STREAM2)
- SET STREAM2=$TRANSLATE(STREAM2,"^","")
- +7 SET STATUS=##class(%XML.TextReader).ParseStream(STREAM,.READER,,,,,1)
- +8 IF $LENGTH(STREAM2)
- SET STATUS2=##class(%XML.TextReader).ParseStream(STREAM2,.READER2,,,,,1)
- +9 IF $$STATCHK^XOBWLIB(STATUS,.XOBERR,1)
- Begin DoDot:1
- +10 NEW BREAK
- +11 SET BREAK=0
- FOR
- if BREAK||READER.EOF||'READER.Read()
- QUIT
- Begin DoDot:2
- +12 NEW X,PUSHED,PARENT
- +13 IF READER.AttributeCount
- Begin DoDot:3
- +14 SET PARENT=READER.LocalName
- +15 DO SPUSH(.S,PARENT)
- SET PUSHED=1
- +16 FOR ATTR=1:1:READER.AttributeCount
- Begin DoDot:4
- +17 DO READER.MoveToAttributeIndex(ATTR)
- +18 IF READER.NodeType="attribute"
- DO APUT(.S,READER.Value,READER.LocalName)
- End DoDot:4
- End DoDot:3
- +19 IF READER.NodeType="element"
- IF '$GET(PUSHED)
- DO SPUSH(.S,READER.LocalName)
- +20 ; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
- +21 IF READER.NodeType="element"
- IF READER.IsEmptyElement
- DO SPUT(.S,"")
- +22 IF READER.NodeType="endelement"
- DO SPOP(.S,.X)
- +23 IF READER.NodeType="chars"
- DO SPUT(.S,READER.Value)
- End DoDot:2
- End DoDot:1
- +24 IF $DATA(STATUS2)
- Begin DoDot:1
- +25 IF $$STATCHK^XOBWLIB(STATUS2,.XOBERR2,1)
- Begin DoDot:2
- +26 NEW BREAK,S
- +27 SET BREAK=0
- FOR
- if BREAK||READER2.EOF||'READER2.Read()
- QUIT
- Begin DoDot:3
- +28 NEW X,PUSHED,PARENT
- +29 IF READER2.AttributeCount
- Begin DoDot:4
- +30 SET PARENT=READER2.LocalName
- +31 DO SPUSH(.S,PARENT)
- SET PUSHED=1
- +32 FOR ATTR=1:1:READER2.AttributeCount
- Begin DoDot:5
- +33 DO READER2.MoveToAttributeIndex(ATTR)
- +34 IF READER2.NodeType="attribute"
- DO APUT(.S,READER2.Value,READER2.LocalName)
- End DoDot:5
- End DoDot:4
- +35 IF READER2.NodeType="element"
- IF '$GET(PUSHED)
- DO SPUSH(.S,READER2.LocalName)
- +36 ; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
- +37 IF READER.NodeType="element"
- IF READER.IsEmptyElement
- DO SPUT(.S,"")
- +38 IF READER2.NodeType="endelement"
- DO SPOP(.S,.X)
- +39 IF READER2.NodeType="chars"
- DO SPUT(.S,READER2.Value)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +40 SET MTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))
- if MTYPE']""
- QUIT "0^Message type could not be identified."
- +41 IF '$LENGTH(NPI)
- SET NPI=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Identification",0,"NPI",0))
- +42 IF '$LENGTH(NPI)
- QUIT "0^Missing NPI. Institution could not be resolved. eRx not filed."
- +43 SET VAINST=$$FIND1^DIC(4,,"O",NPI,"ANPI")
- +44 IF '$GET(VAINST)
- QUIT "0^Institution could not be resolved. eRx not filed."
- +45 NEW NERXIEN,ERR,PATIEN
- +46 SET NERXIEN=$$HDR^PSOERXA3(MTYPE)
- +47 IF $PIECE(NERXIEN,U)<1
- QUIT NERXIEN
- +48 IF $GET(VAINST)
- SET FDA(52.49,NERXIEN_",",24.1)=VAINST
- DO FILE^DIE(,"FDA")
- KILL FDA
- +49 ; if message type is 'Error', do not try to file the other components.
- +50 IF MTYPE["Error"
- Begin DoDot:1
- +51 SET PATIEN=$$GETPAT^PSOERXU5(NERXIEN)
- if 'PATIEN
- QUIT
- +52 SET FDA(52.49,NERXIEN_",",.04)=PATIEN
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- QUIT NERXIEN
- +53 DO PAT(NERXIEN,MTYPE)
- DO BFC^PSOERXA5(NERXIEN)
- DO PHR^PSOERXA2(NERXIEN,MTYPE)
- DO PRE^PSOERXA2(NERXIEN,MTYPE)
- +54 DO MED^PSOERXA3(NERXIEN,.ERXVALS,MTYPE)
- DO OBS(NERXIEN,MTYPE)
- DO SUP^PSOERXA2(NERXIEN,MTYPE)
- +55 DO MEDDISP^PSOERXA5(NERXIEN,MTYPE)
- +56 IF MTYPE="RefillResponse"
- DO REFRESP^PSOERXA5(NERXIEN,MTYPE)
- +57 IF MTYPE["Cancel"
- Begin DoDot:1
- +58 SET HUBDENY=$PIECE(ERXHID,U,2)
- +59 DO CANRX^PSOERXA5(NERXIEN,MTYPE,HUBDENY,VAINST)
- End DoDot:1
- +60 ; facility/request have no where to go at this point in time??
- +61 DO FAC^PSOERXA2(NERXIEN)
- +62 QUIT NERXIEN
- +63 ;
- OBS(ERXIEN,MTYPE) ; Observation
- +1 NEW GL,I,LAST,DIM,MSOURCE,MUNIT,OBSDT,MVAL,OBSNOTE,OBSCNT,F,EIENS,FDA,MDQUAL
- +2 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Observation",0))
- +3 SET F=52.4914
- SET EIENS=ERXIEN_","
- +4 SET I=-1
- SET OBSCNT=0
- FOR
- SET I=$ORDER(@GL@("Measurement",I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 SET OBSCNT=OBSCNT+1
- SET FDA(F,"+1,"_EIENS,.01)=OBSCNT
- +6 SET DIM=$GET(@GL@("Measurement",I,"Dimension",0))
- SET FDA(F,"+1,"_EIENS,.02)=DIM
- +7 SET MDQUAL=$GET(@GL@("Measurement",I,"MeasurementDataQualifier",0))
- SET FDA(F,"+1,"_EIENS,.05)=MDQUAL
- +8 SET MSOURCE=$GET(@GL@("Measurement",I,"MeasurementSourceCode",0))
- SET FDA(F,"+1,"_EIENS,.06)=MSOURCE
- +9 SET MUNIT=$GET(@GL@("Measurement",I,"MeasurementUnitCode",0))
- SET FDA(F,"+1,"_EIENS,.07)=MUNIT
- +10 SET OBSDT=$GET(@GL@("Measurement",I,"ObservationDate",0,"Date",0))
- SET OBSDT=$$CONVDTTM^PSOERXA1(OBSDT)
- SET FDA(F,"+1,"_EIENS,.04)=OBSDT
- +11 SET MVAL=$GET(@GL@("Measurement",I,"Value",0))
- SET FDA(F,"+1,"_EIENS,.03)=MVAL
- +12 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +13 SET OBSNOTE=$GET(@GL@("ObservationNotes",0))
- SET FDA(52.49,EIENS,15)=OBSNOTE
- DO FILE^DIE(,"FDA")
- KILL FDA
- +14 QUIT
- PAT(ERXIEN,MTYPE) ; patient
- +1 NEW GL,AL1,AL2,CITY,STATE,ZIP,LN,FN,MN,PREF,SUFF,COMQUAL,COMVAL,PLQUAL,DOB,GEN,PRELATE,IDDONE,CDONE,I,C,CQUAL,CVAL
- +2 NEW IDNM,IDVAL,PFN,ERXPAT,NEWPAT,F,EIENS,FDA,IDFND,SRCH,PIENS,NPIEN,PATSSN,PREL,SIEN
- +3 SET F=52.46
- +4 SET EIENS=ERXIEN_","
- +5 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0))
- +6 SET PREL=$GET(@GL@("PatientRelationship",0))
- +7 SET FN=$$UP^XLFSTR($GET(@GL@("Name",0,"FirstName",0)))
- +8 SET LN=$$UP^XLFSTR($GET(@GL@("Name",0,"LastName",0)))
- +9 SET MN=$$UP^XLFSTR($GET(@GL@("Name",0,"MiddleName",0)))
- +10 SET PFN=LN_","_FN_$SELECT(MN]"":" "_MN,1:"")
- +11 SET SUFF=$$UP^XLFSTR($GET(@GL@("Name",0,"Suffix",0)))
- +12 SET PREF=$$UP^XLFSTR($GET(@GL@("Name",0,"Prefix",0)))
- +13 SET PRELATE=$GET(@GL@("PatientRelationship",0))
- +14 SET GEN=$GET(@GL@("Gender",0))
- +15 SET DOB=$GET(@GL@("DateOfBirth",0,"Date",0))
- SET DOB=$$CONVDTTM^PSOERXA1(DOB)
- +16 IF DOB<1
- SET DOB=""
- +17 SET AL1=$GET(@GL@("Address",0,"AddressLine1",0))
- +18 SET AL2=$GET(@GL@("Address",0,"AddressLine2",0))
- +19 SET CITY=$GET(@GL@("Address",0,"City",0))
- +20 SET STATE=$GET(@GL@("Address",0,"State",0))
- +21 SET ZIP=$GET(@GL@("Address",0,"ZipCode",0))
- +22 SET SIEN=$$STRES^PSOERXA2(ZIP,STATE)
- +23 ; need to check for SSN before trying to match the patient. This needs to be stored in an array for later processing
- +24 ; check 52.46 for a match before filing
- +25 SET PATSSN=$GET(@GL@("Identification",0,"SocialSecurity",0))
- +26 SET ERXPAT=$$FINDPAT^PSOERXU2(PFN,DOB,GEN,$GET(PATSSN),$GET(AL1))
- SET PIENS=$SELECT(ERXPAT:ERXPAT_",",1:"+1,")
- +27 ; first, lets set up the main part
- +28 SET FDA(F,PIENS,.01)=PFN
- SET FDA(F,PIENS,.02)=LN
- SET FDA(F,PIENS,.03)=FN
- SET FDA(F,PIENS,.04)=MN
- SET FDA(F,PIENS,.05)=SUFF
- SET FDA(F,PIENS,.06)=PREF
- +29 SET FDA(F,PIENS,.07)=GEN
- SET FDA(F,PIENS,.08)=DOB
- +30 SET FDA(F,PIENS,1.4)=PATSSN
- SET FDA(F,PIENS,1.7)=PREL
- +31 SET FDA(F,PIENS,3.1)=AL1
- SET FDA(F,PIENS,3.2)=AL2
- SET FDA(F,PIENS,3.3)=CITY
- +32 SET FDA(F,PIENS,3.4)=SIEN
- +33 SET FDA(F,PIENS,3.5)=ZIP
- +34 IF PIENS["+"
- Begin DoDot:1
- +35 DO UPDATE^DIE(,"FDA","NEWPAT")
- KILL FDA
- +36 SET NPIEN=$ORDER(NEWPAT(0))
- SET NPIEN=$GET(NEWPAT(NPIEN))
- +37 if 'NPIEN
- QUIT
- +38 SET NPIEN=NPIEN
- +39 DO PATC(NPIEN)
- +40 SET FDA(52.49,EIENS,.04)=NPIEN
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- QUIT
- +41 DO FILE^DIE(,"FDA")
- KILL FDA
- DO PATC(ERXPAT)
- +42 SET FDA(52.49,EIENS,.04)=ERXPAT
- DO FILE^DIE(,"FDA")
- KILL FDA
- +43 QUIT
- PATC(IEN) ; patient communication
- +1 NEW IENS,CQUAL,CVAL,COMARY,FDA,SRCH,IDFND,IDNM,IDVAL,IDARY,PATSSN
- +2 if 'IEN
- QUIT
- +3 SET IENS=IEN_","
- +4 ; Kill off existing communication values
- +5 KILL ^PS(52.46,IEN,3)
- +6 SET C=-1
- FOR
- SET C=$ORDER(@GL@("CommunicationNumbers",0,"Communication",C))
- if C=""
- QUIT
- Begin DoDot:1
- +7 SET CQUAL=$GET(@GL@("CommunicationNumbers",0,"Communication",C,"Qualifier",0))
- +8 SET CVAL=$GET(@GL@("CommunicationNumbers",0,"Communication",C,"Number",0))
- +9 SET COMARY(CQUAL)=CVAL
- +10 SET FDA(52.462,"+1,"_IENS,.01)=CVAL
- +11 SET FDA(52.462,"+1,"_IENS,.02)=CQUAL
- +12 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +13 ; kill existing identification values in multiple
- +14 KILL ^PS(52.46,IEN,5)
- +15 SET IDNM=""
- FOR
- SET IDNM=$ORDER(@GL@("Identification",0,IDNM))
- if IDNM=""
- QUIT
- Begin DoDot:1
- +16 SET IDVAL=$GET(@GL@("Identification",0,IDNM,0))
- +17 IF IDNM="SocialSecurity"
- SET PATSSN=IDVAL
- +18 SET IDARY(IDNM)=IDVAL
- +19 SET IDFND=0
- +20 SET SRCH=0
- FOR
- SET SRCH=$ORDER(^PS(52.46,IEN,5,SRCH))
- if 'SRCH
- QUIT
- Begin DoDot:2
- +21 IF $$GET1^DIQ(52.465,SRCH_","_IEN_",",.01)=IDNM
- Begin DoDot:3
- +22 SET IDFND=1
- +23 SET FDA(52.465,SRCH_","_IEN_",",.02)=IDVAL
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:3
- End DoDot:2
- +24 if IDFND
- QUIT
- +25 SET FDA(52.465,"+1,"_IEN_",",.01)=IDNM
- +26 SET FDA(52.465,"+1,"_IEN_",",.02)=IDVAL
- +27 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +28 IF $GET(PATSSN)]""
- SET FDA(52.46,IENS,1.4)=PATSSN
- DO FILE^DIE(,"FDA")
- KILL FDA
- +29 QUIT
- SPUSH(S,X) ;places X on the stack S and returns the current level of the stack
- +1 NEW I
- SET I=$ORDER(S(""),-1)+1
- SET S(I)=X
- +2 QUIT I
- +3 ;
- SPOP(S,X) ;removes the top item from the stack S and put it into the variable X and returns the level that X was at
- +1 NEW I
- SET I=$ORDER(S(""),-1)
- +2 IF I
- SET X=S(I)
- KILL S(I)
- +3 NEW J
- SET J=$ORDER(S(I),-1)
- IF J
- SET S(J,X)=$GET(S(J,X))+1
- +4 QUIT I
- +5 ;
- SPEEK(S,X) ;same as SPOP except the top item is not removed
- +1 NEW I
- SET I=$ORDER(S(""),-1)
- +2 IF I
- SET X=S(I)
- +3 QUIT I
- +4 ;
- SPUT(S,X) ;implementation specific, uses the stack to form a global node
- +1 NEW I,STR
- +2 SET X=$TRANSLATE(X,";","")
- +3 SET STR=$PIECE(GL,")")
- +4 SET I=0
- FOR
- SET I=$ORDER(S(I))
- if 'I
- QUIT
- Begin DoDot:1
- +5 SET STR=STR_","_""""_S(I)_""""_","
- +6 NEW NUM
- SET NUM=0
- +7 IF $DATA(S(I-1,S(I)))
- SET NUM=+$GET(S(I-1,S(I)))
- +8 SET STR=STR_NUM
- End DoDot:1
- +9 SET STR=STR_")"
- +10 IF $DATA(@STR)
- SET @STR=@STR_X
- +11 IF '$DATA(@STR)
- SET @STR=X
- +12 QUIT STR
- APUT(S,X,LN) ; what am i doing here?
- +1 NEW I,STR
- +2 SET X=$TRANSLATE(X,";","")
- +3 SET STR=$PIECE(GL,")")
- +4 SET I=0
- FOR
- SET I=$ORDER(S(I))
- if 'I
- QUIT
- Begin DoDot:1
- +5 SET STR=STR_","_""""_S(I)_""""_","
- +6 NEW NUM
- SET NUM="""A"""
- +7 SET STR=STR_NUM_","_""""_LN_""""
- End DoDot:1
- +8 SET STR=STR_")"
- +9 IF $DATA(@STR)
- SET @STR=@STR_X
- +10 IF '$DATA(@STR)
- SET @STR=X
- +11 QUIT STR
- +12 ;
- +13 ; VAL - value to resolve
- +14 ; 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 IF VAL'["T"
- Begin DoDot:1
- +4 SET X=$EXTRACT(VAL,1,10)
- SET X=$TRANSLATE(X,"-","")
- +5 DO ^%DT
- IF 'Y
- SET VAL=""
- QUIT
- +6 IF $PIECE(VAL,"-",4)
- SET ETIME=$TRANSLATE($PIECE(VAL,"-",4),":","")
- +7 IF $PIECE(VAL,"+",2)
- SET ETIME=$TRANSLATE($PIECE(VAL,"+",2),":","")
- +8 IF '$GET(ETIME)
- SET VAL=Y
- QUIT
- +9 SET VAL=Y_"."_ETIME
- End DoDot:1
- QUIT VAL
- +10 SET EDATE=$PIECE(VAL,"T")
- SET ETIME=$PIECE(VAL,"T",2)
- +11 ; split off time zone
- +12 SET ETZ=$PIECE(ETIME,".",2)
- +13 SET ETIME=$PIECE(ETIME,".")
- +14 SET X=EDATE
- DO ^%DT
- IF 'Y
- QUIT ""
- +15 SET VAL=Y_$SELECT($LENGTH(ETIME):"."_$TRANSLATE(ETIME,":",""),1:"")
- +16 QUIT VAL
+17 ;
CSERX() ; Determine if an Incoming eRx is for a Controlled Substance Medication or not
+1 ; Output: "1" (Controlled Substance) or "0" (Non-Controlled Substance)
+2 ;
+3 NEW DIGSIGVA
+4 SET DIGSIGVA=$GET(@GL@("DigitalSignature",0,"SignatureValue",0))
+5 IF DIGSIGVA'=""
QUIT 1
+6 QUIT 0