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

RAO7RO.m

Go to the documentation of this file. 
  1. RAO7RO ;HISC/GJC,FPT-Request message from OE/RR. ;9/11/98  11:56
  1.  ;;5.0;Radiology/Nuclear Medicine;**1,2,13,15,75**;Mar 16, 1998;Build 4
  1.  ;
  1.  ;------------------------- Variable List -------------------------------
  1.  ; RAFLG=flag indicates ORC reached     RAHLFS="|"
  1.  ; RAMSG=HL7 message passed in          RAORD=ORC-1 (Order control)
  1.  ; RAPLCHLD=Tracks place holder values for adding entries to sub-files
  1.  ;          in the Rad/Nuc Med Orders file.
  1.  ; RASEG=specific HL7 node              X=subscript of HL7 node
  1.  ; ----------------------------------------------------------------------
  1.  ;
  1. EN1(RAMSG) ; Pass in the message from OE/RR.  Decipher information.
  1.  ; new variables for RAO7RO processing
  1.  N A,AAH,ARR,CHAR,CNT,DFN,ERR,FLG,GMTSTYP,I,J,L,LEN,MSG,RA,RA0
  1.  N RA7003,RA71,RA713,RA783,RAA,RAB,RAC,RACLIN,RACMCODE,RACMNOR
  1.  N RACNT,RACOST,RACPT,RACPTIEN,RAD0,RADATA,RADBS,RADC,RADFN,RADUZ
  1.  N RAECH,RAEMSG,RAERR,RAFDA,RAFLG,RAFNAME,RAFNUM,RAHDR,RAHLFS
  1.  N RAIEN71,RAIL,RAIMGAB,RAIMGTYI,RAINCR,RAION,RAIT,RALDT,RALINEX,RALOC
  1.  N RAMFE,RAMODIEN,RAMSH3,RAMULT,RANEW,RANOW,RANSTAT,RAOBR18,RAOBR19
  1.  N RAOBR30,RAOBR4,RAOBX2,RAOBX3,RAOBX5,RAOIFN,RAORC1,RAORC10,RAORC11
  1.  N RAORC12,RAORC15,RAORC16,RAORC2,RAORC3,RAORC7,RAORC7D,RAORC7P
  1.  N RAORD,RAPGE,RAPLCHLD,RAPREG,RAPHYAP,RAPID3,RAPID5,RAPRCTY
  1.  N RAPV119,RAPV12,RAPV13,RAREA,RARMBED,RASEG,RASTATUS,RASUB
  1.  N RATSTMP,RAVAR,RAWARD,RAWP,RAX,RAXIT,RAXT71,RAY,RAZ,T1,T2,T3
  1.  N VAIP,X,Y,Y1,Y2,Y3,Y4,Y5,Z,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1.  S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP")
  1.  S (RAFLG,X)=0,RAPLCHLD=1
  1.  D EN1^RAO7UTL ; setup field seperator data (see var list)
  1.  S RALDT=$$NOW^XLFDT() ; setup 'Last Activity Date/Time'
  1.  F  S X=$O(RAMSG(X)) Q:X'>0  D  Q:RAFLG
  1.  . S RASEG=$G(RAMSG(X)) Q:$P(RASEG,RAHLFS)'="ORC"  ; quit if not ORC
  1.  . S RAORD=$P(RASEG,RAHLFS,2),RAFLG=1
  1.  . Q
  1.  I RAORD'="NW"&(RAORD'="DC")&(RAORD'="NA")&(RAORD'="DE")&(RAORD'="Z@") D BRKOUT^RAO7UTL1,REJ^RAO7OKS("OC","Missing/Invalid Order Control") Q
  1.  I RAORD="NW" D EN1^RAO7RON(.RAMSG) D
  1.  .I $G(RAERR) D  Q
  1.  ..S RAERR1="" I RAERR=35 I $G(RANOW) S RAERR1="Now="_RANOW
  1.  ..I RAERR=35 S RAERR1=RAERR1_" Req Entered Dt="_$G(RAORC15)
  1.  ..S RAERR=$$EN1^RAO7RO1(RAERR)_" "_$G(RAERR1) K RAERR1
  1.  ..D REJ^RAO7OKS("OC",RAERR) Q
  1.  .;if CLINICAL HISTORY was passed from CPRS and it failed the CLINICAL HISTORY data
  1.  .;requirements, reject the message
  1.  .I $P(RACLIN,U)=1,$P(RACLIN,U,2)'=1 S RAERR=$$EN1^RAO7RO1(15) D REJ^RAO7OKS("OC",RAERR) Q
  1.  .K ERR
  1.  .; Update 'REQUEST STATUS TIMES' multiple if parameter dictates!
  1.  .I "Yy"[RADIV(.119) D
  1.  ..; make sure that the activity log place holders differ from the
  1.  ..; modifiers place holders
  1.  ..S RAPLCHLD=RAPLCHLD+1
  1.  ..S RANEW(75.12,"+"_RAPLCHLD_",+1,",.01)=RALDT
  1.  ..S RANEW(75.12,"+"_RAPLCHLD_",+1,",2)=5
  1.  ..S RANEW(75.12,"+"_RAPLCHLD_",+1,",3)=+RAORC10
  1.  ..Q
  1.  .D UPDATE^DIE("","RANEW","RAORC3","ERR") S RAORC3=+$G(RAORC3(1))
  1.  .S RAORC3=$G(RAORC3)_"^RA"
  1.  .I $D(ERR) S RAERR=$$EN1^RAO7RO1(21) D REJ^RAO7OKS("OC",RAERR) Q
  1.  .D WP^DIE(75.1,+RAORC3_",",400,"K","^TMP(""RAWP"",$J)","ERR")
  1.  .D ACC^RAO7OKS("OK","","","","")
  1.  .; Prt request on im'g loc req prtr; if no im'g loc on the HL7 msg
  1.  .; check for prtr on first entry in Im'g Loc file; if no prtr on
  1.  .; first entry, don't print request
  1.  . S RAO751=$G(^RAO(75.1,+RAORC3,0))
  1.  . D:$P(RAO751,"^",6)=1!($P(RAO751,"^",6)=2) OENO^RAUTL19(+RAORC3)
  1.  . K RAO751 ; fire off 'stat' or 'urgent' alert if order qualifies
  1.  . ; print the request
  1.  . I +RAOBR19(3)>0 S RAION=$P($G(^RA(79.1,+RAOBR19(3),0)),U,16)
  1.  . ;I +RAOBR19(3)=0 S RAION=$P($G(^RA(79.1,+$O(^RA(79.1,0)),0)),U,16)
  1.  . I +RAOBR19(3)=0 D  S:RAION="" RAION=$P($G(^RA(79.1,+$O(^RA(79.1,0)),0)),U,16)
  1.  .. S (RALOC,RAION)=""
  1.  .. ; Get Imaging Type of Procedure..
  1.  .. S RAIMGTYI=$P(^RAMIS(71,RAOBR4(4),0),U,12) Q:RAIMGTYI=""
  1.  .. F  S RALOC=$O(^RA(79.1,"BIMG",RAIMGTYI,RALOC)) Q:RALOC=""  D  Q:RAION]""
  1.  ... ; Find Imaging Location within Imaging Type with Request device..
  1.  ... Q:$P(^RA(79.1,RALOC,0),U,16)=""
  1.  ... Q:^RA(79.1,RALOC,"DIV")'=+$$KSP^XUPARAM("INST")
  1.  ... S RAION=$P(^RA(79.1,RALOC,0),U,16)
  1.  . I RAION]"" D
  1.  .. D PSETUP Q:RAION']""
  1.  .. S ZTDTH=$H,ZTRTN="PRHS^RAO7RO",ZTIO=RAION
  1.  .. S ZTDESC="Rad/Nuc Med Request print - frontdoor (CPRS)"
  1.  .. D ^%ZTLOAD,HOME^%ZIS
  1.  .. K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1.  .. Q
  1.  . Q
  1.  ;
  1.  I RAORD="Z@" N RAPUROK D EN2^RAO7PURG(.RAMSG) D  ; RAPUROK set in
  1.  . ; EN2^RAO7PURG.  If RAPUROK=1 send ok msg, else send reject msg
  1.  . I $G(RAERR) D REJ^RAO7OKS("ZU","") Q
  1.  . D:'RAPUROK REJ^RAO7OKS("ZU","")
  1.  . D:RAPUROK ACC^RAO7OKS("ZR","","","","")
  1.  . Q
  1.  I RAORD="DC" D EN1^RAO7RCH(.RAMSG) D
  1.  .I $G(RAERR) S RAERR=$$EN1^RAO7RO1(RAERR) D REJ^RAO7OKS("UD",RAERR) Q
  1.  .K ERR D FILE^DIE("K","RANEW","ERR")
  1.  .I $D(ERR) S RAERR=$$EN1^RAO7RO1(37) D REJ^RAO7OKS("UD",RAERR) Q
  1.  .D OE3^RABUL(+RAORC3) ; rad/nuc med request cancelled bulletin
  1.  .I "Yy"[RADIV(.119) D  Q:$G(RAERR)
  1.  ..N ERR
  1.  ..S ERR=$$EN5^RAO7VLD(+RAORC3,1,+RAORC10,"")
  1.  ..I +$G(ERR) S RAERR=$$EN1^RAO7RO1(30) D REJ^RAO7OKS("UD",RAERR) Q
  1.  ..Q
  1.  .D ACC^RAO7OKS("DR","","","","")
  1.  .; print out the cancelled request
  1.  .S RAIMJLOC=+$P($G(^RAO(75.1,+RAORC3,0)),"^",20)
  1.  .I RAIMJLOC>0 S RAION=$P($G(^RA(79.1,RAIMJLOC,0)),U,24)
  1.  .I RAIMJLOC=0 S RAION=$P($G(^RA(79.1,+$O(^RA(79.1,0)),0)),U,24)
  1.  .I RAION]"" D
  1.  ..D PSETUP Q:RAION']""
  1.  ..S RACRHD="" ; set the cancelled request flag
  1.  ..S ZTDESC="Rad/Nuc Med Cancelled Request print - frontdoor (CPRS)"
  1.  ..S ZTIO=RAION,ZTDTH=$H,ZTRTN="PRHS^RAO7RO",ZTSAVE("RACRHD")=""
  1.  ..D ^%ZTLOAD,HOME^%ZIS
  1.  ..K RACRHD,RAIMJLOC,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ;For an order control of: 'NA', we error if one of these three
  1.  ;conditions are true:
  1.  ;1) if the ien of the Rad/Nuc Med Order is not valid
  1.  ;2) patient file pointer (PID3) evaluates to a different
  1.  ;   patient name than the PID5 value
  1.  ;3) cannot file oerr order ien into file 75.1
  1.  ;
  1.  I RAORD="NA" D EN1^RAO7OKR(.RAMSG) I $G(RAERR) D
  1.  . N RATXT S RATXT="Error for order control: 'NA'"
  1.  . S:RAERR'?1N.N RAERR="error not found in our error table"
  1.  . S:RAERR?1N.N RAERR=$$EN1^RAO7RO1(RAERR)
  1.  . S:$D(XQY0)#2 RAVAR("XQY0")="" S RAVAR("RAERR")=""
  1.  . D ERR^RAO7UTL(RATXT,.RAMSG,.RAVAR)
  1.  . Q
  1.  ;if order control of 'DE', CPRS files data into their OE/RR Errors file
  1.  ;I RAORD="DE"
  1.  ;purge DBS specific variables before exiting
  1.  ;
  1. PURGE ; kill & quit
  1.  D CLEAN^DILF
  1.  K ^TMP("RAWP",$J)
  1.  Q
  1. PRHS ; print request and/or health summary
  1.  U IO D ^RAORD5 ; print the request
  1.  S:'$D(RACRHD) GMTSTYP=$P($G(^RAMIS(71,+$G(RAOBR4(4)),0)),U,13)
  1.  I +$G(GMTSTYP) D  ; don't print Health Summary with cancelled requests
  1.  . W:$Y @IOF D ENX^GMTSDVR(RADFN,GMTSTYP)
  1.  . Q
  1.  W ! D CLOSE^RAUTL
  1.  Q
  1. PSETUP ; Define the variables needed to print cancelled and non-cancelled
  1.  ; requests from the frontdoor (CPRS).
  1.  I RAION'?1N.N S RAION=$O(^%ZIS(1,"B",RAION,0)) Q:RAION']""
  1.  S RAION=$P($G(^%ZIS(1,RAION,0)),"^") Q:RAION']""
  1.  S RAOIFN=+RAORC3,RAPAGE=0,RAX="",RADFN=RAPID3
  1.  N RAFOERR S RAFOERR="" ; flag to indicate entry from frontdoor (CPRS)
  1.  F RAI="RADFN","RAOIFN","RAX","RAPGE","RAOBR4(","RAFOERR" S ZTSAVE(RAI)=""
  1.  S:$D(RAIL) ZTSAVE("RAIL")=""
  1.  Q