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