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