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

RAMAGU04.m

Go to the documentation of this file.
  1. RAMAGU04 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM UTILITIES) ; 8/18/08 10:16am
  1. ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1. ;
  1. Q
  1. ;
  1. ;***** CONSTRUCTS THE SITE ACCESSION NUMBER
  1. ;
  1. ; RADTE Exam date (.01 field of the sub-file #70.02)
  1. ;
  1. ; RACN Case number (.01 field of the sub-file #70.03)
  1. ;
  1. ; [FLAGS] Flags that control the execution (can be combined):
  1. ;
  1. ; S Return the short accession number: MMDDYY-NNNNN.
  1. ; By default, the long version (SSS-MMDDYY-NNNNN)
  1. ; is returned.
  1. ;
  1. ACCNUM(RADTE,RACN,FLAGS) ;
  1. N RAD S RAD=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_(+RACN) ; mmddyy-case#
  1. Q:$G(FLAGS)["S" RAD
  1. Q $E($P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)_"-"_RAD
  1. ;
  1. ;***** CHECKS EXAMINATION IDENTIFIERS
  1. ;
  1. ; RACASE Examination identifiers
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  1. ;
  1. ; [RAPRMNM] Parameter name inserted into the error message.
  1. ; By default ($G(RAPRMNM)=""), "RACASE" is assumed.
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. CHKEXMID(RACASE,RAPRMNM) ;
  1. N NODE,RC
  1. S:$G(RAPRMNM)="" RAPRMNM="RACASE"
  1. ;--- Check the IDs
  1. S RC=(RACASE'>0)!($P(RACASE,U,2)'>0)!($P(RACASE,U,3)'>0)
  1. Q:RC $$ERROR^RAERR(-3,RAPRMNM_"='"_RACASE_"'",RAPRMNM)
  1. ;--- Check if the case exists
  1. S NODE=$$ROOT^DILFD(70.03,","_$P(RACASE,U,2)_","_$P(RACASE,U)_",",1)
  1. Q:'$D(@NODE@($P(RACASE,U,3),0)) $$ERROR^RAERR(-25,,RAPRMNM)
  1. ;--- Success
  1. Q 0
  1. ;
  1. ;***** CONSTRUCTS THE DAY-CASE EXAM IDENTIFIER
  1. ;
  1. ; RADTE Exam date (.01 field of the sub-file #70.02)
  1. ;
  1. ; RACN Case number (.01 field of the sub-file #70.03)
  1. ;
  1. ; Return Values:
  1. ; MMDDYY-Case#
  1. ;
  1. DAYCASE(RADTE,RACN) ;
  1. Q $E(+RADTE,4,7)_$E(+RADTE,2,3)_"-"_(+RACN)
  1. ;
  1. ;***** CONVERTS EXAM IDENTIFIERS INTO THE EXAM IENS
  1. ;
  1. ; RACASE Examination identifiers
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  1. ;
  1. EXAMIENS(RACASE) ;
  1. Q $P(RACASE,U,3)_","_$P(RACASE,U,2)_","_$P(RACASE,U)_","
  1. ;
  1. ;***** RETURNS THE EXAM GLOBAL NODE
  1. ;
  1. ; RACASE Examination identifiers
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  1. ;
  1. EXAMNODE(RACASE) ;
  1. N IENS,NODE
  1. S IENS=$$EXAMIENS(RACASE),$P(IENS,",")=""
  1. S NODE=$$ROOT^DILFD(70.03,IENS,1)
  1. Q $NA(@NODE@($P(RACASE,U,3)))
  1. ;
  1. ;***** LOADS EXAM PROPERTIES AND INITIALIZES VARIABLES
  1. ;
  1. ; RAIENS IENS of the exam record in the EXAMINATIONS multiple
  1. ; (50) of the RAD/NUC MED PATIENT file (#70).
  1. ;
  1. ; Output variables:
  1. ; RACN, RADTE, RAIMGTYI
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Ok
  1. ;
  1. EXAMVARS(RAIENS) ;
  1. N IENS,RABUF,RAMSG
  1. ;=== Data from the REGISTERED EXAMS multiple
  1. S IENS=$P(RAIENS,",",2,4)
  1. D GETS^DIQ(70.02,IENS,".01;2","I","RABUF","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.02,IENS)
  1. ;--- Exam date
  1. S RADTE=+$G(RABUF(70.02,IENS,.01,"I"))
  1. Q:RADTE'>0 $$ERROR^RAERR(-19,,70.02,IENS,.01)
  1. ;--- Imaging type IEN
  1. S RAIMGTYI=+$G(RABUF(70.02,IENS,2,"I"))
  1. Q:RAIMGTYI'>0 $$ERROR^RAERR(-19,,70.02,IENS,2)
  1. ;
  1. ;=== Data from the EXAMINATIONS multiple
  1. D GETS^DIQ(70.03,RAIENS,".01","I","RABUF","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
  1. ;--- Case number
  1. S RACN=$G(RABUF(70.03,RAIENS,.01,"I"))
  1. Q:RACN'>0 $$ERROR^RAERR(-19,,70.03,RAIENS,.01)
  1. ;
  1. ;=== Success
  1. Q 0
  1. ;
  1. ;***** RETURNS 'INVERTED' DATE/TIME
  1. INVDTE(DTE) ;
  1. Q 9999999.9999-DTE
  1. ;
  1. ;***** REGISTERS THE PATIENT IN THE FILE #70 (IF NOT REGISTERED)
  1. ;
  1. ; DFN Patient IEN (in file #2)
  1. ;
  1. ; [USLCAT] Usual category (value of the USUAL CATEGORY (.04)
  1. ; field of the RAD/NUC MED PATIENT file #70).
  1. ; By default ($G(USLCAT)=""), "O" (outpatient) is
  1. ; assumed.
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; >0 IEN in the file #70 (the same as DFN)
  1. ;
  1. RAPTREG(DFN,USLCAT) ;
  1. Q:$G(DFN)'>0 $$IPVE^RAERR("DFN")
  1. ;--- Check if the patient is already registered
  1. Q:$D(^RADPT(+DFN)) +DFN
  1. ;--- Register a new Radiology patient
  1. N IENS,RAFDA,RAIENS,RAMSG
  1. S IENS="+1,",RAIENS(1)=+DFN
  1. S RAFDA(70,IENS,.01)="`"_(+DFN) ; NAME
  1. S RAFDA(70,IENS,.06)="`"_(+DUZ) ; USER WHO ENTERED PATIENT
  1. S RAFDA(70,IENS,.04)=$S($G(USLCAT)'="":USLCAT,1:"O")
  1. D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70,IENS)
  1. ;--- Success
  1. Q RAIENS(1)
  1. ;
  1. ;***** UPDATES EXAM PROCEDURE AND MODIFIERS
  1. ;
  1. ; RACASE Exam/case identifiers
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  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 Ok
  1. ;
  1. UPDEXMPR(RACASE,RAPROC) ;
  1. N DA,DIK,I,RAIENS,RANODE,RAFDA,RAMSG,TMP
  1. S RAIENS=$$EXAMIENS(RACASE)
  1. ;--- Prepare the new data for storage
  1. S RAFDA(70.03,RAIENS,2)=+RAPROC ; Procedure
  1. F I=2:1 S TMP=$P(RAPROC,U,I) Q:TMP="" D:TMP>0
  1. . S RAFDA(70.1,"+"_I_","_RAIENS,.01)=+TMP ; Modifiers
  1. ;--- Delete the old modifiers
  1. S TMP=","_RAIENS D DA^DILF(TMP,.DA)
  1. S DIK=$$ROOT^DILFD(70.1,TMP),RANODE=$$CREF^DILF(DIK)
  1. D IXALL2^DIK ; Delete entries from cross-references
  1. K @RANODE ; Clear the whole multiple
  1. ;--- Store the new data
  1. D UPDATE^DIE(,"RAFDA",,"RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
  1. ;---
  1. Q 0