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

RAO7RON1.m

Go to the documentation of this file.
  1. RAO7RON1 ;HISC/GJC,FPT-Request message from OE/RR. (frontdoor) ;19 Jun 2019 1:36 PM
  1. ;;5.0;Radiology/Nuclear Medicine;**69,75,98,129,158**;Mar 16, 1998;Build 2
  1. ;
  1. ;------------------------- Variable List -------------------------------
  1. ; RADATA=HL7 data minus seg. hdr RAHDR=Segment header
  1. ; RAHLFS="|" RAMSG=HL7 message passed in
  1. ; RAOBR12=danger code RAOBR18=modifier
  1. ; RAOBR19=Img. Loc. pntr (79.1) RAOBR30=trans. mode
  1. ; RAOBR31=Reason for Study RAOBX2=format of observ. value
  1. ; RAOBR4=univ. trans. mode RAOBX5=observ. value
  1. ; RAOBX3=observ. ID RAORC10=entered by (200
  1. ; RAORC1=order control RAORC15=order effective D/T
  1. ; RAORC12=ordering provider (200) RAORC2=placer order #_"^OR"
  1. ; RAORC16=order control reason RAORC7=start dt/freq. of service
  1. ; RAORC3=filler order #_"^RA" RAPID5=patient name (2)
  1. ; RAPID3=patient ID RAPV12=patient class
  1. ; RAPV119=visit # RASEG=message seg. including header
  1. ; RAPV13=patient location (44)
  1. ; ----------------------------------------------------------------------
  1. ;
  1. OBR ; breakdown the 'OBR' segment
  1. S RAOBR4=$P(RADATA,RAHLFS,4)
  1. F I=1:1:$L(RAOBR4,RAECH(1)) S RAOBR4(I)=$P(RAOBR4,RAECH(1),I)
  1. I RAOBR4(1)'="" S RACPTIEN=+$O(^ICPT("B",RAOBR4(1),0)) S:'RACPTIEN RAERR=8 Q:RAERR ;RA*5*69
  1. S RAERR=$$EN2^RAO7VLD(71,+RAOBR4(4),RAOBR4(5)) S:RAERR RAERR=8 Q:RAERR
  1. I $$UP^XLFSTR($P($G(^RAMIS(71,+RAOBR4(4),0)),"^",6))="P" D Q:RAERR
  1. . S RAERR=$$EN6^RAO7VLD(+RAOBR4(4)) S:RAERR RAERR=32
  1. . Q
  1. I RAOBR4(1)'="" S:'$D(^RAMIS(71,"D",RACPTIEN,+RAOBR4(4))) RAERR=8 Q:RAERR ;RA*5*69
  1. S RAOBR4(4,"I-TYPE")=+$P($G(^RAMIS(71,+RAOBR4(4),0)),"^",12)
  1. S RANEW(75.1,"+1,",2)=RAOBR4(4)
  1. S RAIT=$P(^RAMIS(71,+RAOBR4(4),0),U,12)
  1. S RAERR=$$EN3^RAO7VLD(79.2,RAIT) Q:RAERR
  1. S RANEW(75.1,"+1,",3)=RAIT
  1. S RAOBR12=$P(RADATA,RAHLFS,12)
  1. S RAOBR12=$S($E(RAOBR12)="":"n","yYiI"[$E(RAOBR12):"y",1:"n")
  1. S RAERR=$$EN1^RAO7VLD(75.1,24,"E",RAOBR12,"RASULT","") S:RAERR RAERR=10 Q:RAERR
  1. S RANEW(75.1,"+1,",24)=RAOBR12
  1. S RAOBR18=$P(RADATA,RAHLFS,18)
  1. N RAIMAG ;RASERIES removed w/RA5P158 by GJC
  1. F I=1:1:$L(RAOBR18,RAECH(2)) S:$L($P(RAOBR18,RAECH(2),I))>0 RAOBR18(I)=$P(RAOBR18,RAECH(2),I)
  1. S I=0 F S I=$O(RAOBR18(I)) Q:I'>0 D Q:RAERR
  1. . S RAMODIEN=+$O(^RAMIS(71.2,"B",RAOBR18(I),0))
  1. . S:'RAMODIEN RAERR=11 Q:RAERR
  1. . S RAIMAG=$P($G(^RAMIS(71,+RAOBR4(4),0)),U,12) ; type of imaging
  1. . S:'$D(^RAMIS(71.2,"AB",RAIMAG,RAMODIEN)) RAERR=33 Q:RAERR
  1. . ;S RASERIES=$S($P($G(^RAMIS(71,+RAOBR4(4),0)),"^",6)="S":1,1:0) RA5P158 by GJC
  1. . ;S:RASERIES&($P($G(^RAMIS(71.2,RAMODIEN,0)),U,2)]"") RAERR=34 Q:RAERR RA5P158 by GJC
  1. . S RAPLCHLD=RAPLCHLD+1
  1. . S RANEW(75.1125,"+"_RAPLCHLD_",+1,",.01)=RAMODIEN
  1. . Q
  1. S RAOBR19=$P(RADATA,RAHLFS,19),RAOBR19(1)=$P(RAOBR19,U,1)
  1. S RAOBR19(2)=$P(RAOBR19,U,2),RAOBR19(3)=+RAOBR19(1)
  1. I RAOBR19(3) D Q:RAERR
  1. . S RAOBR19(3,"I-TYPE")=+$P($G(^RA(79.1,+RAOBR19(3),0)),"^",6)
  1. . I RAOBR4(4,"I-TYPE")'=RAOBR19(3,"I-TYPE") S RAERR=31
  1. . Q
  1. S RANEW(75.1,"+1,",20)=$S(RAOBR19(3)>0:RAOBR19(3),1:"")
  1. S X=$P(RADATA,RAHLFS,30)
  1. S RAOBR30=$S(X="CART":"s",X="PORT":"p",X="WALK":"a",X="WHLC":"w",1:"")
  1. I RAOBR30']"" S RAERR=13
  1. S:'RAERR RAERR=$$EN1^RAO7VLD(75.1,19,"E",RAOBR30,"RASULT","")
  1. S:RAERR RAERR=13 Q:RAERR
  1. S RANEW(75.1,"+1,",19)=RAOBR30
  1. ;--- Reason for Study P75 ---
  1. ;CPRS will not pass 'Reason for Study' data until OR*3.0*243
  1. ;(GUI CPRS V27) is released. Define a default Reason for Study
  1. I '$$PATCH^XPDUTL("OR*3.0*243") S RAOBR31="See Clinical History:"
  1. E D Q:RAERR ;CPRS V27 is installed
  1. .S RAOBR31=$P($P(RADATA,RAHLFS,31),RAECH(1),2)
  1. .S:RAOBR31="" RAERR=38 Q:RAERR
  1. .S RAERR=$$EN1^RAO7VLD(75.1,1.1,"E",RAOBR31,"RASULT","")
  1. .S:RAERR RAERR=39
  1. .Q
  1. D CCS(.RAOBR31) ;P129 - strip CCs
  1. S:'RAERR RANEW(75.1,"+1,",1.1)=RAOBR31
  1. K RAOBR31
  1. Q
  1. OBX ; breakdown the 'OBX' segment
  1. S RAOBX2=$P(RADATA,RAHLFS,2)
  1. S RAERR=$S(RAOBX2="TX":0,RAOBX2="CE":0,RAOBX2="TS":0,1:1) Q:RAERR=17
  1. S RAOBX3=$P(RADATA,RAHLFS,3)
  1. S RAOBX5=$P(RADATA,RAHLFS,5)
  1. F I=1:1:$L(RAOBX3,RAECH(1)) S RAOBX3(I)=$P(RAOBX3,RAECH(1),I)
  1. S X=RAOBX3(2) D UPPER^RAUTL4 S RAOBX3(2)=Y
  1. ;
  1. ;P75 check to see if CLINICAL HISTORY data is passed. If data is passed, and not yet
  1. ;determined if valid continue to check for validity until:
  1. ;1-valid data is found
  1. ;2-no data left to validate
  1. I RAOBX3(1)=2000.02 D
  1. .;check if a null value is sent for CLINICAL HISTORY which is
  1. .;possible if the CPRS user does not enter a CLINICAL HISTORY
  1. .I RAOBX5="",$P(RACLIN,U)'=1 Q
  1. .;now if data was sent (RAOBX5'="") set the data received from CPRS flag
  1. .S $P(RACLIN,U)=1
  1. .;now that we know the CPRS user intended to send CLINICAL HISTORY data
  1. .;radiology has to validate the format of that data. $$EN4^RAO7VLD(str)
  1. .;returns 1 if the data passed in was valid, else 0. Once we establish
  1. .;that valid data has been sent, all subsequent data is accepted, valid
  1. .;or not.
  1. .S:$$EN4^RAO7VLD(RAOBX5) $P(RACLIN,U,2)=1
  1. .;now, if the current character string or any other character string
  1. .;of data representing the CLINICAL HISTORY has been accepted as valid
  1. .;($P(RACLIN,U,2)=1) save the character string
  1. .I $P(RACLIN,U,2)=1 D
  1. ..S RAWP=RAWP+1 D CCS(.RAOBX5) ;P129
  1. ..S ^TMP("RAWP",$J,RAWP)=RAOBX5
  1. ..Q
  1. ;
  1. I RAOBX3(1)=2000.33 D Q:RAERR
  1. .S RAERR=$$EN1^RAO7VLD(75.1,13,"E",RAOBX5,"RASULT","") S:RAERR RAERR=14 Q:RAERR
  1. .S RAPREG=$E(RAOBX5),RAPREG=$S(RAPREG="N"!(RAPREG="n"):"n",RAPREG="Y"!(RAPREG="y"):"y",1:"u")
  1. .S RANEW(75.1,"+1,",13)=RAPREG
  1. I RAOBX3(1)=34!(RAOBX2="CE") D Q:RAERR
  1. .S RAERR=$$EN2^RAO7VLD(34,$P(RAOBX5,RAECH(1)),$P(RAOBX5,RAECH(1),2)) Q:RAERR
  1. .S RANEW(75.1,"+1,",9)=+RAOBX5
  1. I RAOBX3(2)["RESEARCH" D S:RAERR RAERR=18 Q:RAERR
  1. .S RAERR=$$EN1^RAO7VLD(75.1,9.5,"E",RAOBX5,"RASULT","") S:RAERR RAERR=19 Q:RAERR
  1. .S RANEW(75.1,"+1,",9.5)=RAOBX5
  1. I RAOBX3(2)["PRE-OP" D Q:RAERR
  1. .S RAOBX5=$$FMDATE^HLFNC(RAOBX5)
  1. .S RAERR=$$EN1^RAO7VLD(75.1,12,"E",RAOBX5,"RASULT","") S:RAERR RAERR=20 Q:RAERR
  1. .S RANEW(75.1,"+1,",12)=RAOBX5
  1. I $D(RANEW(75.1,"+1,",9))&($D(RANEW(75.1,"+1,",9.5))) S RAERR=29
  1. Q
  1. ;
  1. CCS(RAX) ;does a string have unprintable
  1. ; control characters? If 'yes' strip them out.
  1. ;
  1. ;'RAX' the string checked for CCs (by reference)
  1. ;
  1. I RAX?.e1.c.e D Q
  1. .D SCC ;'RAX' is changed!
  1. .Q
  1. Q
  1. ;
  1. SCC ;strip out unprintable CCs.
  1. ;
  1. ;'RAX' the string w/unprintable CCs
  1. ;'RAE' is each character of 'RAX'
  1. K RAE,RAI S RAXX=""
  1. F RAI=1:1:$L(RAX) D
  1. .S RAE=$E(RAX,RAI)
  1. .S:RAE'?1C RAXX=RAXX_RAE K RAE
  1. .Q
  1. S RAX=RAXX
  1. K RAI,RAXX
  1. Q
  1. ;