- RAMAGU12 ;HCIOFO/SG - ORDERS/EXAMS API (REPORT UTILS) ; Sep 10, 2020@09:29:33
- ;;5.0;Radiology/Nuclear Medicine;**90,174**;Mar 16, 1998;Build 2
- ;
- Q
- ;
- ;***** CREATES A REPORT STUB
- ;
- ; 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)
- ;
- ; [[.]RADTE] Date of the exam. If this parameter is not defined,
- ; the value is loaded from the case record.
- ;
- ; [[.]RACN] Case number. If this parameter is not defined, the
- ; value is loaded from the subfile #70.02.
- ;
- ; Return values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; >0 Report IEN in the RAD/NUC MED REPORTS file (#74)
- ;
- RPTSTUB(RACASE,RADTE,RACN) ;
- N RABUF,RACNI,RADFN,RADTI,RAIENS,RAMSG,RARPT,TMP
- S RADFN=$P(RACASE,U),RADTI=$P(RACASE,U,2),RACNI=$P(RACASE,U,3)
- S RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
- ;--- Get case properties
- S TMP=$S($G(RACN)'>0:".01;17",1:"17")
- D GETS^DIQ(70.03,RAIENS,TMP,"I","RABUF","RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
- S RARPT=+$G(RABUF(70.03,RAIENS,17,"I"))
- Q:RARPT>0 RARPT ;--- Report already exists
- S:$G(RACN)'>0 RACN=$G(RABUF(70.03,RAIENS,.01,"I"))
- ;--- Get the date if necessary
- I $G(RADTE)'>0 D Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.02,TMP)
- . S TMP=$P(RAIENS,",",2,4) ; Include trailing comma
- . S RADTE=$$GET1^DIQ(70.02,TMP,.01,"I",,"RAMSG")
- ;--- Create the stub
- D
- . N MAGSCN,RAFDA,RASULT,RAX
- . D CREATE^RARIC
- Q $S($G(RARPT)>0:+RARPT,1:$$ERROR^RAERR(-52))
- ;
- ;***** RETURNS REPORT STATUS
- ;
- ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
- ;
- ; Return Values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; >0 Internal and external values of the REPORT STATUS
- ; field (5) of the RAD/NUC MED REPORTS file (#74)
- ; separated by "^".
- ;
- RPTSTAT(RPTIEN) ;
- N IENS,RABUF,RAMSG
- S IENS=(+RPTIEN)_","
- D GETS^DIQ(74,IENS,"5","EI","RABUF","RAMSG")
- Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,74,IENS)
- Q $G(RABUF(74,IENS,5,"I"))_U_$G(RABUF(74,IENS,5,"E"))
- ;
- ;***** UPDATES THE REPORT ACTIVITY LOG
- ;
- ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
- ;
- ; ACTION Internal action value (see the TYPE OF ACTION
- ; field (2) of the sub-file #74.01).
- ;
- ; [LOGDT] Internal date value (FileMan) for the LOG DATE
- ; field (.01) of the sub-file #74.01. If this
- ; parameter is not defined or not greater than 0,
- ; then the current date/time is used.
- ;
- ; Return Values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; >0 IEN of the new activity sub-record in sub-file #74.01
- ;
- UPDRPTAL(RPTIEN,ACTION,LOGDT) ;
- N IENS,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
- S RARC=$$CHKREQ^RAUTL22("RPTIEN,ACTION") Q:RARC<0 RARC
- S RPTIEN=+RPTIEN
- ;
- ;--- Check the date/time
- I $G(LOGDT)>0 D Q:RARC<0 RARC
- . S TMP=+$E(LOGDT,1,12),LOGDT1=$$FMTE^XLFDT(TMP)
- . S:(LOGDT1=TMP)!(LOGDT1="") RARC=$$IPVE^RAERR("LOGDT")
- E S LOGDT1="NOW"
- ;
- ;--- Prepare the data
- S IENS="+1,"_RPTIEN_","
- S RAFDA(74.01,IENS,.01)=LOGDT1 ; LOG DATE
- S RAFDA(74.01,IENS,2)=ACTION ; TYPE OF ACTION
- S RAFDA(74.01,IENS,3)="`"_(+DUZ) ; COMPUTER USER
- ;
- ;--- Lock the ACTIVITY LOG multiple
- K TMP S TMP(74.01,","_RPTIEN_",")=""
- S RARC=$$LOCKFM^RALOCK(.TMP)
- Q:RARC $$LOCKERR^RAERR(RARC,"report activity log")
- M RALOCK=TMP
- ;
- D
- . N $ESTACK,$ETRAP
- . ;--- Setup the error processing
- . D SETDEFEH^RAERR("RARC")
- . ;--- Add the record
- . D UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
- . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,74.01,IENS)
- ;
- ;--- Error handling and cleanup
- D UNLOCKFM^RALOCK(.RALOCK)
- Q $S(RARC<0:RARC,1:+RAIENS(1))
- ;
- ;***** UPDATES THE REPORT STATUS
- ;
- ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
- ;
- ; STATUS Value for the REPORT STATUS field (5) of file #74
- ;
- ; [PROBSTAT] Problem statement. If this parameter is defined and
- ; not empty (spaces are not counted), then its value
- ; is stored into the PROBLEM STATEMENT field (25) of
- ; the file #74 and the status is automatically changed
- ; to PROBLEM DRAFT.
- ;
- ; Return Values:
- ; <0 Error descriptor (see $$ERROR^RAERR)
- ; 0 Success
- ;
- UPDRPTST(RPTIEN,STATUS,PROBSTAT) ;
- N IENS,RAFDA,RALOCK,RAMSG,RARC,TMP
- S RARC=$$CHKREQ^RAUTL22("RPTIEN,STATUS") Q:RARC<0 RARC
- S IENS=(+RPTIEN)_","
- ;
- ;--- Lock the report
- K TMP S TMP(74,IENS)=""
- S RARC=$$LOCKFM^RALOCK(.TMP)
- Q:RARC $$LOCKERR^RAERR(RARC,"report")
- M RALOCK=TMP
- ;
- D
- . N $ESTACK,$ETRAP
- . ;--- Setup the error processing
- . D SETDEFEH^RAERR("RARC")
- . ;
- . ;--- Check the problem statement
- . S TMP=$$TRIM^XLFSTR($G(PROBSTAT))
- . S:TMP'="" STATUS="PD"
- . D VAL^DIE(74,IENS,25,"F",TMP,.TMP,"RAFDA","RAMSG")
- . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9) Q
- . I TMP="^" S RARC=$$IPVE^RAERR("PROBSTAT") Q
- . ;
- . ;--- Check the new report status
- . D VAL^DIE(74,IENS,5,"F",STATUS,.TMP,"RAFDA","RAMSG")
- . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9) Q
- . I TMP="^" S RARC=$$IPVE^RAERR("STATUS") Q
- . S STATUS=TMP
- . ;
- . ;--- Check if the report currently has the same status
- . S TMP=$$GET1^DIQ(74,IENS,5,"I",,"RAMSG")
- . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,74,IENS) Q
- . I TMP=STATUS K RAFDA(74,IENS,5) Q:$D(RAFDA)<10
- . ;
- . ;--- Update the record
- . D FILE^DIE(,"RAFDA","RAMSG")
- . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,74,IENS)
- . ;p174 KLM: add link to Women's Health
- . I $P(^RARPT(RPTIEN,0),U,5)="EF"!($P(^RARPT(RPTIEN,0),U,5)="V") D CREATE^WVRALINK(RADFN,RADTI,RACNI)
- ;
- ;--- Error handling and cleanup
- D UNLOCKFM^RALOCK(.RALOCK)
- Q $S(RARC<0:RARC,1:0)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU12 5996 printed Jan 18, 2025@03:38:09 Page 2
- RAMAGU12 ;HCIOFO/SG - ORDERS/EXAMS API (REPORT UTILS) ; Sep 10, 2020@09:29:33
- +1 ;;5.0;Radiology/Nuclear Medicine;**90,174**;Mar 16, 1998;Build 2
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;***** CREATES A REPORT STUB
- +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 ; [[.]RADTE] Date of the exam. If this parameter is not defined,
- +13 ; the value is loaded from the case record.
- +14 ;
- +15 ; [[.]RACN] Case number. If this parameter is not defined, the
- +16 ; value is loaded from the subfile #70.02.
- +17 ;
- +18 ; Return values:
- +19 ; <0 Error descriptor (see $$ERROR^RAERR)
- +20 ; >0 Report IEN in the RAD/NUC MED REPORTS file (#74)
- +21 ;
- RPTSTUB(RACASE,RADTE,RACN) ;
- +1 NEW RABUF,RACNI,RADFN,RADTI,RAIENS,RAMSG,RARPT,TMP
- +2 SET RADFN=$PIECE(RACASE,U)
- SET RADTI=$PIECE(RACASE,U,2)
- SET RACNI=$PIECE(RACASE,U,3)
- +3 SET RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
- +4 ;--- Get case properties
- +5 SET TMP=$SELECT($GET(RACN)'>0:".01;17",1:"17")
- +6 DO GETS^DIQ(70.03,RAIENS,TMP,"I","RABUF","RAMSG")
- +7 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
- +8 SET RARPT=+$GET(RABUF(70.03,RAIENS,17,"I"))
- +9 ;--- Report already exists
- if RARPT>0
- QUIT RARPT
- +10 if $GET(RACN)'>0
- SET RACN=$GET(RABUF(70.03,RAIENS,.01,"I"))
- +11 ;--- Get the date if necessary
- +12 IF $GET(RADTE)'>0
- Begin DoDot:1
- +13 ; Include trailing comma
- SET TMP=$PIECE(RAIENS,",",2,4)
- +14 SET RADTE=$$GET1^DIQ(70.02,TMP,.01,"I",,"RAMSG")
- End DoDot:1
- if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,70.02,TMP)
- +15 ;--- Create the stub
- +16 Begin DoDot:1
- +17 NEW MAGSCN,RAFDA,RASULT,RAX
- +18 DO CREATE^RARIC
- End DoDot:1
- +19 QUIT $SELECT($GET(RARPT)>0:+RARPT,1:$$ERROR^RAERR(-52))
- +20 ;
- +21 ;***** RETURNS REPORT STATUS
- +22 ;
- +23 ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
- +24 ;
- +25 ; Return Values:
- +26 ; <0 Error descriptor (see $$ERROR^RAERR)
- +27 ; >0 Internal and external values of the REPORT STATUS
- +28 ; field (5) of the RAD/NUC MED REPORTS file (#74)
- +29 ; separated by "^".
- +30 ;
- RPTSTAT(RPTIEN) ;
- +1 NEW IENS,RABUF,RAMSG
- +2 SET IENS=(+RPTIEN)_","
- +3 DO GETS^DIQ(74,IENS,"5","EI","RABUF","RAMSG")
- +4 if $GET(DIERR)
- QUIT $$DBS^RAERR("RAMSG",-9,74,IENS)
- +5 QUIT $GET(RABUF(74,IENS,5,"I"))_U_$GET(RABUF(74,IENS,5,"E"))
- +6 ;
- +7 ;***** UPDATES THE REPORT ACTIVITY LOG
- +8 ;
- +9 ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
- +10 ;
- +11 ; ACTION Internal action value (see the TYPE OF ACTION
- +12 ; field (2) of the sub-file #74.01).
- +13 ;
- +14 ; [LOGDT] Internal date value (FileMan) for the LOG DATE
- +15 ; field (.01) of the sub-file #74.01. If this
- +16 ; parameter is not defined or not greater than 0,
- +17 ; then the current date/time is used.
- +18 ;
- +19 ; Return Values:
- +20 ; <0 Error descriptor (see $$ERROR^RAERR)
- +21 ; >0 IEN of the new activity sub-record in sub-file #74.01
- +22 ;
- UPDRPTAL(RPTIEN,ACTION,LOGDT) ;
- +1 NEW IENS,LOGDT1,RAFDA,RAIENS,RALOCK,RAMSG,RARC,TMP
- +2 SET RARC=$$CHKREQ^RAUTL22("RPTIEN,ACTION")
- if RARC<0
- QUIT RARC
- +3 SET RPTIEN=+RPTIEN
- +4 ;
- +5 ;--- Check the date/time
- +6 IF $GET(LOGDT)>0
- Begin DoDot:1
- +7 SET TMP=+$EXTRACT(LOGDT,1,12)
- SET LOGDT1=$$FMTE^XLFDT(TMP)
- +8 if (LOGDT1=TMP)!(LOGDT1="")
- SET RARC=$$IPVE^RAERR("LOGDT")
- End DoDot:1
- if RARC<0
- QUIT RARC
- +9 IF '$TEST
- SET LOGDT1="NOW"
- +10 ;
- +11 ;--- Prepare the data
- +12 SET IENS="+1,"_RPTIEN_","
- +13 ; LOG DATE
- SET RAFDA(74.01,IENS,.01)=LOGDT1
- +14 ; TYPE OF ACTION
- SET RAFDA(74.01,IENS,2)=ACTION
- +15 ; COMPUTER USER
- SET RAFDA(74.01,IENS,3)="`"_(+DUZ)
- +16 ;
- +17 ;--- Lock the ACTIVITY LOG multiple
- +18 KILL TMP
- SET TMP(74.01,","_RPTIEN_",")=""
- +19 SET RARC=$$LOCKFM^RALOCK(.TMP)
- +20 if RARC
- QUIT $$LOCKERR^RAERR(RARC,"report activity log")
- +21 MERGE RALOCK=TMP
- +22 ;
- +23 Begin DoDot:1
- +24 NEW $ESTACK,$ETRAP
- +25 ;--- Setup the error processing
- +26 DO SETDEFEH^RAERR("RARC")
- +27 ;--- Add the record
- +28 DO UPDATE^DIE("E","RAFDA","RAIENS","RAMSG")
- +29 if $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,74.01,IENS)
- End DoDot:1
- +30 ;
- +31 ;--- Error handling and cleanup
- +32 DO UNLOCKFM^RALOCK(.RALOCK)
- +33 QUIT $SELECT(RARC<0:RARC,1:+RAIENS(1))
- +34 ;
- +35 ;***** UPDATES THE REPORT STATUS
- +36 ;
- +37 ; RPTIEN IEN of the report in RAD/NUC MED REPORTS file (#74)
- +38 ;
- +39 ; STATUS Value for the REPORT STATUS field (5) of file #74
- +40 ;
- +41 ; [PROBSTAT] Problem statement. If this parameter is defined and
- +42 ; not empty (spaces are not counted), then its value
- +43 ; is stored into the PROBLEM STATEMENT field (25) of
- +44 ; the file #74 and the status is automatically changed
- +45 ; to PROBLEM DRAFT.
- +46 ;
- +47 ; Return Values:
- +48 ; <0 Error descriptor (see $$ERROR^RAERR)
- +49 ; 0 Success
- +50 ;
- UPDRPTST(RPTIEN,STATUS,PROBSTAT) ;
- +1 NEW IENS,RAFDA,RALOCK,RAMSG,RARC,TMP
- +2 SET RARC=$$CHKREQ^RAUTL22("RPTIEN,STATUS")
- if RARC<0
- QUIT RARC
- +3 SET IENS=(+RPTIEN)_","
- +4 ;
- +5 ;--- Lock the report
- +6 KILL TMP
- SET TMP(74,IENS)=""
- +7 SET RARC=$$LOCKFM^RALOCK(.TMP)
- +8 if RARC
- QUIT $$LOCKERR^RAERR(RARC,"report")
- +9 MERGE RALOCK=TMP
- +10 ;
- +11 Begin DoDot:1
- +12 NEW $ESTACK,$ETRAP
- +13 ;--- Setup the error processing
- +14 DO SETDEFEH^RAERR("RARC")
- +15 ;
- +16 ;--- Check the problem statement
- +17 SET TMP=$$TRIM^XLFSTR($GET(PROBSTAT))
- +18 if TMP'=""
- SET STATUS="PD"
- +19 DO VAL^DIE(74,IENS,25,"F",TMP,.TMP,"RAFDA","RAMSG")
- +20 IF $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9)
- QUIT
- +21 IF TMP="^"
- SET RARC=$$IPVE^RAERR("PROBSTAT")
- QUIT
- +22 ;
- +23 ;--- Check the new report status
- +24 DO VAL^DIE(74,IENS,5,"F",STATUS,.TMP,"RAFDA","RAMSG")
- +25 IF $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9)
- QUIT
- +26 IF TMP="^"
- SET RARC=$$IPVE^RAERR("STATUS")
- QUIT
- +27 SET STATUS=TMP
- +28 ;
- +29 ;--- Check if the report currently has the same status
- +30 SET TMP=$$GET1^DIQ(74,IENS,5,"I",,"RAMSG")
- +31 IF $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,74,IENS)
- QUIT
- +32 IF TMP=STATUS
- KILL RAFDA(74,IENS,5)
- if $DATA(RAFDA)<10
- QUIT
- +33 ;
- +34 ;--- Update the record
- +35 DO FILE^DIE(,"RAFDA","RAMSG")
- +36 if $GET(DIERR)
- SET RARC=$$DBS^RAERR("RAMSG",-9,74,IENS)
- +37 ;p174 KLM: add link to Women's Health
- +38 IF $PIECE(^RARPT(RPTIEN,0),U,5)="EF"!($PIECE(^RARPT(RPTIEN,0),U,5)="V")
- DO CREATE^WVRALINK(RADFN,RADTI,RACNI)
- End DoDot:1
- +39 ;
- +40 ;--- Error handling and cleanup
- +41 DO UNLOCKFM^RALOCK(.RALOCK)
- +42 QUIT $SELECT(RARC<0:RARC,1:0)