- RAMAGU04 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM UTILITIES) ; 8/18/08 10:16am
- ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU04 6338 printed Jan 18, 2025@03:38:01 Page 2
- 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
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;***** CONSTRUCTS THE SITE ACCESSION NUMBER
- +6 ;
- +7 ; RADTE Exam date (.01 field of the sub-file #70.02)
- +8 ;
- +9 ; RACN Case number (.01 field of the sub-file #70.03)
- +10 ;
- +11 ; [FLAGS] Flags that control the execution (can be combined):
- +12 ;
- +13 ; S Return the short accession number: MMDDYY-NNNNN.
- +14 ; By default, the long version (SSS-MMDDYY-NNNNN)
- +15 ; is returned.
- +16 ;
- 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