MCARUTL5.m

MCARUTL5 ;HOIFO/WAA-UTILITY FOR VALIDATING ENTRY ;04/13/01  12:00

 ;;2.3;Medicine;**33**;09/13/1996

 ; 

 ; VALID Validation function

 ; 

 ; MC*2.3*33 this is a new module to validate the entry

 ; is for the stated patient and matched the one on the "AC"

 ; The subroutine will work out the "AC" from the procedure.

 ; This will ensure that "AC" that the main program is using

 ; and the "AC" that I am building are one and the same.

 ; if they don't match I will not validate it.

 ;

 ;Input:

 ; ROOT = The root Global Reference for the entry.

 ; IEN = The Internal entry number for the procedure being checked

 ; DFN = The Patient DFN with in the Medicine Patient file.

 ;

 ;Outout:

 ; VALID = 1 or 0

 ;         1 = The entry is a procedure for the indicated Patient

 ;         0 = The entry is not a procedure for the indicated Patient

 ;

VALID(ROOT,IEN,DFN) ; Main entry point for this function

 N VALID,LINE,FN

 S VALID=0 ; Init VALID to 0

 S FN=$P(ROOT,"(",2) ; parce out the internal entry number

 S LINE=$G(^MCAR(FN,IEN,0)) ; validate that the entry exists

 I LINE'="" D

 . N IEN697,PL,PRODFN,PRODT

 . S IEN697=$O(^MCAR(697.2,"C",ROOT,0)) Q:IEN697<1  ; get the procedure info

 . S PL=$P(^MCAR(697.2,IEN697,0),U,12) Q:PL=""  ; get the location if the pat DFN within the procedure

 . S PRODFN=$$GET1^DIQ(FN,IEN,PL,"I") Q:PRODFN<1  ; get the pat DFN

 . Q:PRODFN'=DFN  ; compare the pat DFN from the procedure with the passed DFN

 . S PRODT=9999999.9999-$P(LINE,U) ; get the Procedure date and invert it

 . I '$D(^MCAR(690,"AC",PRODFN,PRODT,ROOT,IEN)) Q  ; check to see if the entry is in the a valid entry within 690 "AC" Xref

 . S VALID=1 ; Valid entry

 . Q

 Q VALID

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MCARUTL5   1709     printed  Apr 09, 2024@21:16:50                                                                                                                                                                                                    Page 2

MCARUTL5  ;HOIFO/WAA-UTILITY FOR VALIDATING ENTRY ;04/13/01  12:00

 +1       ;;2.3;Medicine;**33**;09/13/1996

 +2       ; 

 +3       ; VALID Validation function

 +4       ; 

 +5       ; MC*2.3*33 this is a new module to validate the entry

 +6       ; is for the stated patient and matched the one on the "AC"

 +7       ; The subroutine will work out the "AC" from the procedure.

 +8       ; This will ensure that "AC" that the main program is using

 +9       ; and the "AC" that I am building are one and the same.

 +10      ; if they don't match I will not validate it.

 +11      ;

 +12      ;Input:

 +13      ; ROOT = The root Global Reference for the entry.

 +14      ; IEN = The Internal entry number for the procedure being checked

 +15      ; DFN = The Patient DFN with in the Medicine Patient file.

 +16      ;

 +17      ;Outout:

 +18      ; VALID = 1 or 0

 +19      ;         1 = The entry is a procedure for the indicated Patient

 +20      ;         0 = The entry is not a procedure for the indicated Patient

 +21      ;

VALID(ROOT,IEN,DFN) ; Main entry point for this function

 +1        NEW VALID,LINE,FN

 +2       ; Init VALID to 0

           SET VALID=0

 +3       ; parce out the internal entry number

           SET FN=$PIECE(ROOT,"(",2)

 +4       ; validate that the entry exists

           SET LINE=$GET(^MCAR(FN,IEN,0))

 +5        IF LINE'=""

               Begin DoDot:1

 +6                NEW IEN697,PL,PRODFN,PRODT

 +7       ; get the procedure info

                   SET IEN697=$ORDER(^MCAR(697.2,"C",ROOT,0))

                   if IEN697<1

                       QUIT 

 +8       ; get the location if the pat DFN within the procedure

                   SET PL=$PIECE(^MCAR(697.2,IEN697,0),U,12)

                   if PL=""

                       QUIT 

 +9       ; get the pat DFN

                   SET PRODFN=$$GET1^DIQ(FN,IEN,PL,"I")

                   if PRODFN<1

                       QUIT 

 +10      ; compare the pat DFN from the procedure with the passed DFN

                   if PRODFN'=DFN

                       QUIT 

 +11      ; get the Procedure date and invert it

                   SET PRODT=9999999.9999-$PIECE(LINE,U)

 +12      ; check to see if the entry is in the a valid entry within 690 "AC" Xref

                   IF '$DATA(^MCAR(690,"AC",PRODFN,PRODT,ROOT,IEN))

                       QUIT 

 +13      ; Valid entry

                   SET VALID=1

 +14               QUIT 

               End DoDot:1

 +15       QUIT VALID