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

RAMAG03C.m

Go to the documentation of this file. 
  1. RAMAG03C ;HCIOFO/SG - ORDERS/EXAMS API (REGISTR. UTILS) ; 06 Oct 2013  11:03 AM
  1.  ;;5.0;Radiology/Nuclear Medicine;**90,47,1005**;Mar 16, 1998;Build 13
  1.  ;
  1.  Q
  1.  ;
  1.  ;+++++ CREATES AN EXAM IN THE RAD/NUC MED PATIENT (#70)
  1.  ;
  1.  ; Input variables:
  1.  ;   RADFN, RADTE, RADTI, RAEXMVAL, RAIMGTYI, RALOCK, RAMDIV,
  1.  ;   RAMISC, RAMLC, RAOIFN, RAPARENT, RAPRLST, RASACN31
  1.  ;
  1.  ; Output variables:
  1.  ;   ^TMP($J,"RAREG1",...), RALOCK
  1.  ;
  1.  ; Return values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;        0  Success
  1.  ;
  1.  ; NOTE: This is an internal entry point. Do not call it from
  1.  ;       routines other than the ^RAMAG03.
  1.  ;
  1. EXAM() ;
  1.  Q:$D(RAPRLST)<10 0
  1.  N IENS,RACN,RACASE,RACRM,RAFDA,RAIENS,RAIP,RAMOS,RAMSG,RAPROC,RARC,TMP
  1.  K ^TMP($J,"RAREG1")  S RARC=0
  1.  S RAMOS=$S('$G(RAPARENT):"",$G(RAMISC("SINGLERPT")):2,1:1)
  1.  ;
  1.  ;=== Create the date/time record if necessary
  1.  S TMP=$$ROOT^DILFD(70.02,","_RADFN_",",1)
  1.  I '$D(@TMP@(RADTI))  D  Q:RARC<0 RARC
  1.  . S IENS="+1,"_RADFN_","
  1.  . S RAFDA(70.02,IENS,.01)=RADTE         ; EXAM DATE
  1.  . S RAFDA(70.02,IENS,2)=RAIMGTYI        ; TYPE OF IMAGING
  1.  . S RAFDA(70.02,IENS,3)=RAMDIV          ; HOSPITAL DIVISION
  1.  . S RAFDA(70.02,IENS,4)=+RAMLC          ; IMAGING LOCATION
  1.  . S:$G(RAPARENT) RAFDA(70.02,IENS,5)=1  ; EXAM SET
  1.  . S RAIENS(1)=RADTI
  1.  . D UPDATE^DIE(,"RAFDA","RAIENS","RAMSG")
  1.  . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.02,IENS)
  1.  ;
  1.  ;=== Get the credit method from the imaging location
  1.  S RACRM=$$GET1^DIQ(79.1,+RAMLC_",",21,"I",,"RAMSG")
  1.  Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,79.1,+RAMLC_",")
  1.  ;
  1.  ;=== Register individual case(s)
  1.  S RAIP=0
  1.  F  S RAIP=$O(RAPRLST(RAIP))  Q:RAIP'>0  D  Q:RARC<0
  1.  . S RAPROC=RAPRLST(RAIP)  K RAFDA,RAIENS,RAMSG
  1.  . ;--- Generate a case number
  1.  . S RACN=$$CASENUM^RAMAG03D(RADTE)
  1.  . I RACN<0  S RARC=RACN  Q
  1.  . ;--- Prepare the data
  1.  . S IENS="+1,"_RADTI_","_RADFN_","
  1.  . S RAFDA(70.03,IENS,.01)=RACN                  ; CASE NUMBER
  1.  . S RAFDA(70.03,IENS,2)=+RAPROC                 ; PROCEDURE
  1.  . S RAFDA(70.03,IENS,4)=RAMISC("EXAMCAT")       ; CATEGORY OF EXAM
  1.  . S RAFDA(70.03,IENS,6)=$G(RAMISC("WARD"))      ; WARD
  1.  . S RAFDA(70.03,IENS,7)=$G(RAMISC("SERVICE"))   ; SERVICE
  1.  . S RAFDA(70.03,IENS,8)=$G(RAMISC("PRINCLIN"))  ; PRINCIPAL CLINIC
  1.  . S RAFDA(70.03,IENS,11)=RAOIFN                 ; IMAGING ORDER
  1.  . S RAFDA(70.03,IENS,19)=$G(RAMISC("BEDSECT"))  ; BEDSECTION
  1.  . S RAFDA(70.03,IENS,25)=RAMOS                  ; MEMBER OF SET
  1.  . S RAFDA(70.03,IENS,26)=RACRM                  ; CREDIT METHOD
  1.  . ;---Pregnancy Screen and Pregnancy Screen Comment for female pt ages 12-55
  1.  . ;IHS/BJI/DAY - Patch 1005 - Gender Fix
  1.  . ;I $$PTSEX^RAUTL8(RADFN)="F",(($$PTAGE^RAUTL8(RADFN,"")>11)!($$PTAGE^RAUTL8(RADFN,"")<56)) D
  1.  . I $$PTSEX^RAUTL8(RADFN)'="M",$$PTAGE^RAUTL8(RADFN,"")>11,$$PTAGE^RAUTL8(RADFN,"")<56 D
  1.  .. ;
  1.  .. S RAFDA(70.03,IENS,32)="u"
  1.  .. S RAFDA(70.03,IENS,80)="OUTSIDE STUDY"
  1.  . ;--- SITE ACCESSION NUMBER
  1.  . S:$G(RASACN31) RAFDA(70.03,IENS,31)=$$ACCNUM^RAMAGU04(RADTE,RACN)
  1.  . ;--- CLINICAL HISTORY FOR EXAM
  1.  . S TMP=$NA(RAMISC("CLINHIST"))
  1.  . S:$D(@TMP)>1 RAFDA(70.03,IENS,400)=TMP
  1.  . ;--- Values from the order
  1.  . M RAFDA(70.03,IENS)=RAEXMVAL
  1.  . ;--- Add the record
  1.  . D UPDATE^DIE(,"RAFDA","RAIENS","RAMSG")
  1.  . I $G(DIERR)  S RARC=$$DBS^RAERR("RAMSG",-9,70.03,IENS)  Q
  1.  . S RACASE=RADFN_U_RADTI_U_RAIENS(1)
  1.  . ;--- Add to the list
  1.  . S ^TMP($J,"RAREG1",RAIP)=RACASE_U_RAOIFN
  1.  . ;--- Procedure modifiers
  1.  . S $P(IENS,",")=RAIENS(1)
  1.  . S RARC=$$PROCMOD(IENS,RAPROC)  Q:RARC<0
  1.  . ;---Study Instance UID (70.03; 81)
  1.  . D SIUID($P(IENS,",")) ;where IENS is RACNI,RADTI,RADFN,
  1.  . I $G(DIERR)  S RARC=$$DBS^RAERR("RAMSG",-9,70.03,IENS)  Q
  1.  . ;--- Exam status
  1.  . S RARC=$$UPDEXMST^RAMAGU05(RACASE,"^^1")  Q:RARC<0
  1.  . ;--- Activity log
  1.  . S TMP=$G(RAMISC("TECHCOMM"))
  1.  . S RARC=$$UPDEXMAL^RAMAGU05(RACASE,"E",TMP)  Q:RARC<0
  1.  ;
  1.  ;===
  1.  Q $S(RARC<0:RARC,1:0)
  1.  ;
  1.  ;+++++ PERFORMS EXAM POST-PROCESSING
  1.  ;
  1.  ; .RAEXAMS      Reference to a local array where identifiers of
  1.  ;               registered examination(s) are returned to.
  1.  ;
  1.  ; RADTE         Actual date/time of the exam (FileMan)
  1.  ;
  1.  ; Input variables:
  1.  ;   RASACN31, ^TMP($J,"RAREG1",...)
  1.  ;
  1.  ; Return values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;      '<0  Number of registered examinations
  1.  ;           (number of elements in the RAEXAMS array)
  1.  ;
  1. POSTPROC(RAEXAMS,RADTE) ;
  1.  N IENS,RABUF,RACASE,RACN,RACNI,RADFN,RADTI,RAEXMCNT,RAI,RAMSG,RAOIFN
  1.  S RAEXMCNT=0  K RAEXAMS
  1.  ;===
  1.  S RAI=0
  1.  F  S RAI=$O(^TMP($J,"RAREG1",RAI))  Q:RAI'>0  D
  1.  . S RACASE=^TMP($J,"RAREG1",RAI)  K RABUF,RAMSG
  1.  . S RADFN=$P(RACASE,U),RADTI=$P(RACASE,U,2)
  1.  . S RACNI=$P(RACASE,U,3),RAOIFN=$P(RACASE,U,4)
  1.  . S IENS=$$EXAMIENS^RAMAGU04(RACASE)
  1.  . ;--- Exam identifiers
  1.  . S RACN=$$GET1^DIQ(70.03,IENS,.01,"I",,"RAMSG")
  1.  . S $P(RACASE,U,4)=RACN                          ; Case number
  1.  . I $G(RASACN31)  D                              ; Accession number
  1.  . . S $P(RACASE,U,5)=$$GET1^DIQ(70.03,IENS,31,"I",,"RAMSG")
  1.  . E  S $P(RACASE,U,5)=$$ACCNUM^RAMAGU04(RADTE,RACN,"S")
  1.  . S $P(RACASE,U,6)=RADTE                         ; Exam date/time
  1.  . S RAEXMCNT=RAEXMCNT+1,RAEXAMS(RAEXMCNT)=RACASE
  1.  . ;--- Execute RA REG* protocols
  1.  . D REG^RAHLRPC
  1.  . ;--- Remove from the list
  1.  . K ^TMP($J,"RAREG1",RAI)
  1.  ;===
  1.  Q RAEXMCNT
  1.  ;
  1.  ;+++++ STORES PROCEDURE MODIFIERS
  1.  ;
  1.  ; IENS7003      IENS of the exam in the sub-file #70.03
  1.  ;
  1.  ; RAPROC        Radiology procedure and modifiers
  1.  ;                 ^01: Procedure IEN in file #71
  1.  ;                 ^02: Optional procedure modifiers (IENs in
  1.  ;                 ...  the PROCEDURE MODIFIERS file (#71.2))
  1.  ;                 ^nn:
  1.  ;
  1.  ; Return values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;        0  Success
  1.  ;
  1.  ; NOTE: This is an internal entry point. Do not call it from
  1.  ;       outside of this routine.
  1.  ;
  1. PROCMOD(IENS7003,RAPROC) ;
  1.  N I,IENS,LP,RAFDA,RAMSG,RAPMCNT,RARC,TMP
  1.  S (RAPMCNT,RARC)=0
  1.  ;--- Prepare the data
  1.  S LP=$L(RAPROC,U)
  1.  F I=2:1:LP  S TMP=$P(RAPROC,U,I)  D:TMP'=""
  1.  . S RAPMCNT=RAPMCNT+1,IENS="+"_RAPMCNT_","_IENS7003
  1.  . S RAFDA(70.1,IENS,.01)="`"_TMP
  1.  ;--- Store procedure modifiers
  1.  D:RAPMCNT>0
  1.  . D UPDATE^DIE("E","RAFDA",,"RAMSG")
  1.  . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.1)
  1.  ;---
  1.  Q RARC
  1.  ;
  1. SIUID(RACNI) ;
  1.  ;sets field 81 IN 70.03
  1.  ;IENS, RADFN & RADTI are global
  1.  N RAFDA S RAFDA(70.03,IENS,81)=$$SIUID^RAAPI
  1.  D FILE^DIE("","RAFDA")
  1.  Q