source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCORMN.m@ 1036

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