PSOERXI2 ;ALB/BWF - eRx Utilities/RPC's ; 11/8/2022 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
;
Q
PARSE(STREAM,ERXVALS,NPI,STREAM2,STREAM3) ;
N %XML,GL,VAINST,MTYPE,HUBDENY,PROHIBIT
S GL=$NA(^TMP($J,"PSOERXO1"))
K @GL
N STATUS,READER,XOBERR,S,ATTR,READER2,XOBERR2,STATUS2,READER3,STATUS3,XOBERR3
S STREAM=$TR(STREAM,"^","")
I $L(STREAM2) S STREAM2=$TR(STREAM2,"^","")
I $L(STREAM3) S STREAM3=$TR(STREAM3,"^","")
S STATUS=##class(%XML.TextReader).ParseStream(STREAM,.READER,,,,,1)
I $L(STREAM2) S STATUS2=##class(%XML.TextReader).ParseStream(STREAM2,.READER2,,,,,1)
I $L(STREAM3) S STATUS3=##class(%XML.TextReader).ParseStream(STREAM3,.READER3,,,,,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 READER2.NodeType="element",READER2.IsEmptyElement D SPUT(.S,"")
...I READER2.NodeType="endelement" D SPOP(.S,.X)
...I READER2.NodeType="chars" D SPUT(.S,READER2.Value)
; STREAM 3
I $D(STATUS3) D
.I $$STATCHK^XOBWLIB(STATUS3,.XOBERR3,1) D
..N BREAK,S
..S BREAK=0 F Q:BREAK||READER3.EOF||'READER3.Read() D
...N X,PUSHED,PARENT
...I READER3.AttributeCount D
....S PARENT=READER3.LocalName
....D SPUSH(.S,PARENT) S PUSHED=1
....F ATTR=1:1:READER3.AttributeCount D
.....D READER3.MoveToAttributeIndex(ATTR)
.....I READER3.NodeType="attribute" D APUT(.S,READER3.Value,READER3.LocalName)
...I READER3.NodeType="element",'$G(PUSHED) D SPUSH(.S,READER3.LocalName)
...; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
...I READER3.NodeType="element",READER3.IsEmptyElement D SPUT(.S,"")
...I READER3.NodeType="endelement" D SPOP(.S,.X)
...I READER3.NodeType="chars" D SPUT(.S,READER3.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(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
; NEW PARSING HERE
;potential BP - globals are populated
D ALLERGY^PSOERXID(NERXIEN,MTYPE),BENEFITS^PSOERXID(NERXIEN,MTYPE),FACILITY^PSOERXID(NERXIEN,MTYPE)
D PAT^PSOERXIA(NERXIEN,MTYPE),PHR^PSOERXIC(NERXIEN,MTYPE)
N IPR,IMTYP
F IPR="PR","S","FP" D
.D PRE^PSOERXIB(NERXIEN,MTYPE,IPR)
D OBSERV^PSOERXID(NERXIEN,MTYPE)
F IMTYP="MedicationDispensed","MedicationPrescribed","MedicationRequested" D
.D MEDS^PSOERXIE(NERXIEN,MTYPE,IMTYP)
I MTYPE="RxChangeResponse" D
.S PROHIBIT=$G(ERXVALS("PRRFlag"))
.;/JSG/ PSO*7.0*581 - BEGIN CHANGE (Fix PROHIBIT value)
.S FDA(52.49,NERXIEN_",",301.3)=$S(PROHIBIT="true":1,PROHIBIT="false":0,1:"")
.;/JSG/ - END CHANGE
.D FILE^DIE(,"FDA") K FDA
.D CHMESREQ^PSOERXIA(NERXIEN,MTYPE)
.D CHRESP^PSOERXA6(NERXIEN,MTYPE,VAINST)
.; AUTO PROCESSING OCCURS HERE
I MTYPE="RxChangeRequest" D
.D CHMESREQ^PSOERXIA(NERXIEN,MTYPE)
I MTYPE="RxRenewalResponse" D
.D MEDS^PSOERXIE(NERXIEN,MTYPE,"MedicationResponse")
.D REFRESP^PSOERXA5(NERXIEN,MTYPE)
I MTYPE["Cancel" D
.S HUBDENY=$P(ERXHID,U,2)
.D CANRX^PSOERXA5(NERXIEN,MTYPE,HUBDENY,VAINST)
Q NERXIEN
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."
; SCRIPT VERSION
N DTVER,ECLVER,STRUCTV,TRANDOM,TRANSVER,TPRTVER,SSDEV,SSPROD,SSVER
S DTVER=$G(^TMP($J,"PSOERXO1","Message","A","DatatypesVersion")),FDA(52.49,ERXIENS,313.1)=DTVER
S ECLVER=$G(^TMP($J,"PSOERXO1","Message","A","ECLVersion")),FDA(52.49,ERXIENS,313.2)=ECLVER
S STRUCTV=$G(^TMP($J,"PSOERXO1","Message","A","StructuresVersion")),FDA(52.49,ERXIENS,313.3)=STRUCTV
S TRANDOM=$G(^TMP($J,"PSOERXO1","Message","A","TransactionDomain")),FDA(52.49,ERXIENS,313.4)=TRANDOM
S TRANSVER=$G(^TMP($J,"PSOERXO1","Message","A","TransactionVersion")),FDA(52.49,ERXIENS,313.5)=TRANSVER
S TPRTVER=$G(^TMP($J,"PSOERXO1","Message","A","TransportVersion")),FDA(52.49,ERXIENS,313.6)=TPRTVER
; Set the 2017 script standard field to true
S FDA(52.49,ERXIENS,312.1)=1
; Sender software
;/JSG/ POS*7.0*581 - BEGIN CHANGE (Changed @GL...Developer to 3 separate fields)
S SSDEV=$G(@GL@("SenderSoftware",0,"SenderSoftwareDeveloper",0)),FDA(52.49,ERXIENS,314.1)=SSDEV
S SSPROD=$G(@GL@("SenderSoftware",0,"SenderSoftwareProduct",0)),FDA(52.49,ERXIENS,314.2)=SSPROD
S SSVER=$G(@GL@("SenderSoftware",0,"SenderSoftwareVersionRelease",0)),FDA(52.49,ERXIENS,314.3)=SSVER
;/JSG/ - END CHANGE
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)
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"!(MTCODE="CX") 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)
Q ERXIEN
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) ;
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"""
.;I $D(S(I-1,S(I))) S NUM=+$G(S(I-1,S(I)))
.;S STR=STR_NUM
.S STR=STR_NUM_","_""""_LN_""""
S STR=STR_")"
I $D(@STR) S @STR=@STR_X
I '$D(@STR) S @STR=X
Q STR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXI2 11328 printed Apr 09, 2024@21:29:17 Page 2
PSOERXI2 ;ALB/BWF - eRx Utilities/RPC's ; 11/8/2022 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
+2 ;
+3 QUIT
PARSE(STREAM,ERXVALS,NPI,STREAM2,STREAM3) ;
+1 NEW %XML,GL,VAINST,MTYPE,HUBDENY,PROHIBIT
+2 SET GL=$NAME(^TMP($JOB,"PSOERXO1"))
+3 KILL @GL
+4 NEW STATUS,READER,XOBERR,S,ATTR,READER2,XOBERR2,STATUS2,READER3,STATUS3,XOBERR3
+5 SET STREAM=$TRANSLATE(STREAM,"^","")
+6 IF $LENGTH(STREAM2)
SET STREAM2=$TRANSLATE(STREAM2,"^","")
+7 IF $LENGTH(STREAM3)
SET STREAM3=$TRANSLATE(STREAM3,"^","")
+8 SET STATUS=##class(%XML.TextReader).ParseStream(STREAM,.READER,,,,,1)
+9 IF $LENGTH(STREAM2)
SET STATUS2=##class(%XML.TextReader).ParseStream(STREAM2,.READER2,,,,,1)
+10 IF $LENGTH(STREAM3)
SET STATUS3=##class(%XML.TextReader).ParseStream(STREAM3,.READER3,,,,,1)
+11 IF $$STATCHK^XOBWLIB(STATUS,.XOBERR,1)
Begin DoDot:1
+12 NEW BREAK
+13 SET BREAK=0
FOR
if BREAK||READER.EOF||'READER.Read()
QUIT
Begin DoDot:2
+14 NEW X,PUSHED,PARENT
+15 IF READER.AttributeCount
Begin DoDot:3
+16 SET PARENT=READER.LocalName
+17 DO SPUSH(.S,PARENT)
SET PUSHED=1
+18 FOR ATTR=1:1:READER.AttributeCount
Begin DoDot:4
+19 DO READER.MoveToAttributeIndex(ATTR)
+20 IF READER.NodeType="attribute"
DO APUT(.S,READER.Value,READER.LocalName)
End DoDot:4
End DoDot:3
+21 IF READER.NodeType="element"
IF '$GET(PUSHED)
DO SPUSH(.S,READER.LocalName)
+22 ; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
+23 IF READER.NodeType="element"
IF READER.IsEmptyElement
DO SPUT(.S,"")
+24 IF READER.NodeType="endelement"
DO SPOP(.S,.X)
+25 IF READER.NodeType="chars"
DO SPUT(.S,READER.Value)
End DoDot:2
End DoDot:1
+26 IF $DATA(STATUS2)
Begin DoDot:1
+27 IF $$STATCHK^XOBWLIB(STATUS2,.XOBERR2,1)
Begin DoDot:2
+28 NEW BREAK,S
+29 SET BREAK=0
FOR
if BREAK||READER2.EOF||'READER2.Read()
QUIT
Begin DoDot:3
+30 NEW X,PUSHED,PARENT
+31 IF READER2.AttributeCount
Begin DoDot:4
+32 SET PARENT=READER2.LocalName
+33 DO SPUSH(.S,PARENT)
SET PUSHED=1
+34 FOR ATTR=1:1:READER2.AttributeCount
Begin DoDot:5
+35 DO READER2.MoveToAttributeIndex(ATTR)
+36 IF READER2.NodeType="attribute"
DO APUT(.S,READER2.Value,READER2.LocalName)
End DoDot:5
End DoDot:4
+37 IF READER2.NodeType="element"
IF '$GET(PUSHED)
DO SPUSH(.S,READER2.LocalName)
+38 ; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
+39 IF READER2.NodeType="element"
IF READER2.IsEmptyElement
DO SPUT(.S,"")
+40 IF READER2.NodeType="endelement"
DO SPOP(.S,.X)
+41 IF READER2.NodeType="chars"
DO SPUT(.S,READER2.Value)
End DoDot:3
End DoDot:2
End DoDot:1
+42 ; STREAM 3
+43 IF $DATA(STATUS3)
Begin DoDot:1
+44 IF $$STATCHK^XOBWLIB(STATUS3,.XOBERR3,1)
Begin DoDot:2
+45 NEW BREAK,S
+46 SET BREAK=0
FOR
if BREAK||READER3.EOF||'READER3.Read()
QUIT
Begin DoDot:3
+47 NEW X,PUSHED,PARENT
+48 IF READER3.AttributeCount
Begin DoDot:4
+49 SET PARENT=READER3.LocalName
+50 DO SPUSH(.S,PARENT)
SET PUSHED=1
+51 FOR ATTR=1:1:READER3.AttributeCount
Begin DoDot:5
+52 DO READER3.MoveToAttributeIndex(ATTR)
+53 IF READER3.NodeType="attribute"
DO APUT(.S,READER3.Value,READER3.LocalName)
End DoDot:5
End DoDot:4
+54 IF READER3.NodeType="element"
IF '$GET(PUSHED)
DO SPUSH(.S,READER3.LocalName)
+55 ; PSO*7*508 - if the type is an element, and is an empty element, put it in the global.
+56 IF READER3.NodeType="element"
IF READER3.IsEmptyElement
DO SPUT(.S,"")
+57 IF READER3.NodeType="endelement"
DO SPOP(.S,.X)
+58 IF READER3.NodeType="chars"
DO SPUT(.S,READER3.Value)
End DoDot:3
End DoDot:2
End DoDot:1
+59 SET MTYPE=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,""))
if MTYPE']""
QUIT "0^Message type could not be identified."
+60 IF '$LENGTH(NPI)
SET NPI=$GET(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Identification",0,"NPI",0))
+61 IF '$LENGTH(NPI)
QUIT "0^Missing NPI. Institution could not be resolved. eRx not filed."
+62 SET VAINST=$$FIND1^DIC(4,,"O",NPI,"ANPI")
+63 IF '$GET(VAINST)
QUIT "0^Institution could not be resolved. eRx not filed."
+64 NEW NERXIEN,ERR,PATIEN
+65 SET NERXIEN=$$HDR(MTYPE)
+66 IF $PIECE(NERXIEN,U)<1
QUIT NERXIEN
+67 IF $GET(VAINST)
SET FDA(52.49,NERXIEN_",",24.1)=VAINST
DO FILE^DIE(,"FDA")
KILL FDA
+68 ; if message type is 'Error', do not try to file the other components.
+69 IF MTYPE["Error"
Begin DoDot:1
+70 SET PATIEN=$$GETPAT^PSOERXU5(NERXIEN)
if 'PATIEN
QUIT
+71 SET FDA(52.49,NERXIEN_",",.04)=PATIEN
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
QUIT NERXIEN
+72 ; NEW PARSING HERE
+73 ;potential BP - globals are populated
+74 DO ALLERGY^PSOERXID(NERXIEN,MTYPE)
DO BENEFITS^PSOERXID(NERXIEN,MTYPE)
DO FACILITY^PSOERXID(NERXIEN,MTYPE)
+75 DO PAT^PSOERXIA(NERXIEN,MTYPE)
DO PHR^PSOERXIC(NERXIEN,MTYPE)
+76 NEW IPR,IMTYP
+77 FOR IPR="PR","S","FP"
Begin DoDot:1
+78 DO PRE^PSOERXIB(NERXIEN,MTYPE,IPR)
End DoDot:1
+79 DO OBSERV^PSOERXID(NERXIEN,MTYPE)
+80 FOR IMTYP="MedicationDispensed","MedicationPrescribed","MedicationRequested"
Begin DoDot:1
+81 DO MEDS^PSOERXIE(NERXIEN,MTYPE,IMTYP)
End DoDot:1
+82 IF MTYPE="RxChangeResponse"
Begin DoDot:1
+83 SET PROHIBIT=$GET(ERXVALS("PRRFlag"))
+84 ;/JSG/ PSO*7.0*581 - BEGIN CHANGE (Fix PROHIBIT value)
+85 SET FDA(52.49,NERXIEN_",",301.3)=$SELECT(PROHIBIT="true":1,PROHIBIT="false":0,1:"")
+86 ;/JSG/ - END CHANGE
+87 DO FILE^DIE(,"FDA")
KILL FDA
+88 DO CHMESREQ^PSOERXIA(NERXIEN,MTYPE)
+89 DO CHRESP^PSOERXA6(NERXIEN,MTYPE,VAINST)
+90 ; AUTO PROCESSING OCCURS HERE
End DoDot:1
+91 IF MTYPE="RxChangeRequest"
Begin DoDot:1
+92 DO CHMESREQ^PSOERXIA(NERXIEN,MTYPE)
End DoDot:1
+93 IF MTYPE="RxRenewalResponse"
Begin DoDot:1
+94 DO MEDS^PSOERXIE(NERXIEN,MTYPE,"MedicationResponse")
+95 DO REFRESP^PSOERXA5(NERXIEN,MTYPE)
End DoDot:1
+96 IF MTYPE["Cancel"
Begin DoDot:1
+97 SET HUBDENY=$PIECE(ERXHID,U,2)
+98 DO CANRX^PSOERXA5(NERXIEN,MTYPE,HUBDENY,VAINST)
End DoDot:1
+99 QUIT NERXIEN
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 ; SCRIPT VERSION
+19 NEW DTVER,ECLVER,STRUCTV,TRANDOM,TRANSVER,TPRTVER,SSDEV,SSPROD,SSVER
+20 SET DTVER=$GET(^TMP($JOB,"PSOERXO1","Message","A","DatatypesVersion"))
SET FDA(52.49,ERXIENS,313.1)=DTVER
+21 SET ECLVER=$GET(^TMP($JOB,"PSOERXO1","Message","A","ECLVersion"))
SET FDA(52.49,ERXIENS,313.2)=ECLVER
+22 SET STRUCTV=$GET(^TMP($JOB,"PSOERXO1","Message","A","StructuresVersion"))
SET FDA(52.49,ERXIENS,313.3)=STRUCTV
+23 SET TRANDOM=$GET(^TMP($JOB,"PSOERXO1","Message","A","TransactionDomain"))
SET FDA(52.49,ERXIENS,313.4)=TRANDOM
+24 SET TRANSVER=$GET(^TMP($JOB,"PSOERXO1","Message","A","TransactionVersion"))
SET FDA(52.49,ERXIENS,313.5)=TRANSVER
+25 SET TPRTVER=$GET(^TMP($JOB,"PSOERXO1","Message","A","TransportVersion"))
SET FDA(52.49,ERXIENS,313.6)=TPRTVER
+26 ; Set the 2017 script standard field to true
+27 SET FDA(52.49,ERXIENS,312.1)=1
+28 ; Sender software
+29 ;/JSG/ POS*7.0*581 - BEGIN CHANGE (Changed @GL...Developer to 3 separate fields)
+30 SET SSDEV=$GET(@GL@("SenderSoftware",0,"SenderSoftwareDeveloper",0))
SET FDA(52.49,ERXIENS,314.1)=SSDEV
+31 SET SSPROD=$GET(@GL@("SenderSoftware",0,"SenderSoftwareProduct",0))
SET FDA(52.49,ERXIENS,314.2)=SSPROD
+32 SET SSVER=$GET(@GL@("SenderSoftware",0,"SenderSoftwareVersionRelease",0))
SET FDA(52.49,ERXIENS,314.3)=SSVER
+33 ;/JSG/ - END CHANGE
+34 SET PONUM=$GET(@GL@("PrescriberOrderNumber",0))
+35 ; security receiver tertiary identification
+36 SET SRSID=$GET(@GL@("Security",0,"Receiver",0,"SecondaryIdentification",0))
+37 SET SRTID=$GET(@GL@("Security",0,"Receiver",0,"TertiaryIdentification,",0))
+38 ; security sender tertiary identification
+39 SET SSSID=$GET(@GL@("Security",0,"Sender",0,"SecondaryIdentification",0))
+40 SET SSTID=$GET(@GL@("Security",0,"Sender",0,"TertiaryIdentification,",0))
+41 ; convert senttime to file manager dt/tm
+42 SET SENTTIME=$GET(@GL@("SentTime",0))
SET SENTTIME=$$CONVDTTM^PSOERXA1(SENTTIME)
+43 SET RTMID=$GET(@GL@("RelatesToMessageID",0))
+44 SET RTHID=$PIECE(ERXHID,U,3)
+45 SET RTHIEN=""
+46 IF $LENGTH(RTHID)
SET RTHIEN=$ORDER(^PS(52.49,"FMID",RTHID,0))
+47 DO FIELD^DID(52.49,.08,"","POINTER","MTVALS")
+48 SET UPMTYPE=$$UP^XLFSTR(MTYPE)
+49 SET DONE=0
+50 FOR I=1:1
Begin DoDot:1
+51 SET COMPSTR=$PIECE(MTVALS("POINTER"),";",I)
+52 IF COMPSTR=""
SET DONE=1
QUIT
+53 IF COMPSTR[UPMTYPE
SET MTCODE=$PIECE(COMPSTR,":")
SET DONE=1
End DoDot:1
if DONE
QUIT
+54 IF $GET(MTCODE)']""
QUIT "0^Message type could not be resolved."
+55 SET FDA(52.49,ERXIENS,.08)=MTCODE
+56 ; erx hub message id
+57 SET FDA(52.49,ERXIENS,.01)=$PIECE(ERXHID,U)
+58 ; change healthcare message id
+59 SET FDA(52.49,ERXIENS,25)=FMID
+60 SET FDA(52.49,ERXIENS,.02)=RTMID
+61 SET FDA(52.49,ERXIENS,.03)=$$NOW^XLFDT
+62 SET FDA(52.49,ERXIENS,.09)=PONUM
+63 ;RELATES TO HUB ID
+64 SET FDA(52.49,ERXIENS,.14)=RTHID
+65 SET ERXISTAT=$$GETSTAT^PSOERXU2(MTCODE,RTHIEN,RTMID)
+66 SET FDA(52.49,ERXIENS,1)=ERXISTAT
+67 SET FDA(52.49,ERXIENS,22.1)=FROM
+68 SET FDA(52.49,ERXIENS,22.2)=FQUAL
+69 SET FDA(52.49,ERXIENS,22.3)=TO
+70 SET FDA(52.49,ERXIENS,22.4)=TQUAL
+71 SET FDA(52.49,ERXIENS,22.5)=SENTTIME
+72 SET FDA(52.49,ERXIENS,24.3)=SSSID
+73 SET FDA(52.49,ERXIENS,24.4)=SSTID
+74 SET FDA(52.49,ERXIENS,24.5)=SRSID
+75 SET FDA(52.49,ERXIENS,24.6)=SRTID
+76 ; Controlled Substance eRx
+77 SET FDA(52.49,ERXIENS,95.1)=$$CSERX^PSOERXA1()
+78 IF $$CSERX^PSOERXA1()
Begin DoDot:1
+79 SET FDA(52.49,ERXIENS,95.2)=$GET(@GL@("DigitalSignature",0,"DigestMethod",0))
+80 SET FDA(52.49,ERXIENS,95.3)=$GET(@GL@("DigitalSignature",0,"DigestValue",0))
+81 KILL SIGVAL
SET SIGVAL(1)=$GET(@GL@("DigitalSignature",0,"SignatureValue",0))
+82 SET FDA(52.49,ERXIENS,95.4)="SIGVAL"
+83 KILL X509DAT
SET X509DAT(1)=$GET(@GL@("DigitalSignature",0,"X509Data",0))
+84 SET FDA(52.49,ERXIENS,95.5)="X509DAT"
End DoDot:1
+85 ; if this is an existing record, file the updates to the erx and return the IEN
+86 DO UPDATE^DIE(,"FDA","NEWERX","EERR")
KILL FDA
+87 SET ERXIEN=""
+88 SET ERXIEN=$ORDER(NEWERX(0))
SET ERXIEN=$GET(NEWERX(ERXIEN))
+89 IF 'ERXIEN
QUIT ""
+90 IF $GET(RTHIEN)]""
Begin DoDot:1
+91 NEW REFREQ,NRXIEN
+92 SET NRXIEN=$$FINDNRX^PSOERXU6(ERXIEN)
+93 IF MTCODE="RE"!(MTCODE="CX")
Begin DoDot:2
+94 SET REFREQ=$$GETREQ^PSOERXU2(ERXIEN)
+95 IF REFREQ
SET NRXIEN=$$FINDNRX^PSOERXU6(REFREQ)
+96 IF $DATA(^PS(52.49,NRXIEN,201,"B",ERXIEN))
QUIT
+97 IF $GET(NRXIEN)
SET FDA2(52.49201,"+1,"_NRXIEN_",",.01)=ERXIEN
DO UPDATE^DIE(,"FDA2")
KILL FDA2
End DoDot:2
+98 ; link this message to the original
+99 IF $GET(NRXIEN)
Begin DoDot:2
+100 IF $DATA(^PS(52.49,NRXIEN,201,"B",ERXIEN))
QUIT
+101 SET FDA2(52.49201,"+1,"_NRXIEN_",",.01)=ERXIEN
DO UPDATE^DIE(,"FDA2")
KILL FDA2
End DoDot:2
+102 IF '$DATA(^PS(52.49,RTHIEN,201,"B",ERXIEN))
Begin DoDot:2
+103 SET FDA2(52.49201,"+1,"_RTHIEN_",",.01)=ERXIEN
DO UPDATE^DIE(,"FDA2")
KILL FDA2
End DoDot:2
+104 ; link original message to this erxien
+105 IF '$DATA(^PS(52.49,ERXIEN,201,"B",RTHIEN))
Begin DoDot:2
+106 SET FDA2(52.49201,"+1,"_ERXIEN_",",.01)=RTHIEN
DO UPDATE^DIE(,"FDA2")
KILL FDA2
End DoDot:2
End DoDot:1
+107 IF MTYPE["Error"
DO ERR^PSOERXU2(ERXIEN,MTYPE)
+108 QUIT ERXIEN
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) ;
+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 ;I $D(S(I-1,S(I))) S NUM=+$G(S(I-1,S(I)))
+8 ;S STR=STR_NUM
+9 SET STR=STR_NUM_","_""""_LN_""""
End DoDot:1
+10 SET STR=STR_")"
+11 IF $DATA(@STR)
SET @STR=@STR_X
+12 IF '$DATA(@STR)
SET @STR=X
+13 QUIT STR
