- RAMAGU13 ;HCIOFO/SG - ORDERS/EXAMS API (MISC UTILITIES) ; 2/10/09 4:11pm
- ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
- ;
- Q
- ;
- ;***** CREATES A STUB IN THE NUC MED EXAM DATA FILE (#70.2)
- ;
- ; 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)
- ;
- ; [RAPROCIEN] IEN of the Radiology procedure. By default
- ; ($G(RAPROCIEN)'>0), it is loaded from the exam
- ; record.
- ;
- ; [RADTE] Exam date. By default ($G(RADTE)'>0), it is
- ; loaded from the date/time record of the exam.
- ;
- ; [RACN] Case number. By default ($G(RACN)'>0), it is
- ; loaded from the exam record.
- ;
- ; Return Values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; 0 The record is not needed
- ; >0 IEN of the record of the NUC MED EXAM DATA file (#70.2)
- ;
- NMEDSTUB(RACASE,RAPROCIEN,RADTE,RACN) ;
- N IENS,RABUF,RAFDA,RAIENLST,RAIENS,RAMSG,RANMDIEN,RARC,TMP
- S RARC=0,RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
- ;
- ;=== Check parameter values and load default ones if necessary
- S TMP="500" ; NUCLEAR MED DATA
- S:$G(RACN)'>0 TMP=TMP_";.01" ; CASE NUMBER
- S:$G(RAPROCIEN)'>0 TMP=TMP_";2" ; PROCEDURE
- D GETS^DIQ(70.03,RAIENS,TMP,"I","RABUF","RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
- S:$G(RACN)'>0 RACN=$G(RABUF(70.03,RAIENS,.01,"I"))
- S:$G(RAPROCIEN)'>0 RAPROCIEN=$G(RABUF(70.03,RAIENS,2,"I"))
- S RANMDIEN=+$G(RABUF(70.03,RAIENS,500,"I"))
- ;--- Return IEN of the nuclear medicine record if it exists already
- I RANMDIEN>0 Q:$D(^RADPTN(RANMDIEN)) RANMDIEN
- ;--- Exam date/time
- I $G(RADTE)'>0 D Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.02,IENS)
- . S IENS=$P(RAIENS,",",2,4) ; Keep the trailing comma
- . S RADTE=$$GET1^DIQ(70.02,IENS,.01,"I",,"RAMSG")
- ;
- ;=== Check if the nuclear medicine record is needed
- S IENS=+RAPROCIEN_","
- ;--- Check the value of the RADIOPHARMACEUTICALS USED?
- ;--- field of the IMAGING TYPE file (#79.2)
- S TMP=$$GET1^DIQ(71,IENS,"#12:#5","I",,"RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,71,IENS)
- Q:TMP'="Y" 0
- ;--- Check the value of the SUPPRESS RADIOPHARM PROMPT
- ;--- field of the RAD/NUC MED PROCEDURES file (#71)
- S TMP=$$GET1^DIQ(71,IENS,2,"I",,"RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,71,IENS)
- Q:TMP 0
- ;
- ;=== Create the stub record
- S IENS="+1,"
- S RAFDA(70.2,IENS,.01)=$P(RACASE,U)
- S RAFDA(70.2,IENS,2)=RADTE
- S RAFDA(70.2,IENS,3)=RACN
- D UPDATE^DIE(,"RAFDA","RAIENLST","RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.2,IENS)
- S RANMDIEN=+RAIENLST(1)
- ;
- ;=== Store the pointer
- D
- . ;--- Setup the error handler
- . N $ESTACK,$ETRAP D SETDEFEH^RAERR("RARC")
- . ;--- Update the exam record
- . S RAFDA(70.03,RAIENS,500)=RANMDIEN
- . D FILE^DIE(,"RAFDA","RAMSG")
- . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
- ;--- Remove the stray record if the pointer cannot be stored
- I RARC<0 D Q RARC
- . N DA,DIK S DIK="^RADPTN(",DA=RANMDIEN D ^DIK
- ;
- ;=== Success
- Q RANMDIEN
- ;
- ;***** SEARCHES FOR THE RAD/NUC MED REASON SYNONYM
- ;
- ; REASON Either IEN of a record of the RAD/NUC MED REASON
- ; file (#75.2) or a valid synonym (see SYNONYM field
- ; (3) of that file).
- ;
- ; [.TYPE] Reference to a local variable where internal and
- ; external values (separated by "^") of the TYPE OF
- ; REASON field (2) of the file #75.2 are returned to.
- ;
- ; Return Values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; >0 IEN of the record in the file #75.2
- ;
- RARSNIEN(REASON,TYPE) ;
- N IENS,RABUF,RAMSG,RC,TMP
- S TYPE="",RC=$$CHKREQ^RAUTL22("REASON") Q:RC<0 RC
- ;---
- I (+REASON)'=REASON D ;--- Synonym of the reason
- . ;--- Find the reason
- . D FIND^DIC(75.2,,"@;2IE",,REASON,2,"S",,,"RABUF","RAMSG")
- . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,75.2) Q
- . S TMP=+$G(RABUF("DILIST",0))
- . ;--- No such synonym on file
- . I TMP<1 S RC=$$ERROR^RAERR(-33,,"synonym",75.2) Q
- . ;--- Ambiguous synonym
- . I TMP>1 S RC=$$ERROR^RAERR(-14,,"synonym",REASON) Q
- . ;--- Reason IEN and type
- . S TYPE=$G(RABUF("DILIST","ID",1,2,"I"))
- . S TYPE=TYPE_U_$G(RABUF("DILIST","ID",1,2,"E"))
- . S REASON=+RABUF("DILIST",2,1)
- E D ;--- Reason IEN
- . S IENS=REASON_","
- . D GETS^DIQ(75.2,IENS,"2","EI","RABUF","RAMSG")
- . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,75.2,IENS) Q
- . S TYPE=$G(RABUF(75.2,IENS,2,"I"))_U_$G(RABUF(75.2,IENS,2,"E"))
- ;---
- Q $S(RC<0:RC,1:REASON)
- ;
- ;***** UPDATES VALUES OF THE MULTIPLE(S)
- ;
- ; .RAFDAM Reference to a local variable that stores field
- ; values prepared for storage (FileMan FDA array)
- ;
- ; RAIENS IENS of the main record that multiple values in
- ; the RAFDAM belong to
- ;
- ; [RAFLAGS] Flags for UPDATE^DIE
- ;
- ; Return values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; 0 Success
- ;
- UPDMULT(RAFDAM,RAIENS,RAFLAGS) ;
- N DA,DIK,ERR,IENS,RAFDA,RAMSG,RANODE,RARC,RASUBF
- S (RARC,RASUBF)=0,RAFLAGS=$G(RAFLAGS)
- F S RASUBF=$O(RAFDAM(RASUBF)) Q:RASUBF'>0 D Q:RARC<0
- . K RAFDA,RAMSG M RAFDA(RASUBF)=RAFDAM(RASUBF)
- . S IENS=","_RAIENS D DA^DILF(IENS,.DA)
- . S DIK=$$ROOT^DILFD(RASUBF,IENS,0,.ERR)
- . I $G(ERR)!(DIK="") S RARC=$$ERROR^RAERR(-50,,RASUBF,IENS) Q
- . S RANODE=$$CREF^DILF(DIK)
- . ;--- Delete the old data
- . D IXALL2^DIK ; Delete entries from cross-references
- . K @RANODE ; Clear the whole multiple
- . ;--- Store the new data
- . I $D(RAFDA)>1 D Q:RARC<0
- . . D UPDATE^DIE(RAFLAGS,"RAFDA",,"RAMSG")
- . . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,RASUBF,"*,"_RAIENS)
- . ;--- Remove subfile data from the source FDA
- . K:RAFLAGS'["S" RAFDAM(RASUBF)
- ;---
- Q $S(RARC<0:RARC,1:0)
- ;
- ;***** CHECKS IF THE LONG ACCESSION NUMBER SHOULD BE USED
- ;
- ; RAMDIV Radiology division IEN (file #79)
- ;
- ; Return values:
- ; 0 Use short accession number (MMDDYY-NNNNN)
- ; 1 Use long accession number (SSS-MMDDYY-NNNNN)
- ;
- USLNGACN(RAMDIV) ;
- Q:RAMDIV'>0 0
- N RAMSG
- ;--- Check the value of the USE SITE ACCESSION NUMBER? field (.131)
- ; of the RAD/NUC MED DIVISION file (#79). This field is exported
- ;--- by the patch RA*5*47. See the data dictionary for details.
- Q ($$GET1^DIQ(79,RAMDIV_",",.131,"I",,"RAMSG")="Y")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU13 6566 printed Jan 18, 2025@03:38:10 Page 2
- RAMAGU13 ;HCIOFO/SG - ORDERS/EXAMS API (MISC UTILITIES) ; 2/10/09 4:11pm
- +1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;***** CREATES A STUB IN THE NUC MED EXAM DATA FILE (#70.2)
- +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 ; [RAPROCIEN] IEN of the Radiology procedure. By default
- +13 ; ($G(RAPROCIEN)'>0), it is loaded from the exam
- +14 ; record.
- +15 ;
- +16 ; [RADTE] Exam date. By default ($G(RADTE)'>0), it is
- +17 ; loaded from the date/time record of the exam.
- +18 ;
- +19 ; [RACN] Case number. By default ($G(RACN)'>0), it is
- +20 ; loaded from the exam record.
- +21 ;
- +22 ; Return Values:
- +23 ; <0 Error descriptor (see $$ERROR^RAERR)
- +24 ; 0 The record is not needed
- +25 ; >0 IEN of the record of the NUC MED EXAM DATA file (#70.2)
- +26 ;
- NMEDSTUB(RACASE,RAPROCIEN,RADTE,RACN) ;
- +1 NEW IENS,RABUF,RAFDA,RAIENLST,RAIENS,RAMSG,RANMDIEN,RARC,TMP
- +2 SET RARC=0
- SET RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
- +3 ;
- +4 ;=== Check parameter values and load default ones if necessary
- +5 ; NUCLEAR MED DATA
- SET TMP="500"
- +6 ; CASE NUMBER
- if $GET(RACN)'>0
- SET TMP=TMP_";.01"
- +7 ; PROCEDURE
- if $GET(RAPROCIEN)'>0
- SET TMP=TMP_";2"
- +8 DO GETS^DIQ(70.03,RAIENS,TMP,"I","RABUF","RAMSG")
- +9 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
- +10 if $GET(RACN)'>0
- SET RACN=$GET(RABUF(70.03,RAIENS,.01,"I"))
- +11 if $GET(RAPROCIEN)'>0
- SET RAPROCIEN=$GET(RABUF(70.03,RAIENS,2,"I"))
- +12 SET RANMDIEN=+$GET(RABUF(70.03,RAIENS,500,"I"))
- +13 ;--- Return IEN of the nuclear medicine record if it exists already
- +14 IF RANMDIEN>0
- if $DATA(^RADPTN(RANMDIEN))
- QUIT RANMDIEN
- +15 ;--- Exam date/time
- +16 IF $GET(RADTE)'>0
- Begin DoDot:1
- +17 ; Keep the trailing comma
- SET IENS=$PIECE(RAIENS,",",2,4)
- +18 SET RADTE=$$GET1^DIQ(70.02,IENS,.01,"I",,"RAMSG")
- End DoDot:1
- if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,70.02,IENS)
- +19 ;
- +20 ;=== Check if the nuclear medicine record is needed
- +21 SET IENS=+RAPROCIEN_","
- +22 ;--- Check the value of the RADIOPHARMACEUTICALS USED?
- +23 ;--- field of the IMAGING TYPE file (#79.2)
- +24 SET TMP=$$GET1^DIQ(71,IENS,"#12:#5","I",,"RAMSG")
- +25 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,71,IENS)
- +26 if TMP'="Y"
- QUIT 0
- +27 ;--- Check the value of the SUPPRESS RADIOPHARM PROMPT
- +28 ;--- field of the RAD/NUC MED PROCEDURES file (#71)
- +29 SET TMP=$$GET1^DIQ(71,IENS,2,"I",,"RAMSG")
- +30 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,71,IENS)
- +31 if TMP
- QUIT 0
- +32 ;
- +33 ;=== Create the stub record
- +34 SET IENS="+1,"
- +35 SET RAFDA(70.2,IENS,.01)=$PIECE(RACASE,U)
- +36 SET RAFDA(70.2,IENS,2)=RADTE
- +37 SET RAFDA(70.2,IENS,3)=RACN
- +38 DO UPDATE^DIE(,"RAFDA","RAIENLST","RAMSG")
- +39 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,70.2,IENS)
- +40 SET RANMDIEN=+RAIENLST(1)
- +41 ;
- +42 ;=== Store the pointer
- +43 Begin DoDot:1
- +44 ;--- Setup the error handler
- +45 NEW $ESTACK,$ETRAP
- DO SETDEFEH^RAERR("RARC")
- +46 ;--- Update the exam record
- +47 SET RAFDA(70.03,RAIENS,500)=RANMDIEN
- +48 DO FILE^DIE(,"RAFDA","RAMSG")
- +49 if $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
- End DoDot:1
- +50 ;--- Remove the stray record if the pointer cannot be stored
- +51 IF RARC<0
- Begin DoDot:1
- +52 NEW DA,DIK
- SET DIK="^RADPTN("
- SET DA=RANMDIEN
- DO ^DIK
- End DoDot:1
- QUIT RARC
- +53 ;
- +54 ;=== Success
- +55 QUIT RANMDIEN
- +56 ;
- +57 ;***** SEARCHES FOR THE RAD/NUC MED REASON SYNONYM
- +58 ;
- +59 ; REASON Either IEN of a record of the RAD/NUC MED REASON
- +60 ; file (#75.2) or a valid synonym (see SYNONYM field
- +61 ; (3) of that file).
- +62 ;
- +63 ; [.TYPE] Reference to a local variable where internal and
- +64 ; external values (separated by "^") of the TYPE OF
- +65 ; REASON field (2) of the file #75.2 are returned to.
- +66 ;
- +67 ; Return Values:
- +68 ; <0 Error descriptor (see $$ERROR^RAERR)
- +69 ; >0 IEN of the record in the file #75.2
- +70 ;
- RARSNIEN(REASON,TYPE) ;
- +1 NEW IENS,RABUF,RAMSG,RC,TMP
- +2 SET TYPE=""
- SET RC=$$CHKREQ^RAUTL22("REASON")
- if RC<0
- QUIT RC
- +3 ;---
- +4 ;--- Synonym of the reason
- IF (+REASON)'=REASON
- Begin DoDot:1
- +5 ;--- Find the reason
- +6 DO FIND^DIC(75.2,,"@;2IE",,REASON,2,"S",,,"RABUF","RAMSG")
- +7 IF $GET(DIERR)
- SET RC=$$DBS^RAERR("RAMSG",-9,75.2)
- QUIT
- +8 SET TMP=+$GET(RABUF("DILIST",0))
- +9 ;--- No such synonym on file
- +10 IF TMP<1
- SET RC=$$ERROR^RAERR(-33,,"synonym",75.2)
- QUIT
- +11 ;--- Ambiguous synonym
- +12 IF TMP>1
- SET RC=$$ERROR^RAERR(-14,,"synonym",REASON)
- QUIT
- +13 ;--- Reason IEN and type
- +14 SET TYPE=$GET(RABUF("DILIST","ID",1,2,"I"))
- +15 SET TYPE=TYPE_U_$GET(RABUF("DILIST","ID",1,2,"E"))
- +16 SET REASON=+RABUF("DILIST",2,1)
- End DoDot:1
- +17 ;--- Reason IEN
- IF '$TEST
- Begin DoDot:1
- +18 SET IENS=REASON_","
- +19 DO GETS^DIQ(75.2,IENS,"2","EI","RABUF","RAMSG")
- +20 IF $GET(DIERR)
- SET RC=$$DBS^RAERR("RAMSG",-9,75.2,IENS)
- QUIT
- +21 SET TYPE=$GET(RABUF(75.2,IENS,2,"I"))_U_$GET(RABUF(75.2,IENS,2,"E"))
- End DoDot:1
- +22 ;---
- +23 QUIT $SELECT(RC<0:RC,1:REASON)
- +24 ;
- +25 ;***** UPDATES VALUES OF THE MULTIPLE(S)
- +26 ;
- +27 ; .RAFDAM Reference to a local variable that stores field
- +28 ; values prepared for storage (FileMan FDA array)
- +29 ;
- +30 ; RAIENS IENS of the main record that multiple values in
- +31 ; the RAFDAM belong to
- +32 ;
- +33 ; [RAFLAGS] Flags for UPDATE^DIE
- +34 ;
- +35 ; Return values:
- +36 ; <0 Error descriptor (see $$ERROR^RAERR)
- +37 ; 0 Success
- +38 ;
- UPDMULT(RAFDAM,RAIENS,RAFLAGS) ;
- +1 NEW DA,DIK,ERR,IENS,RAFDA,RAMSG,RANODE,RARC,RASUBF
- +2 SET (RARC,RASUBF)=0
- SET RAFLAGS=$GET(RAFLAGS)
- +3 FOR
- SET RASUBF=$ORDER(RAFDAM(RASUBF))
- if RASUBF'>0
- QUIT
- Begin DoDot:1
- +4 KILL RAFDA,RAMSG
- MERGE RAFDA(RASUBF)=RAFDAM(RASUBF)
- +5 SET IENS=","_RAIENS
- DO DA^DILF(IENS,.DA)
- +6 SET DIK=$$ROOT^DILFD(RASUBF,IENS,0,.ERR)
- +7 IF $GET(ERR)!(DIK="")
- SET RARC=$$ERROR^RAERR(-50,,RASUBF,IENS)
- QUIT
- +8 SET RANODE=$$CREF^DILF(DIK)
- +9 ;--- Delete the old data
- +10 ; Delete entries from cross-references
- DO IXALL2^DIK
- +11 ; Clear the whole multiple
- KILL @RANODE
- +12 ;--- Store the new data
- +13 IF $DATA(RAFDA)>1
- Begin DoDot:2
- +14 DO UPDATE^DIE(RAFLAGS,"RAFDA",,"RAMSG")
- +15 if $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,RASUBF,"*,"_RAIENS)
- End DoDot:2
- if RARC<0
- QUIT
- +16 ;--- Remove subfile data from the source FDA
- +17 if RAFLAGS'["S"
- KILL RAFDAM(RASUBF)
- End DoDot:1
- if RARC<0
- QUIT
- +18 ;---
- +19 QUIT $SELECT(RARC<0:RARC,1:0)
- +20 ;
- +21 ;***** CHECKS IF THE LONG ACCESSION NUMBER SHOULD BE USED
- +22 ;
- +23 ; RAMDIV Radiology division IEN (file #79)
- +24 ;
- +25 ; Return values:
- +26 ; 0 Use short accession number (MMDDYY-NNNNN)
- +27 ; 1 Use long accession number (SSS-MMDDYY-NNNNN)
- +28 ;
- USLNGACN(RAMDIV) ;
- +1 if RAMDIV'>0
- QUIT 0
- +2 NEW RAMSG
- +3 ;--- Check the value of the USE SITE ACCESSION NUMBER? field (.131)
- +4 ; of the RAD/NUC MED DIVISION file (#79). This field is exported
- +5 ;--- by the patch RA*5*47. See the data dictionary for details.
- +6 QUIT ($$GET1^DIQ(79,RAMDIV_",",.131,"I",,"RAMSG")="Y")