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

RAMAGU09.m

Go to the documentation of this file.
  1. RAMAGU09 ;HCIOFO/SG - ORDERS/EXAMS API (RAMISC VALIDATION) ; Aug 15, 2024@09:35:50
  1. ;;5.0;Radiology/Nuclear Medicine;**90,219**;Mar 16, 1998;Build 1
  1. ;
  1. ;
  1. ; NOTE: All entry points in this routine are internal ones. Do not
  1. ; call it from outside of routines that validate miscellaneous
  1. ; exam parameters (^RAMAGU08, ^RAMAGU10, ^RAMAGU14, etc.).
  1. ;
  1. Q
  1. ;
  1. ;+++++ CHECKS THE FIELD VALUE
  1. ;
  1. ; PNODE Name of the parameter
  1. ; VALUE Parameter value
  1. ;
  1. ; FILE File number
  1. ; FIELD Field number
  1. ;
  1. ; [[.]IENS] IENS of the record. If this parameter is not defined
  1. ; or empty, a new IENS is automatically generated by
  1. ; the $$IENS^RAMAGU09.
  1. ;
  1. ; [REQUIRED] If this parameter is defined and not zero, then "@"
  1. ; or an empty string (deletion) are not allowed.
  1. ;
  1. ; Input variables:
  1. ; RAFDA
  1. ;
  1. ; Output variables:
  1. ; RAFDA
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Ok
  1. ;
  1. CHECKFLD(PNODE,VALUE,FILE,FIELD,IENS,REQUIRED) ;
  1. N RAMSG,RESULT
  1. I $G(REQUIRED) Q:VALUE?.1"@" $$IPVE^RAERR(PNODE)
  1. S:$G(IENS)="" IENS=$$IENS
  1. D VAL^DIE(FILE,IENS,FIELD,"F",VALUE,.RESULT,"RAFDA","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9)
  1. Q $S(RESULT="^":$$IPVE^RAERR(PNODE),1:0)
  1. ;
  1. ;+++++ GENERATES IENS FOR ADDING A RECORD TO A MULTIPLE
  1. ;
  1. ; Input variables:
  1. ; RAFDA
  1. ;
  1. ; Output variables:
  1. ; RAFDA
  1. ;
  1. IENS() ;
  1. S RAFDA("RACNT")=$G(RAFDA("RACNT"))+1
  1. Q "+"_RAFDA("RACNT")_","_RAFDA("RAIENS")
  1. ;
  1. ;+++++ VALIDATES EXAM CATEGORY SPECIFIC PARAMETERS
  1. ;
  1. ; RACAT Exam category
  1. ;
  1. ; Input variables:
  1. ; RAIENS, RAMISC
  1. ;
  1. ; Output variables:
  1. ; RAFDA, RAMISC
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Parameters are valid
  1. ;
  1. VALECPRM(RACAT) ;
  1. N ERRCNT,PNODE,RC,TMP
  1. S (ERRCNT,RC)=0
  1. ;---
  1. I RACAT="I" D ;--- Inpatient
  1. . ;--- Bedsection
  1. . S PNODE=$NA(RAMISC("BEDSECT"))
  1. . I $D(@PNODE)#10 D
  1. . . S TMP=$$VI($P(@PNODE,U))
  1. . . S:$$CHECKFLD(PNODE,TMP,70.03,19,RAIENS)<0 ERRCNT=ERRCNT+1
  1. . ;--- Service
  1. . S PNODE=$NA(RAMISC("SERVICE"))
  1. . I $D(@PNODE)#10 D
  1. . . S TMP=$$VI($P(@PNODE,U))
  1. . . S:$$CHECKFLD(PNODE,TMP,70.03,7,RAIENS)<0 ERRCNT=ERRCNT+1
  1. . ;--- Ward
  1. . S PNODE=$NA(RAMISC("WARD"))
  1. . I $D(@PNODE)#10 D
  1. . . S TMP=$$VI($P(@PNODE,U))
  1. . . S:$$CHECKFLD(PNODE,TMP,70.03,6,RAIENS)<0 ERRCNT=ERRCNT+1
  1. . ;---
  1. . K RAMISC("PRINCLIN")
  1. E D ;--- Other categories
  1. . ;--- Principal Clinic
  1. . S PNODE=$NA(RAMISC("PRINCLIN"))
  1. . I $D(@PNODE)#10 S RC=0 D
  1. . . S TMP=$$VI($P(@PNODE,U))
  1. . . S:$$CHECKFLD(PNODE,TMP,70.03,8,RAIENS,1)<0 ERRCNT=ERRCNT+1
  1. . ;---
  1. . F I="BEDSECT","SERVICE","WARD" K RAMISC(I)
  1. ;---
  1. Q $S(ERRCNT>0:-11,1:0)
  1. ;
  1. ;+++++ VALIDATES THE PARAMETER
  1. ;
  1. ; NAME Parameter name
  1. ;
  1. ; [SEQ] Sequential number of the parameter value. If this
  1. ; parameter is greater than 0, then the parameter
  1. ; value is loaded from the @NODE@(NAME,SEQ) node.
  1. ; Otherwise, the parameter value is loaded from the
  1. ; @NODE@(NAME) node.
  1. ;
  1. ; [[.]IENS] IENS of the record. If this parameter is not defined
  1. ; or empty, a new IENS is automatically generated by
  1. ; the $$IENS^RAMAGU09.
  1. ;
  1. ; [NODE] Base node in the RAMISC arrays. By default
  1. ; ($G(NODE)=""), the RAMISC variable is assumed.
  1. ;
  1. ; [FLAGS] Flags that control the execution (can be combined):
  1. ;
  1. ; C Perform the checks but do not record errors.
  1. ;
  1. ; O If this flag is defined, then the validated
  1. ; parameter is considered 'optional' regardless
  1. ; of requirements stored in the RAMSPSDEFS.
  1. ;
  1. ; R If this flag is defined, then the validated
  1. ; parameter is considered 'required' regardless
  1. ; of requirements stored in the RAMSPSDEFS.
  1. ;
  1. ; Input variables:
  1. ; RAFDA, RAMISC, RAMSPSDEFS
  1. ;
  1. ; Output variables:
  1. ; RAFDA
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Ok (parameter is not defined)
  1. ; >0 Ok (parameter is defined)
  1. ;
  1. VALPRM(NAME,SEQ,IENS,NODE,FLAGS) ;
  1. N FILE,FIELD,LSTPRM,PNODE,PRMDEF,RAMSG,RARES,RC,REQUIRED,TMP,TYPE,VALUE
  1. S:$G(NODE)="" NODE="RAMISC"
  1. S PNODE=$S($G(SEQ)>0:$NA(@NODE@(NAME,SEQ)),1:$NA(@NODE@(NAME)))
  1. ;
  1. ;=== Check the flags
  1. S FLAGS=$G(FLAGS),TMP=0
  1. S:FLAGS["O" REQUIRED=0,TMP=TMP+1
  1. S:FLAGS["R" REQUIRED=1,TMP=TMP+1
  1. Q:TMP>1 $$IPVE^RAERR("FLAGS")
  1. ;
  1. ;=== Get the parameter definition
  1. S PRMDEF=$G(RAMSPSDEFS("N",NAME))
  1. S FILE=+$P(PRMDEF,U),FIELD=+$P(PRMDEF,U,2),TYPE=$P(PRMDEF,U,3)
  1. S LSTPRM=(TYPE["M")&($G(SEQ)'>0) ; "List" mode
  1. Q:(FILE'>0)!('LSTPRM&(FIELD'>0)) $$ERROR^RAERR(-58,,NAME)
  1. S:$G(IENS)="" IENS=$$IENS
  1. ;
  1. ;=== Preserve the error stack so that errors are not recorded
  1. I FLAGS["C" N RAERROR
  1. ;
  1. ;=== Unless overridden by the caller, determine
  1. ;=== if the field value is required
  1. D:$G(REQUIRED)=""
  1. . ;--- .01 fields are required
  1. . I FIELD=.01,'LSTPRM S REQUIRED=1 Q
  1. . ;--- Ignore missing required values if the flag is set
  1. . I $G(RAMISC("FLAGS"))["F" S REQUIRED=0 Q
  1. . ;--- Check the parameter definition
  1. . S TMP=+$P(PRMDEF,U,4)
  1. . S REQUIRED=$S(TMP>0:+$P($G(RAMSPSDEFS("R")),U,TMP),1:0)
  1. ;
  1. ;=== If the API is called in "list" mode, check if the parameter
  1. ; list is provided. If it is not but the values are required
  1. ; for the new exam status, check if the corresponding multiple
  1. ;=== has any records already.
  1. I LSTPRM S RC=0 D:$D(@PNODE)<10 Q $S(RC<0:RC,1:$D(@PNODE)>0)
  1. . N ROOT
  1. . ;--- Check for data deletion request
  1. . I $D(@PNODE)#10 D Q
  1. . . ;--- Deletion of required data is not allowed
  1. . . I REQUIRED S RC=$$IPVE^RAERR(PNODE) Q
  1. . . ;--- Mark the multiple for deletion
  1. . . K RAFDA(FILE) S RAFDA(FILE)=""
  1. . ;--- Check if the multiple field has any records
  1. . Q:'REQUIRED
  1. . S TMP=","_RAFDA("RAIENS"),ROOT=$$ROOT^DILFD(FILE,TMP,1)
  1. . I ROOT="" S RC=$$ERROR^RAERR(-50,,FILE,TMP) Q
  1. . S:$O(@ROOT@(0))'>0 RC=$$ERROR^RAERR(-8,,PNODE)
  1. ;
  1. ;=== If the parameter is not provided but the value is required
  1. ; for the new exam status, check if the corresponding field
  1. ;=== has a non-empty value already.
  1. I '$D(@PNODE) S RC=0 D:REQUIRED Q $S(RC<0:RC,1:0)
  1. . ;--- If the IENS starts with a placeholder, then there is no data
  1. . S TMP=$P($G(IENS),",")
  1. . I 'TMP!(+TMP'=TMP) S RC=$$ERROR^RAERR(-8,,PNODE) Q
  1. . ;--- Word processing field
  1. . I TYPE["W" D Q
  1. . . N I,RABUF
  1. . . S TMP=$$GET1^DIQ(FILE,IENS,FIELD,,"RABUF","RAMSG")
  1. . . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,FILE,IENS) Q
  1. . . S I=0,RC=1
  1. . . F S I=$O(RABUF(I)) Q:I'>0 I RABUF(I)'?." " S RC=0 Q
  1. . . S:RC RC=$$ERROR^RAERR(-8,,PNODE)
  1. . ;--- Other field types
  1. . S TMP=$$GET1^DIQ(FILE,IENS,FIELD,"I",,"RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,FILE,IENS) Q
  1. . S:TMP="" RC=$$ERROR^RAERR(-8,,PNODE)
  1. ;
  1. ;=== Validate the word-processing parameter
  1. I TYPE["W" S RC=0 D Q $S(RC<0:RC,1:1)
  1. . N I
  1. . ;--- Check for data deletion request
  1. . I $D(@PNODE)<10 D Q
  1. . . I REQUIRED!(@PNODE'?.1"@") S RC=$$IPVE^RAERR(PNODE) Q
  1. . . S RAFDA(FILE,IENS,FIELD)="@"
  1. . ;--- Check if the value is not empty
  1. . S I=0,RC=1
  1. . F S I=$O(@PNODE@(I)) Q:I'>0 I @PNODE@(I)'?." " S RC=0 Q
  1. . I RC S RC=$$IPVE^RAERR(PNODE) Q ;p219/KLM - INC34423845
  1. . S RAFDA(FILE,IENS,FIELD)=PNODE
  1. ;
  1. ;=== Pre-process the parameter value according to the field type.
  1. ;=== Deletion of required field values is never allowed.
  1. S VALUE=$P($G(@PNODE),U)
  1. I VALUE'?.1"@" D
  1. . ;--- Pre-process the parameter value according to the field type
  1. . I TYPE["P" S VALUE=$$VI(VALUE) Q
  1. . I TYPE["D" S VALUE=$$FMTE^XLFDT(VALUE) Q
  1. E Q:REQUIRED $$IPVE^RAERR(PNODE)
  1. ;
  1. ;=== Let the FileMan validate the parameter value
  1. D VAL^DIE(FILE,IENS,FIELD,"F",VALUE,.RARES,"RAFDA","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9)
  1. Q $S(RARES="^":$$IPVE^RAERR(PNODE),1:1)
  1. ;
  1. ;+++++ RETURNS PSEUDO-EXTERNAL VALUE OF THE IEN
  1. VI(IEN) ;
  1. Q $S(IEN?.1"@":IEN,1:"`"_IEN)