- RAO7VLD ;HISC/GJC-Validate OE/RR data to Rad (frontdoor) ;1/6/98 13:02
- ;;5.0;Radiology/Nuclear Medicine;**75**;Mar 16, 1998;Build 4
- ;
- EN1(RAA,RAB,RAC,RAX,RAY,RAZ) ; Pass in parameters to validate data
- ; Returns '0' if data is valid, '1' if data is invalid
- ; This call is not used on pointer type data fields.
- ; ***** variable list *****
- ; RAA=file # RAB=field #
- ; RAC=flag parameters RAX=value being checked
- ; RAY=result of call array RAZ=Error Array (not used)
- ;***********************************************************************
- K %DT(0) D CHK^DIE(RAA,RAB,RAC,RAX,.RAY)
- Q $S(RAY["^":1,1:0)
- ;
- EN2(T1,T2,T3) ;
- ; Pass in parameters to validate pointer type data.
- ; This call is only used on pointer type data fields.
- ; ***** variable list *****
- ; T1=file # T2=IEN (if app) T3=.01 fields value
- ; X=0 if proper match, 1 if no match Y=global node (assumed to be '0')
- ;***********************************************************************
- N X,Y,Z S X=0
- F Z=$G(T1),$G(T2),$G(T3) S:Z']"" X=1 Q:X
- Q:X X ; all parameters must be defined
- S Y=$G(@(^DIC(T1,0,"GL")_T2_",0)"))
- Q $S($P(Y,"^")=T3:0,1:1)
- EN3(X,Y) ; does entry exist in a file
- ; X-> file # 'Y'-> ien
- ; 0 if entry exists, 1 if entry does not exist
- Q $S($D(@(^DIC(+X,0,"GL")_+Y_",0)"))#2:0,1:1)
- ;
- EN4(X) ;P75 Check CPRS entered CLINICAL HISTORY text for validity.
- ;This function returns: 1 if the string is valid else 0.
- ;Please note that once the data is valid, (a minimum of two
- ;alphanumeric characters on a character string) subsequent data
- ;strings may not be valid but are still stored.
- N CHAR,CNT,FLG,I,LEN S (CNT,FLG)=0,LEN=$L(X)
- F I=1:1:LEN D Q:FLG
- .S CHAR=$E(X,I)
- .S:CHAR?1AN CNT=CNT+1
- .I CHAR'?1AN,(CNT) S CNT=0
- .S:CNT=2 FLG=1
- .Q
- Q FLG
- ;
- EN5(RAD0,RANSTAT,RADUZ,RAREA) ; update the 'REQUEST STATUS TIMES' multiple
- ; in the Rad/Nuc Med Orders file. All parameters must be in the
- ; internal format.
- ; RAD0=top level ien RANSTAT=new status
- ; RADUZ=user ien RAREA=reason for status change
- ; Pass back '1' if error, '0' if no error.
- N ARR
- S ARR(7,75.12,"+1,"_RAD0_",",".01")=RALDT
- S ARR(7,75.12,"+1,"_RAD0_",",2)=RANSTAT
- S ARR(7,75.12,"+1,"_RAD0_",",3)=RADUZ
- S ARR(7,75.12,"+1,"_RAD0_",",4)=RAREA
- D UPDATE^DIE("","ARR(7)")
- Q +$G(DIERR)
- EN6(X) ; Check if parent procedure has descendents
- ; Passes back: 0 if descendents else 1
- ; X is the ien of the procedure (71)
- Q $S(+$O(^RAMIS(71,X,4,0)):0,1:1)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAO7VLD 2585 printed Jan 18, 2025@03:38:59 Page 2
- RAO7VLD ;HISC/GJC-Validate OE/RR data to Rad (frontdoor) ;1/6/98 13:02
- +1 ;;5.0;Radiology/Nuclear Medicine;**75**;Mar 16, 1998;Build 4
- +2 ;
- EN1(RAA,RAB,RAC,RAX,RAY,RAZ) ; Pass in parameters to validate data
- +1 ; Returns '0' if data is valid, '1' if data is invalid
- +2 ; This call is not used on pointer type data fields.
- +3 ; ***** variable list *****
- +4 ; RAA=file # RAB=field #
- +5 ; RAC=flag parameters RAX=value being checked
- +6 ; RAY=result of call array RAZ=Error Array (not used)
- +7 ;***********************************************************************
- +8 KILL %DT(0)
- DO CHK^DIE(RAA,RAB,RAC,RAX,.RAY)
- +9 QUIT $SELECT(RAY["^":1,1:0)
- +10 ;
- EN2(T1,T2,T3) ;
- +1 ; Pass in parameters to validate pointer type data.
- +2 ; This call is only used on pointer type data fields.
- +3 ; ***** variable list *****
- +4 ; T1=file # T2=IEN (if app) T3=.01 fields value
- +5 ; X=0 if proper match, 1 if no match Y=global node (assumed to be '0')
- +6 ;***********************************************************************
- +7 NEW X,Y,Z
- SET X=0
- +8 FOR Z=$GET(T1),$GET(T2),$GET(T3)
- if Z']""
- SET X=1
- if X
- QUIT
- +9 ; all parameters must be defined
- if X
- QUIT X
- +10 SET Y=$GET(@(^DIC(T1,0,"GL")_T2_",0)"))
- +11 QUIT $SELECT($PIECE(Y,"^")=T3:0,1:1)
- EN3(X,Y) ; does entry exist in a file
- +1 ; X-> file # 'Y'-> ien
- +2 ; 0 if entry exists, 1 if entry does not exist
- +3 QUIT $SELECT($DATA(@(^DIC(+X,0,"GL")_+Y_",0)"))#2:0,1:1)
- +4 ;
- EN4(X) ;P75 Check CPRS entered CLINICAL HISTORY text for validity.
- +1 ;This function returns: 1 if the string is valid else 0.
- +2 ;Please note that once the data is valid, (a minimum of two
- +3 ;alphanumeric characters on a character string) subsequent data
- +4 ;strings may not be valid but are still stored.
- +5 NEW CHAR,CNT,FLG,I,LEN
- SET (CNT,FLG)=0
- SET LEN=$LENGTH(X)
- +6 FOR I=1:1:LEN
- Begin DoDot:1
- +7 SET CHAR=$EXTRACT(X,I)
- +8 if CHAR?1AN
- SET CNT=CNT+1
- +9 IF CHAR'?1AN
- IF (CNT)
- SET CNT=0
- +10 if CNT=2
- SET FLG=1
- +11 QUIT
- End DoDot:1
- if FLG
- QUIT
- +12 QUIT FLG
- +13 ;
- EN5(RAD0,RANSTAT,RADUZ,RAREA) ; update the 'REQUEST STATUS TIMES' multiple
- +1 ; in the Rad/Nuc Med Orders file. All parameters must be in the
- +2 ; internal format.
- +3 ; RAD0=top level ien RANSTAT=new status
- +4 ; RADUZ=user ien RAREA=reason for status change
- +5 ; Pass back '1' if error, '0' if no error.
- +6 NEW ARR
- +7 SET ARR(7,75.12,"+1,"_RAD0_",",".01")=RALDT
- +8 SET ARR(7,75.12,"+1,"_RAD0_",",2)=RANSTAT
- +9 SET ARR(7,75.12,"+1,"_RAD0_",",3)=RADUZ
- +10 SET ARR(7,75.12,"+1,"_RAD0_",",4)=RAREA
- +11 DO UPDATE^DIE("","ARR(7)")
- +12 QUIT +$GET(DIERR)
- EN6(X) ; Check if parent procedure has descendents
- +1 ; Passes back: 0 if descendents else 1
- +2 ; X is the ien of the procedure (71)
- +3 QUIT $SELECT(+$ORDER(^RAMIS(71,X,4,0)):0,1:1)