RAO7VLD.m

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)

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)