BMCTEST.m

BMCTEST ; IHS/PHXAO/TMJ - TEST OF LAST FY REFERRAL ; 

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

 S BMCSTART=60640101

 ;S BMCXLAST=$O(^BMCREF("FY",BMCSTART,"")),BMCXVDFN=$O(^BMCREF("FY",BMCSTART,BMCXLAST,""))

 ;W BMCXVDFN,!

 ;W BMCXLAST,!

 ;W BMCXLAST-1,!

 ;Q

 ;

ANOTHER ;

REFDISP ;Display if Patient has existing Referrals

 W !!,?25,"********************",!

 W ?25,"**LAST 5 REFERRALS**",!,?25,"********************",!

 I '$D(^BMCREF("FY",BMCSTART)) W !,?20,"**--NO EXISTING REFERRALS--**",! S BMCQ=1 Q

 S BMCQ=0

 S BMCIEN=""

 F I=1:1:5 S BMCIEN=$O(^BMCREF("FY",BMCSTART,BMCIEN),-1) Q:BMCIEN=""  D

 . Q:BMCIEN=""

 . ;Q:BMCRIEN=""

 . ;D START^BMCLKID1

 . ;S I=I+1 ; increment outer loop counter to limit display to 5 referrals

 . W BMCIEN,!

 . Q

 Q

BMCTEST   ; IHS/PHXAO/TMJ - TEST OF LAST FY REFERRAL ; 

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

 +2        SET BMCSTART=60640101

 +3       ;S BMCXLAST=$O(^BMCREF("FY",BMCSTART,"")),BMCXVDFN=$O(^BMCREF("FY",BMCSTART,BMCXLAST,""))

 +4       ;W BMCXVDFN,!

 +5       ;W BMCXLAST,!

 +6       ;W BMCXLAST-1,!

 +7       ;Q

 +8       ;

ANOTHER   ;

REFDISP   ;Display if Patient has existing Referrals

 +1        WRITE !!,?25,"********************",!

 +2        WRITE ?25,"**LAST 5 REFERRALS**",!,?25,"********************",!

 +3        IF '$DATA(^BMCREF("FY",BMCSTART))

               WRITE !,?20,"**--NO EXISTING REFERRALS--**",!

               SET BMCQ=1

               QUIT 

 +4        SET BMCQ=0

 +5        SET BMCIEN=""

 +6        FOR I=1:1:5

               SET BMCIEN=$ORDER(^BMCREF("FY",BMCSTART,BMCIEN),-1)

               IF BMCIEN=""

                   QUIT 

               Begin DoDot:1

 +7                IF BMCIEN=""

                       QUIT 

 +8       ;Q:BMCRIEN=""

 +9       ;D START^BMCLKID1

 +10      ;S I=I+1 ; increment outer loop counter to limit display to 5 referrals

 +11               WRITE BMCIEN,!

 +12               QUIT 

               End DoDot:1

 +13       QUIT