126 lines
5.2 KiB
Mathematica
126 lines
5.2 KiB
Mathematica
MCORMN ;WISC/DCB-Front-end for Health Summary ;4/26/04 11:54
|
|
;;1.0;CLINICAL PROCEDURES;**5,13**;Apr 01, 2004;Build 19
|
|
; Reference IA #1236 for Medicine and Health Summary interface.
|
|
; #3778 for Medicine and Health Summary interface for RDV
|
|
; #10070 for XMD API call.
|
|
; #10064 for XM call.
|
|
; #10090 DIC(4) Read Access.
|
|
; #10106 for HLFNC calls.
|
|
; #10113 for Access to ^XMB(3.9,#,2)
|
|
HL7(MESSNUMB) ;This is the HL7 entry point for queries
|
|
N MSH,TEMP,ORD,ST,MSTR,BDATE,EDATE,OCC,PROC,PATID,MCTDEC,XMZ,MCLINE
|
|
N QDT,QFC,QP,QID,RAP,GNODE,ATYPE
|
|
Q:+MESSNUMB=0 0
|
|
S GNODE="^XMB(3.9,"_MESSNUMB_",2)"
|
|
S MSH=$G(@GNODE@(1,0)) I MSH="" D ERROR Q 0
|
|
S MSTR=$E(MSH,4,9) D SLIP^MCORMN0(MSTR)
|
|
S QRD=$G(@GNODE@(2,0)) I QRD="" D ERROR Q 0
|
|
S QFC=$P(QRD,ST(1),3) I QFC'="R" D ERROR Q 0
|
|
S QLR=$P(QRD,ST(1),8),OCC=$P(QLR,ST(2),2),ATYPE=$P(QLR,ST(2),1)
|
|
S PATID=+$P(QRD,ST(1),9)
|
|
I '$D(^MCAR(690,"AC",PATID)) D ERROR Q ""
|
|
S PROC=$P(QRD,ST(1),11)
|
|
S TEMP=$P(QRD,ST(1),12) S BDATE=$P(TEMP,ST(2),1),EDATE=$P(TEMP,ST(2),2)
|
|
S BDATE=$$FMDATE^HLFNC(BDATE),EDATE=$$FMDATE^HLFNC(EDATE)
|
|
S RAP=$P(MSH,ST(1),3)
|
|
S MCTDEC="^TMP(""MCAR1"",$J)",GLOBAL=1
|
|
D HSUM(RAP,PATID,BDATE,EDATE,OCC,PROC,MSTR,MCTDEC,.GLOBAL,ATYPE)
|
|
I GLOBAL=0 S ^TMP("MCAR1",$J,1)="" Q 0
|
|
I GLOBAL'=0 D
|
|
.S XMSUB="Medicine Response",XMDUN="Medicine",XMDUZ=.5
|
|
.S XMTEXT="^TMP(""MCAR1"",$J,",XMY("G.MC MESSAGING SERVER")=""
|
|
.;S XMY(DUZ)=""
|
|
.D ^XMD
|
|
.S GLOBAL=+$G(XMZ)
|
|
D KILL^XM
|
|
K ^TMP("MCAR1",$J)
|
|
Q GLOBAL
|
|
ERROR ;HL7 Messaging Error
|
|
D KILL^XM Q
|
|
SERVER ;A do nothing routine
|
|
Q
|
|
HSUM(RAP,PATID,BDATE,EDATE,OCC,PE,MSTR,MCTDEC,GLOBAL,ATYPE) ;Sending Message Builder
|
|
N LOC,REC,RNF,SNF,SAP,MST,PCI,VID,MCDFN,TMP,ENDDATE,BEGDATE,MCIMAGE
|
|
N LOOP,DFN,COUNT,MCPROC,MCFILE,PREC,SENDATE,FILE,MCREC,MCDEST
|
|
N MCER,MCERR,MCVAL,TEMP,WH,S5
|
|
I +PATID'=PATID S GLOBAL=0 Q
|
|
I '$D(^MCAR(690,"AC",PATID))&('$D(^MDD(702,"B",PATID))) S GLOBAL=0 Q
|
|
I PE'="" D
|
|
.S S5=+$O(^MCAR(697.2,"B",PE,0))
|
|
.S S5=$P($G(^MCAR(697.2,S5,0)),U,2)
|
|
.I S5="" S PE="" K S5
|
|
S MCVAL=DUZ(2),REC=$$FIND1^DIC(4,"","X",MCVAL,"D","","MCER")
|
|
S LOC=$S(+REC:$$GET1^DIQ(4,+REC_",",.01),1:"")
|
|
S (RNF,SNF)=LOC
|
|
S SAP="Medicine",MST="HS",PCI="P"
|
|
S VID=$P($T(+2),";",3),MCDFN=PATID,MCLINE=0
|
|
S:EDATE="" EDATE=9999999.9999
|
|
S:BDATE="" BDATE=0
|
|
S:+OCC=0 OCC=999999
|
|
I EDATE<BDATE S TEMP=EDATE,EDATE=BDATE,BDATE=TEMP
|
|
S ENDDATE=(9999999.9999-EDATE)-.00001
|
|
S BEGDATE=(9999999.9999-BDATE)+.00001
|
|
S LOOP=ENDDATE,COUNT=0
|
|
N L,LL,LL1,K,M,PE,REC,S1,S2,S4,S6
|
|
N MCARCODE,MCARFILE,MCARPSUM,MCARSUM,MCESKEY,MCESON,MCSUP,MCESSEC
|
|
S MCIMAGE=""
|
|
K ^TMP("MCAR",$J)
|
|
S DFN=PATID,WH="P" D ^MCARPS1
|
|
PROCN ;
|
|
N MCRESULT,MDHOLDR,MCROU
|
|
I $$PATCH^XPDUTL("MD*1.0*2")!('$$FIND1^DIC(9.4,"","MX","MEDICINE")) D
|
|
.S MDRDV=1 K ^TMP("MDPLST",$J)
|
|
.S MCRESULT=$NA(^TMP("MDPLST",$J)) N MCLP,MCLP1,MCXG
|
|
.S MCROU="D GET702^MDPS3(.MCRESULT,PATID,"""",BDATE,EDATE,OCC)"
|
|
.X MCROU
|
|
.S MCLP="" F S MCLP=$O(^TMP("MDPLST",$J,MCLP)) Q:MCLP="" S MCLP1="" F S MCLP1=$O(^TMP("MDPLST",$J,MCLP,MCLP1)) Q:MCLP1="" S MCXG=$G(^(MCLP1)) D
|
|
..S:$G(^TMP("MCAR",$J,MCLP,MCLP1))="" ^TMP("MCAR",$J,MCLP,MCLP1)=MCXG
|
|
.K ^TMP("MDPLST",$J)
|
|
S MCPROC="",COUNT=0 N MCG
|
|
F S MCPROC=$O(^TMP("MCAR",$J,MCPROC)) Q:MCPROC="" D
|
|
.S MCDTIME=ENDDATE
|
|
.F S MCDTIME=$O(^TMP("MCAR",$J,MCPROC,MCDTIME)) Q:MCDTIME="" Q:COUNT'<OCC Q:MCDTIME>BEGDATE S MCG=$G(^(MCDTIME)) D
|
|
..S MCREC=$P(MCG,U,2) Q:+MCREC=0
|
|
..S MCDEST=MCTDEC,SENDATE=9999999.9999-MCDTIME,MDHOLDR=MCPROC
|
|
..I +$G(BDATE) Q:SENDATE<+$G(BDATE)
|
|
..I +$G(EDATE) Q:SENDATE>+$G(EDATE)
|
|
..I $P(MCG,U,4)["MDPS1" S MCARGDA=+$P(MCG,U,2) Q:'MCARGDA D PR690 S COUNT=COUNT+1,MCPROC=MDHOLDR Q
|
|
..I $P(MCG,U,4)["MDPS4" S MCARGDA=+$P(MCG,U,2) Q:'MCARGDA D PR690 S COUNT=COUNT+1,MCPROC=MDHOLDR Q
|
|
..S PREC=$O(^MCAR(697.2,"B",MCPROC,"")) Q:PREC=""
|
|
..S FILE=$P($G(^MCAR(697.2,PREC,0)),U,2) Q:FILE=""
|
|
..S MCFILE=+$P(FILE,"MCAR(",2)
|
|
..S MCERR=$$BUILD^MCORMN0(RAP,DFN,SAP,SNF,RNF,MST,PCI,VID,.MCLINE,MSTR,MCDEST,MCPROC,MCFILE,MCREC,SENDATE,ATYPE)
|
|
..S:MCERR=0 COUNT=COUNT+1
|
|
K ^TMP("MCAR",$J),^TMP("MDPTXT",$J),MCPRO,MCARPPS,MCARGRTN,MDT,MDHDR,MDRDV
|
|
Q
|
|
PR690 ; Set node for CP Reports
|
|
N HLECH,MCRREC,ST
|
|
S MCPRO=$P(MCG,U,11),MCARPPS=$P(MCG,U,3,4),MCARGRTN=$P(MCG,U,5),MDT="RD",MDHDR=1
|
|
S HLECH=$E(MSTR,2,4) D SLIP^MCORMN0(MSTR)
|
|
D SETNODE(MCDEST,$$MSH^MCORMN01(MCPROC,SAP,SNF,RAP,RNF,MST,PCI,VID))
|
|
D SETNODE(MCDEST,$$PID^MCORMN01(MCDFN))
|
|
D SETNODE(MCDEST,$$OBR1(SENDATE,MCPROC,HLECH))
|
|
D SETNODE(MCDEST,$$OBX1^MCORMN01("W","ST","702~.1~702.1^^DD",1,""))
|
|
D @MCARPPS S MCRREC=$NA(^TMP("MDPTXT",$J))
|
|
F S MCRREC=$Q(@MCRREC) Q:MCRREC="" Q:$QS(MCRREC,1)'="MDPTXT" D
|
|
.D SETNODE(MCTDEC,$G(@MCRREC))
|
|
D SETNODE(MCDEST,"||")
|
|
Q
|
|
OBR1(SDATE,MCPROC,HLECH) ; OBX Messaging Line
|
|
N LOOP,TEMP,TMP,STAT,STR
|
|
S TMP="OTH"
|
|
S STAT="COMPLETE"
|
|
S TEMP=$$CONVERT^MCORMN01("D",SDATE),STR="OBR",$P(STR,ST(1),8)=TEMP
|
|
S $P(STR,ST(1),16)=TMP,$P(STR,ST(1),26)=STAT
|
|
Q STR
|
|
SETNODE(NODE,VALUE) ; Set the node with the HL7 message string
|
|
S MCLINE=MCLINE+1,@NODE@(MCLINE,0)=VALUE
|
|
Q
|
|
HL1(MCSAP,MCDFN,MCB,MCE,MCOCC,MCTYP) ; Alternate Entry Point for Data View
|
|
N MSH,TEMP,ORD,ST,MSTR,BDATE,EDATE,OCC,PROC,PATID,MCTDEC,XMZ,MCLINE
|
|
N QDT,QFC,QP,QID,RAP,GNODE,ATYPE
|
|
S GLOBAL=1 K ^TMP("MCAR1",$J)
|
|
D HSUM(MCSAP,MCDFN,MCB,MCE,MCOCC,"","|^~\&|","^TMP(""MCAR1"",$J)",.GLOBAL,MCTYP)
|
|
I GLOBAL=0 S ^TMP("MCAR1",$J,1,0)=""
|
|
Q
|