BMCRCHK.m

BMCRCHK ; IHS/PHXAO/TMJ - Check Provisional Primary DX ;

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;

 ;This routine checks to insure at least one of the DX's is Primary

 ;If no Primary Dx exists or more than one Do DX OF BMCMOD

 ;to edit existing DX's

 ;

START ;Order through the RCIS DX Gbl

 Q:'$D(^BMCDX("AD",BMCRIEN))

 K BMCDX

 D DXCHK

 D DXMSG

 D END

 Q

 ;

DXCHK ;Check Diagnosis Entries

 S BMCDXASK=0

 S BMCDXCT=0

 S BMCDX=""

 F  S BMCDX=$O(^BMCDX("AD",BMCRIEN,BMCDX)) Q:BMCDX'=+BMCDX  D

 .I $P(^BMCDX(BMCDX,0),U,5)="P" S BMCDXCT=BMCDXCT+1

 .Q

 Q

DXMSG ;Check if Primary DX Exists

 I BMCDXCT=0 W !!,"WARNING-No Primary Diagnosis exists for this Referral-Please enter a Primary DX",!,$C(7) H 5 S BMCDXASK=1

 E  I BMCDXCT>1 W !!,"Multiple Primary Diagnosis exist for this Referral-Only one please",!,$C(7) H 5 S BMCDXASK=1

 ;H 5

 Q

END ;Kill Variables

 K BMCDX,BMCDXIEN,BMCDXCT

 Q

 ;

BMCRCHK   ; IHS/PHXAO/TMJ - Check Provisional Primary DX ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3       ;This routine checks to insure at least one of the DX's is Primary

 +4       ;If no Primary Dx exists or more than one Do DX OF BMCMOD

 +5       ;to edit existing DX's

 +6       ;

START     ;Order through the RCIS DX Gbl

 +1        IF '$DATA(^BMCDX("AD",BMCRIEN))

               QUIT 

 +2        KILL BMCDX

 +3        DO DXCHK

 +4        DO DXMSG

 +5        DO END

 +6        QUIT 

 +7       ;

DXCHK     ;Check Diagnosis Entries

 +1        SET BMCDXASK=0

 +2        SET BMCDXCT=0

 +3        SET BMCDX=""

 +4        FOR 

               SET BMCDX=$ORDER(^BMCDX("AD",BMCRIEN,BMCDX))

               IF BMCDX'=+BMCDX

                   QUIT 

               Begin DoDot:1

 +5                IF $PIECE(^BMCDX(BMCDX,0),U,5)="P"

                       SET BMCDXCT=BMCDXCT+1

 +6                QUIT 

               End DoDot:1

 +7        QUIT 

DXMSG     ;Check if Primary DX Exists

 +1        IF BMCDXCT=0

               WRITE !!,"WARNING-No Primary Diagnosis exists for this Referral-Please enter a Primary DX",!,$CHAR(7)

               HANG 5

               SET BMCDXASK=1

 +2       IF '$TEST

               IF BMCDXCT>1

                   WRITE !!,"Multiple Primary Diagnosis exist for this Referral-Only one please",!,$CHAR(7)

                   HANG 5

                   SET BMCDXASK=1

 +3       ;H 5

 +4        QUIT 

END       ;Kill Variables

 +1        KILL BMCDX,BMCDXIEN,BMCDXCT

 +2        QUIT 

 +3       ;