Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMPRAD

PXRMPRAD.m

Go to the documentation of this file.
  1. PXRMPRAD ;SLC/AGP,RFR - Reminder Order Protocol Outgoing to Rad;10/13/2020
  1. ;;2.0;CLINICAL REMINDERS;**45,71**;Feb 04, 2005;Build 43
  1. Q
  1. ;ICR 586
  1. EN(MSG) ;
  1. N PXRMMSG,$ETRAP,$ESTACK
  1. S $ETRAP="G UNEXPERR^PXRMPRAD"
  1. S PXRMMSG=$S($L($G(MSG)):MSG,1:"MSG") Q:'$O(@PXRMMSG@(0))
  1. N APPL,BEGDATE,CNTRL,CODE,CODESYS,DATE,ENDDATE,ERROR,ITEMIEN,LOC,MATCH,MSH,NODE,OBR,ORDIEN,ORC,PAT,PID,PROV
  1. N PXRMXDT,PARAMS,RADID,RADNAME,REMIEN,TERMIEN,TERMARR,PKGIFN,OBX,DATA,EXIT
  1. S MSH=0 F S MSH=$O(@PXRMMSG@(MSH)) Q:MSH'>0 Q:$E(@PXRMMSG@(MSH),1,3)="MSH"
  1. I 'MSH D ERROR("Missing or invalid MSH segment",.ERROR) G ORX
  1. S APPL=$P(@PXRMMSG@(MSH),"|",5) I '$$VALIDAPL(APPL) G ORX
  1. D PID(.PXRMMSG,MSH,.PID,.PAT) I PAT'>0 D ERROR("Missing patient in HL7 message",.ERROR) G ORX
  1. S ORC=PID
  1. ;
  1. ORC ;process the ORC segments
  1. S MATCH=0
  1. F S ORC=$O(@PXRMMSG@(+ORC)) Q:ORC'>0 I $E(@PXRMMSG@(ORC),1,3)="ORC" D Q
  1. . S ORC=ORC_U_@PXRMMSG@(ORC),CNTRL=$TR($P(ORC,"|",2),"@","P")
  1. . I '$L(CNTRL) D ERROR("Invalid control code in HL7 message") Q
  1. . I '$$VALIDCTL(APPL,CNTRL) Q
  1. . ; figure out what to do with DC orders
  1. . I CNTRL="DC" Q
  1. . S ORDIEN=$P($P(ORC,"|",3),U),PKGIFN=$P($P(ORC,"|",4),U)
  1. . I ORDIEN,$D(^OR(100,+ORDIEN,0)),+$P(^(0),U,2)'=PAT D ERROR("Patient doesn't match between the Order and HL7 message",.ERROR) Q
  1. . S MATCH=1
  1. . S DATE=$P($G(^OR(100,+ORDIEN,0)),U,7),LOC=+$P($G(^OR(100,+ORDIEN,0)),U,10)
  1. . S PROV=$P($P(ORC,"|",11),U)
  1. I MATCH=0 G ORX
  1. S OBR=ORC
  1. ;
  1. OBR ;process the OBR segments
  1. F S OBR=$O(@PXRMMSG@(+OBR)) Q:OBR'>0 I $E(@PXRMMSG@(OBR),1,3)="OBR" D Q
  1. .S OBR=OBR_U_@PXRMMSG@(OBR)
  1. .S NODE=$P(OBR,"|",5) I NODE="" Q
  1. .S CODE=$P(NODE,U),CODESYS=$P(NODE,U,3)
  1. .S RADID=$P(NODE,U,4),RADNAME=$P(NODE,U,5)
  1. S ITEMTYPE=$$GETTYPE(APPL)
  1. I $G(CODESYS)="",CODE="",RADID'>0 Q
  1. ; safety check to pull code from radiology procedure if not defined in OI.
  1. I CODE="",RADID>0 S CODE=$$GET1^DIQ(71,RADID_",",9,"")
  1. D EVAL(PAT,RADID,ITEMTYPE,CODE,CODESYS,ORDIEN,PROV,$G(DATE),$G(LOC),.ERROR)
  1. ORX ;
  1. I $D(ERROR) D SENDERR(.ERROR)
  1. Q
  1. ;
  1. EPISODE(ITEM,START,DATE) ;
  1. I DATE'>0 S DATE=$$NOW^XLFDT()
  1. Q
  1. ;
  1. UNEXPERR ;unexpected error handler
  1. N ERROR
  1. D ERROR("An unexpected error was encountered: "_$$EC^%ZOSV,.ERROR)
  1. D SENDERR(.ERROR)
  1. D @^%ZOSF("ERRTN") ;file error
  1. S $ECODE=""
  1. Q ""
  1. ;
  1. ERROR(TEXT,ERROR) ;
  1. N CNT,DATA,INDEX
  1. S CNT=$O(ERROR("?"),-1)+1
  1. S ERROR(CNT,0)=TEXT,CNT=CNT+1
  1. S ERROR(CNT,0)="",CNT=CNT+1
  1. S ERROR(CNT,0)="The contents of the HL7 message that triggered this error:"
  1. D ACOPY^PXRMUTIL($S(PXRMMSG[U:$P(PXRMMSG,",")_")",1:"MSG"),"DATA()")
  1. S INDEX=0 F S INDEX=$O(DATA(INDEX)) Q:INDEX'>0 S CNT=CNT+1,ERROR(CNT,0)=DATA(INDEX)
  1. Q
  1. ;
  1. GETCODES(TXIEN,TNAME,TXARRAY) ;
  1. N CODE,CODESYS
  1. S CODESYS="" F S CODESYS=$O(^PXD(811.2,TXIEN,20,"AE",CODESYS)) Q:CODESYS="" D
  1. .I CODESYS'="CPT",CODESYS'="CPC" Q
  1. .S CODE="" F S CODE=$O(^PXD(811.2,TXIEN,20,"AE",CODESYS,CODE)) Q:CODE="" D
  1. ..S TXARRAY(CODE)=""
  1. Q
  1. ;
  1. GETTRMCD(TIEN,TXARRAY,TERMARR,ERROR) ;
  1. N TNAME,TXIEN
  1. S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U) I TNAME="" S ERROR="Reminder Term IEN #"_TIEN_" not found" Q
  1. D TERM^PXRMLDR(TNAME,.TERMARR) I $D(TERMARR("DNE")) S ERROR="Reminder Term "_TNAME_" not found" Q
  1. I '$D(TERMARR("E","PXD(811.2,")) S ERROR="Reminder Term "_TNAME_" does not contain a taxonomy" Q
  1. S TXIEN=0 F S TXIEN=$O(TERMARR("E","PXD(811.2,",TXIEN)) Q:TXIEN'>0 D GETCODES(TXIEN,TNAME,.TXARRAY)
  1. Q
  1. ;
  1. CHCKPROC(INPUT,ERROR) ;
  1. N CODE,CODESYS,DATE,ITEM,ITEMTYPE,MAX,RESULT,START,TEMPDATE,TERMARR,TERMLARR,TNAME,TXARRAY,TXIEN,X
  1. S CODE=$G(INPUT("CODE")),CODESYS=$G(INPUT("CODESYS"))
  1. S ITEM=$G(INPUT("ITEM")),ITEMTYPE=$G(INPUT("ITEMTYPE"))
  1. S RESULT=0
  1. ;F TNAME="VA-WH MAMMOGRAM SCREENING CODES","VA-WH MAMMOGRAM BILAT DIAGNOSTIC CODES","VA-WH MAMMOGRAM UNILAT DIAGNOSTIC CODES","VA-WH MRI OF THE BREASTS CODES","VA-WH ULTRASOUND OF THE BREAST CODES" D Q:$D(ERROR)!(+RESULT=1)
  1. S MAX=$$BLDTARR(.TERMLARR)
  1. F X=1:1:MAX D Q:$D(ERROR)!(+RESULT=1)
  1. .S TNAME=TERMLARR(X)
  1. .K TERMARR
  1. .S START=$S(TNAME="VA-WH MAMMOGRAM SCREENING CODES":1,TNAME="VA-WH BREAST TOMOSYNTHESIS SCREENING":1,1:0)
  1. .D TERM^PXRMLDR(TNAME,.TERMARR) I $D(TERMARR("DNE")) D ERROR("Reminder Term "_TNAME_" not found",.ERROR) Q
  1. .S DATE=$$EARLDATE^PXRMPRAD(.TERMARR) I +INPUT("DATE")>0,INPUT("DATE")<DATE Q
  1. .I CODE'="",CODESYS'="" D
  1. ..S TXIEN=0 F S TXIEN=$O(TERMARR("E","PXD(811.2,",TXIEN)) Q:TXIEN'>0 D GETCODES(TXIEN,TNAME,.TXARRAY)
  1. ..S RESULT=$S('$D(TXARRAY(CODE)):0_U_0,1:1_U_START)
  1. .I +RESULT=1 Q
  1. .I $G(ITEMTYPE)="" Q
  1. .I $G(ITEM)="" Q
  1. .I '$D(TERMARR("E",ITEMTYPE,ITEM)) Q
  1. .S RESULT=1_U_START
  1. Q RESULT
  1. ;
  1. BLDTARR(TERMARR) ;
  1. N CNT,PXRMERR,PXRMOUT,TIEN,TNAME,X
  1. S CNT=0
  1. D GETLST^XPAR(.PXRMOUT,"ALL","WV BREAST IMAGE TERM LINKING","Q",.PXRMERR)
  1. S X=0 F S X=$O(PXRMOUT(X)) Q:X'>0 D
  1. .S TIEN=+$P(PXRMOUT(X),U,2) Q:TIEN=0
  1. .S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U) Q:TNAME=""
  1. .S CNT=CNT+1,TERMARR(CNT)=TNAME
  1. ;S CNT=CNT+1,TERMARR(CNT)="VA-WH MAMMOGRAM SCREENING CODES"
  1. ;S CNT=CNT+1,TERMARR(CNT)="VA-WH MAMMOGRAM BILAT DIAGNOSTIC CODES"
  1. ;S CNT=CNT+1,TERMARR(CNT)="VA-WH MAMMOGRAM UNILAT DIAGNOSTIC CODES"
  1. ;S CNT=CNT+1,TERMARR(CNT)="VA-WH MRI BREASTS CODES"
  1. ;S CNT=CNT+1,TERMARR(CNT)="VA-WH ULTRASOUND BREAST CODES"
  1. ;S CNT=CNT+1,TERMARR(CNT)="VA-WH BREAST TOMOSYNTHESIS BILAT"
  1. ;S CNT=CNT+1,TERMARR(CNT)="VA-WH BREAST TOMOSYNTHESIS SCREENING"
  1. ;S CNT=CNT+1,TERMARR(CNT)="VA-WH BREAST TOMOSYNTHESIS UNILAT"
  1. Q CNT
  1. ;
  1. EARLDATE(TERMARR) ;
  1. N CNT,DATE,RESULT,TEMP
  1. S RESULT=0
  1. S CNT=0 F S CNT=$O(TERMARR(20,CNT)) Q:CNT'>0 D
  1. .S TEMP=$P(TERMARR(20,CNT,0),U,8) Q:TEMP=""
  1. .S DATE=$$CTFMD^PXRMDATE(TEMP)
  1. .I RESULT=0,DATE>0 S RESULT=DATE Q
  1. .I RESULT>0,DATE<RESULT S RESULT=DATE Q
  1. Q RESULT
  1. ;
  1. EVAL(PAT,ITEMIEN,ITEMTYPE,CODE,CODESYS,ORDIEN,PROV,DATE,LOC,ERROR) ;evaluation of a reminder
  1. N CNT,INPUT,MSG,START,VALUE
  1. S INPUT("CODE")=CODE,INPUT("CODESYS")=CODESYS,INPUT("ITEMTYPE")=ITEMTYPE,INPUT("ITEM")=ITEMIEN
  1. S INPUT("DATE")=DATE
  1. S VALUE=$$CHCKPROC(.INPUT,.ERROR)
  1. I +VALUE=0 Q
  1. S START=+$P(VALUE,U,2)
  1. D ADD^PXRMEOC(PAT,DATE,+ORDIEN_";OR(100,",START,0,"BREAST CARE",.MSG)
  1. I $D(MSG) D Q
  1. .D ERROR("UPDATE^DIE Error:",.ERROR)
  1. .S CNT=0 F S CNT=$O(MSG(CNT)) Q:CNT'>0 D ERROR(MSG(CNT),.ERROR)
  1. Q
  1. ;
  1. GETTYPE(APPL) ;
  1. I APPL="RADIOLOGY" Q "RAMIS(71,"
  1. Q ""
  1. ;
  1. SENDERR(ERROR) ;
  1. K ^TMP("PXRMXMZ",$J)
  1. M ^TMP("PXRMXMZ",$J)=ERROR
  1. D SEND^PXRMMSG("PXRMXMZ","Clinical Reminder Radiology HL7 listener.")
  1. K ^TMP("PXRMXMZ",$J)
  1. Q
  1. ;
  1. VALIDCTL(APPL,CNTRL) ;
  1. N RESULT
  1. S RESULT=0
  1. I APPL="RADIOLOGY" D Q RESULT
  1. .I CNTRL="NW" S RESULT=1 Q
  1. .I CNTRL="DC" S RESULT=1 Q
  1. Q RESULT
  1. ;
  1. VALIDAPL(APPL) ;
  1. I APPL="RADIOLOGY" Q 1
  1. Q 0
  1. ;
  1. PID(PXRMMSG,MSH,PID,PAT) ; -- Returns patient from PID segment in current msg
  1. N DFN,I,SEG S I=MSH,PID=""
  1. F S I=$O(@PXRMMSG@(I)) Q:I'>0 S SEG=$E(@PXRMMSG@(I),1,3) Q:SEG="ORC" I SEG="PID" D Q
  1. . S DFN=+$P(@PXRMMSG@(I),"|",4),PID=I
  1. . I $D(^DPT(DFN,0)) S PAT=DFN Q
  1. . S:$L($P(@PXRMMSG@(I),"|",5)) PAT=+$P(@PXRMMSG@(I),"|",5) ; alt ID for Lab
  1. Q