- 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 Dec 13, 2024@01:48:35 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