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

RAO7XX.m

Go to the documentation of this file.
  1. RAO7XX ;HISC/SS-Sending XX HL7 message to CPRS ;11/19/01 09:07
  1. ;;5.0;Radiology/Nuclear Medicine;**18,26,28,32,82**;Mar 16, 1998;Build 8
  1. ;Check if requested and registered procedures differ in:
  1. ; proc, requesting physician, proc mod(s)
  1. ;if there are changes - send XX message and return 1, otherwise 0
  1. ; called from RAREG2
  1. EN1(RAOIFN1) ;P18 entry point for "Register exams" and "Add to last visit" options
  1. K RAREGMOD
  1. Q:'$D(^RAO(75.1,RAOIFN1,0)) 0
  1. Q:'$D(^RAMIS(71,$P(^RAO(75.1,RAOIFN1,0),"^",2),0)) 0
  1. N RAPRTYPE S RAPRTYPE=$P(^RAMIS(71,$P(^RAO(75.1,RAOIFN1,0),"^",2),0),"^",6)
  1. Q:RAPRTYPE="P" 0 ;quit processing if parent proc, since RAREG2 treats an order, not each descendent of an order, thus no "XX" and no Alert
  1. I $$ISCHNGD(RAOIFN1,1)=0 Q 0 ;no changes or no OR*3*92
  1. CHCK N RAREGMOD S RAREGMOD="R" ;as a flag for registering mode
  1. I $$ORVR^RAORDU()'<3 D EN1^RAO7NEW(RAOIFN1) ;sends HL7 message
  1. Q 1 ;proc/reqphys/pmod was changed
  1. ;
  1. ;Can be used only for EXAMS that DO NOT contain Parent procedures
  1. ;ISSCHNGD Checks: Was original procedure changed?
  1. ;if proc/prc mod/rqstr changed, return 1 to syncrhonize with CPRS
  1. ;Usage: RAIEN751 recNo in 75.1 (like RAOIFN)
  1. ;if SNDALERT=1 sends alert to provider requested the order
  1. ;----------------
  1. ISCHNGD(RAIEN751,SNDALERT) ;P18
  1. N RACHANGE,RAX751,RAX70,RASTRING
  1. N RAD751 S RAD751=$G(^RAO(75.1,RAIEN751,0),-1),RASTRING=""
  1. Q:RAD751=-1 0
  1. N RAPAT S RAPAT=$P(RAD751,"^",1)
  1. N RAD70 S RAD70=$$FNDIN70(RAPAT,RAIEN751,"V")
  1. N RAD70SB S RAD70SB=$$FNDIN70(RAPAT,RAIEN751,"T")
  1. Q:RAD70=0 0
  1. N RAPR751 S RAPR751=$P(RAD751,"^",2) ;ien proc from order
  1. N RAPHYSID S RAPHYSID=$P(RAD751,"^",14) ;ien req phys
  1. S RAPR70=$P(RAD70,"^",2) ;ien proc from exam
  1. S RACHANGE=0
  1. I RAPR751'=RAPR70,(RAPRTYPE'="P") S RACHANGE=1,$P(RASTRING,"/",4,5)=RAPR751_"/"_RAPR70 ; nonparent,proc changed
  1. I RAPR751=RAPR70,(RAPRTYPE'="P") S $P(RASTRING,"/",4)=RAPR751 ;save unchanged proc name
  1. I RAPHYSID'=$P(RAD70,"^",14) S RACHANGE=1,$P(RASTRING,"/",6,7)=RAPHYSID_"/"_$P(RAD70,"^",14) ;req phy changed
  1. D STR751^RAUTL10(.RAX751,RAIEN751)
  1. D STR70^RAUTL10(.RAX70,RAPAT,$P(RAD70SB,"^"),$P(RAD70SB,"^",2))
  1. I RAX751'=RAX70 S RACHANGE=1,$P(RASTRING,"/",8,9)=RAX751_"/"_RAX70 ;proc mods changed
  1. Q:'RACHANGE 0
  1. S $P(RASTRING,"/",1,3)=RAPAT_"/"_$P(RAD70SB,"^")_"/"_$P(RAD70SB,"^",2) ;dfn,invdt,case ien
  1. S:$P(RASTRING,"/",6)="" $P(RASTRING,"/",6)=RAPHYSID ;recipient of msg
  1. I $G(SNDALERT,0)=1 D
  1. . I $$PATCH^XPDUTL("OR*3.0*112") D SETNOTIF^RAO7PC4(RAIEN751) Q
  1. . D SETALERT^RAO7PC4
  1. B1P18 Q:'$$PATCH^XPDUTL("OR*3.0*92") 0 ;CPRS patch not installed yet-return zero (do not send XX message).Alert has been sent above,because it should be sent anyway
  1. Q 1 ;one or more changes from orig order AND OR*3*92
  1. ;
  1. ;RAPT like RADFN
  1. ;RADT like RADTI
  1. ;RACSN like RACN
  1. ;If RARET="V" returns string value, otherwise - $Q of the node
  1. ;if failure returns "0"
  1. FNDIN70M(RAPT,RADT,RACSN,RARET) ;P18
  1. N RALV,RALFL
  1. S (RALV,RALFL)=0
  1. N RALVAR2,RAVAL2
  1. S RALV=$O(^RADPT(RAPT,"DT",RADT,"P","B",RACSN,0))
  1. Q:+RALV=0 0
  1. Q:RARET="V" $G(^RADPT(RAPT,"DT",RADT,"P",RALV,0),0)
  1. Q:RARET="T" RADT_"^"_RALV
  1. Q $Q(^RADPT(RAPT,"DT",RADT,"P",RALV))
  1. ;
  1. ;search for #70 entry using PATIEN and Order No from 75.1
  1. ;works correctly ONLY FOR ORDERS that do NOT contain PARENT PROCEDURE
  1. ;RETRN="V" returns value
  1. ;RETRN="T" returns D1^D2 of #70
  1. ;otherwise - $Q
  1. FNDIN70(RAPATN,RAORDN,RETRN) ;
  1. N RA18A,RA18B
  1. S RA18A=$O(^RADPT("AO",RAORDN,RAPATN,0))
  1. Q:RA18A="" 0
  1. S RA18B=$O(^RADPT("AO",RAORDN,RAPATN,RA18A,0))
  1. Q:RA18B="" 0
  1. Q:RETRN="V" $G(^RADPT(RAPATN,"DT",RA18A,"P",RA18B,0),0)
  1. Q:RETRN="T" RA18A_"^"_RA18B
  1. Q $Q(^RADPT(RAPATN,"DT",RA18A,"P",RA18B))
  1. Q
  1. ;
  1. ;
  1. UPDTRA0 ;P18 updates var RAO with data from file #70 and sets RAD70SB variable (D2^D3 of #70), called from RAO7NEW
  1. N RAD70
  1. S RAD70=0
  1. ;if registering mode (should not be parent procedure, so we can locate the exam in #70 by OrderN) - data and D2^D3 in #70 for the Order No
  1. S:RAREGMOD="R" RAD70=$$FNDIN70(+RA0,RAOIFN,"V"),RAD70SB=$$FNDIN70(+RA0,RAOIFN,"T")
  1. ;editing exam had called SVBEFOR, and thus RAPRIEN()s are defined
  1. S:RAREGMOD="E" RAD70=$G(^RADPT(RAPRIEN(1),"DT",RAPRIEN(2),"P",RAPRIEN(3),0)),RAD70SB=RAPRIEN(2)_"^"_RAPRIEN(3) S:+RAD70SB=0 RAD70SB=0 S:+RAD70=0 RAD70=0 ;041801 convert null to 0
  1. ; updating info
  1. I RAD70=0 S $P(RA0,"^",26)="" G ORCSET ; nature of new order activity
  1. S:$P(^RAMIS(71,+$P(RA0,"^",2),0),"^",6)'="P" $P(RA0,"^",2)=$P(RAD70,"^",2) ;OBR(4) reset prc only if not parent typ
  1. S $P(RA0,"^",9)=$P(RAD70,"^",9) ;Contract/Sharing Source
  1. S $P(RA0,"^",14)=$P(RAD70,"^",14) ; req phys ORC(12)
  1. ORCSET S $P(RA0,"^",15)=DUZ ;ORC(10)
  1. Q
  1. ;
  1. MODIF70(RA18D1,RA18D2) ;P18 uses data of Modifiers from #70 for OBR(18)
  1. I $O(^RADPT(+RA0,"DT",RA18D1,"P",RA18D2,"M",0)) D
  1. . S (A,RAXIT)=0
  1. . F S A=$O(^RADPT(+RA0,"DT",RA18D1,"P",RA18D2,"M",A)) Q:A'>0 D Q:RAXIT
  1. .. S B(0)=$G(^RADPT(+RA0,"DT",RA18D1,"P",RA18D2,"M",A,0))
  1. .. S B(1)=$P($G(^RAMIS(71.2,+B(0),0)),U)
  1. .. I $L(RA("OBR",18))+$L(B(1))>60 S RAXIT=1 Q
  1. .. S RA("OBR",18)=$G(RA("OBR",18))_B(1)_RAECH(2)
  1. .. Q
  1. . S RA("OBR",18)=$P(RA("OBR",18),RAECH(2),1,$L(RA("OBR",18),RAECH(2))-1)
  1. . Q
  1. Q
  1. SVBEFOR(RAPATN,RAINVDT,RACIEN) ;P18;send radfn,radti,racni (instead of racn and new sequencing of params
  1. D SVBEFOR^RAO7UTL(RAPATN,RAINVDT,RACIEN) Q
  1. ;Compare proc ien after editing
  1. CMPAFTR(SNDALERT) ;P18
  1. K RAREGMOD
  1. I $D(I) N I
  1. I $D(J) N J
  1. I $D(Y) N Y
  1. Q:'$D(RAPRIEN) 0 ;RAPRIEN must be defined by calling SVBEFOR
  1. N RADATA,RACHANGE,RAX,RA0,RA1,RA2,RA3,RASTRING,RAPRTYPE
  1. S RASTRING=""
  1. S RACHANGE=0 ;=1 if changed any of : proc, proc mod, req phys
  1. S RADATA=$G(^RADPT(RAPRIEN(1),"DT",RAPRIEN(2),"P",RAPRIEN(3),0))
  1. I RADATA="" G CMPEXIT
  1. I $P(RADATA,"^",11)="" G CMPEXIT ;can't process unknown proc type
  1. S RAPRTYPE=$P($G(^RAMIS(71,+$P($G(^RAO(75.1,+$P(RADATA,"^",11),0)),"^",2),0)),"^",6)
  1. I RAPRTYPE="P" G CMPEXIT ; if parent-type, skip both "XX" and Alert
  1. ; compare procedure if it's nonparent
  1. I $P(RADATA,"^",11),RAPRTYPE'="P",$P(RADATA,"^",2)'=RAPRIEN S RACHANGE=1,$P(RASTRING,"/",4,5)=RAPRIEN_"/"_$P(RADATA,"^",2) ;nonparent proc--changed
  1. I $P(RADATA,"^",11),RAPRTYPE'="P",$P(RADATA,"^",2)=RAPRIEN S $P(RASTRING,"/",4)=RAPRIEN ;save unchanged proc name
  1. ; compare req phys
  1. I $P(RADATA,"^",14)'=RAPRIEN(4) S RACHANGE=1,$P(RASTRING,"/",6,7)=RAPRIEN(4)_"/"_$P(RADATA,"^",14) ;req phy--changed
  1. ; compare proc mods
  1. D STR70^RAUTL10(.RAX,RAPRIEN(1),RAPRIEN(2),RAPRIEN(3))
  1. I RAPRIEN(5)'=RAX S RACHANGE=1,$P(RASTRING,"/",8,9)=RAPRIEN(5)_"/"_RAX ;proc mods-- changed
  1. I 'RACHANGE G CMPEXIT
  1. S $P(RASTRING,"/",1,3)=RAPRIEN(1)_"/"_RAPRIEN(2)_"/"_RAPRIEN(3)
  1. S:$P(RASTRING,"/",6)="" $P(RASTRING,"/",6)=RAPRIEN(4)
  1. ; set up of vars for call to XQALERT or to ORB3
  1. I $G(SNDALERT,0)=1 D
  1. . I $$PATCH^XPDUTL("OR*3.0*112") D SETNOTIF^RAO7PC4($P(RADATA,"^",11)) Q
  1. . D SETALERT^RAO7PC4
  1. B2P18 G:'$$PATCH^XPDUTL("OR*3.0*92") CMPEXIT
  1. ;if CPRS patch not installed-don't send any XX message.Checkpoint for all modes except registration,for registration mode see ISCHNGD.Alert has been sent above,because it should be sent anyway
  1. N RAREGMOD S RAREGMOD="E" ;edit mode
  1. I $$ORVR^RAORDU()'<3 D EN1^RAO7NEW($P(RADATA,"^",11))
  1. CMPEXIT ;
  1. ;Next lines are for RA*5*82
  1. G:$G(RACHANGE) QQQ ;If proc, proc mod, req phys changed quit 1
  1. S RAX=0 ;Quit 1 if CPT modifier changed or Tech comments changed
  1. F S RAX=$O(^RADPT(RAPRIEN(1),"DT",RAPRIEN(2),"P",RAPRIEN(3),"CMOD",RAX)) Q:'RAX I $G(RAPRIEN("CMOD",RAX))'=+$G(^(RAX,0)) S RACHANGE=1 Q
  1. G:$G(RACHANGE) QQQ ;
  1. S RAX=0
  1. F S RAX=$O(^RADPT(RAPRIEN(1),"DT",RAPRIEN(2),"P",RAPRIEN(3),"L",RAX)) Q:'RAX I $G(RAPRIEN("TCOM",RAX))'=$G(^(RAX,"TCOM")) S RACHANGE=1 Q
  1. QQQ K RAPRIEN Q RACHANGE
  1. ;End of RA*5*82 change
  1. Q ;OK
  1. ;In input templates the TECH COMMENT prompt should follow
  1. ;TECHNOILOGIST prompt but on the other hand it must be saved
  1. ;ONLY with other Activity log fields. That is why we call TCPROMPT
  1. ;from template after TECHNOLOGIST prompt and put the content of
  1. ;RA18TCOM in the file 70 only in the very end of editing
  1. TCPROMPT() ;called from input templates to immitate prompt
  1. N RA18A,RA18B,RA18C,DIR,Y,X,DA,DTOUT,DUOUT,DIRUT,DIROUT
  1. S RA18A="DESCRIPTION;HELP-PROMPT;INPUT TRANSFORM"
  1. D FIELD^DID(70.07,4,"",RA18A,"RA18B") ;field's parameters
  1. S DIR(0)="FO^3:255^"_RA18B("INPUT TRANSFORM")
  1. S DIR("?")=RA18B("HELP-PROMPT")
  1. S DIR("??")="^D DSCRP^RAO7XX"
  1. S DIR("A")=" TECHNOLOGIST COMMENT"
  1. S RA18C=$$GETTCOM^RAUTL11(RADFN,RADTI,RACNI)
  1. S:RA18C'="" DIR("B")=RA18C
  1. D ^DIR
  1. Q:Y=""!(Y=RA18C) ""
  1. Q Y
  1. ;
  1. DSCRP ;get field description
  1. N RA18D S RA18D=0
  1. F S RA18D=$O(RA18B("DESCRIPTION",RA18D)) Q:RA18D="" W !,RA18B("DESCRIPTION",RA18D)
  1. Q
  1. ZZ(RAPTID,RAPFIEN,RAPTIEN) ; Additional text for display when processing alert.
  1. ;
  1. S RAPTID=$G(RAPTID) ; IEN of Patient
  1. S RAPFIEN=$G(RAPFIEN) ; IEN of Procedure changed FROM
  1. S RAPTIEN=$G(RAPTIEN) ; IEN of Procedure changed TO
  1. ;
  1. N RAPNAM,RAPSSN,RAPRFR,RAPRTO
  1. ;
  1. S RAPNAM=$$GET1^DIQ(70,+RAPTID,.01) S:RAPNAM="" RAPNAM="UNKNOWN"
  1. S RAPSSN=$$GET1^DIQ(70,+RAPTID,.09) S:RAPSSN="" RAPSSN="UNKNOWN"
  1. S RAPRFR=$$GET1^DIQ(71,+RAPFIEN,.01) S:RAPRFR="" RAPRFR="UNKNOWN"
  1. S RAPRTO=$$GET1^DIQ(71,+RAPTIEN,.01) S:RAPRTO="" RAPRTO="UNKNOWN"
  1. ;
  1. D EN^DDIOL("Imaging Exam For "_$E(RAPNAM,1,30)_" ("_RAPSSN_") Changed:",,"!!?4")
  1. D EN^DDIOL("From: "_RAPRFR,,"!?8")
  1. D EN^DDIOL("To: "_RAPRTO,,"!?8")
  1. Q
  1. ;