BMXUTL2.m

BMXUTL2 ; IHS/OIT/HMW - UTIL: PATIENT INFO ;

 ;;4.0;BMX;;JUN 28, 2010

 ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  UTILITY: PATIENT FUNCTIONS: CONTRAS, INPATIENT, HIDOSE.

 ;

NEXTAPPT(BMXDFN) ;EP

 ;---> Return patient's next appointment from Scheduling Package.

 ;---> Parameters:

 ;     1 - BMXDFN  (req) Patient's IEN (BMXDFN).

 ;

 Q:'$G(BMXDFN) ""

 Q:'$D(^DPT(BMXDFN)) ""

 ;

 N BMXAPPT,BMXDT,BMXYES

 S BMXDT=DT+.2400,BMXYES=0

 F  S BMXDT=$O(^DPT(BMXDFN,"S",BMXDT)) Q:'BMXDT!(BMXYES)  D

 .N BMXDATA,BMXOI,X

 .S BMXDATA=$G(^DPT(BMXDFN,"S",BMXDT,0))

 .Q:BMXDATA=""

 .;

 .;---> Quit if appointment is cancelled.

 .Q:$P(BMXDATA,U,2)["C"

 .;

 .S X=0 F  S X=$O(^SC(+BMXDATA,"S",BMXDT,1,X)) Q:'X  D

 ..Q:+$G(^SC(+BMXDATA,"S",BMXDT,1,X,0))'=BMXDFN

 ..S BMXYES=BMXDT_U_+BMXDATA

 ;

 Q:'BMXYES ""

 ;

 S BMXAPPT=$$FMTE^XLFDT(+BMXYES,"1P")_" with "

 S BMXAPPT=BMXAPPT_$P($G(^SC($P(BMXYES,U,2),0)),U)

 Q BMXAPPT

BMXUTL2   ; IHS/OIT/HMW - UTIL: PATIENT INFO ;

 +1       ;;4.0;BMX;;JUN 28, 2010

 +2       ;;Stolen from:* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  UTILITY: PATIENT FUNCTIONS: CONTRAS, INPATIENT, HIDOSE.

 +4       ;

NEXTAPPT(BMXDFN) ;EP

 +1       ;---> Return patient's next appointment from Scheduling Package.

 +2       ;---> Parameters:

 +3       ;     1 - BMXDFN  (req) Patient's IEN (BMXDFN).

 +4       ;

 +5        IF '$GET(BMXDFN)

               QUIT ""

 +6        IF '$DATA(^DPT(BMXDFN))

               QUIT ""

 +7       ;

 +8        NEW BMXAPPT,BMXDT,BMXYES

 +9        SET BMXDT=DT+.2400

           SET BMXYES=0

 +10       FOR 

               SET BMXDT=$ORDER(^DPT(BMXDFN,"S",BMXDT))

               IF 'BMXDT!(BMXYES)

                   QUIT 

               Begin DoDot:1

 +11               NEW BMXDATA,BMXOI,X

 +12               SET BMXDATA=$GET(^DPT(BMXDFN,"S",BMXDT,0))

 +13               IF BMXDATA=""

                       QUIT 

 +14      ;

 +15      ;---> Quit if appointment is cancelled.

 +16               IF $PIECE(BMXDATA,U,2)["C"

                       QUIT 

 +17      ;

 +18               SET X=0

                   FOR 

                       SET X=$ORDER(^SC(+BMXDATA,"S",BMXDT,1,X))

                       IF 'X

                           QUIT 

                       Begin DoDot:2

 +19                       IF +$GET(^SC(+BMXDATA,"S",BMXDT,1,X,0))'=BMXDFN

                               QUIT 

 +20                       SET BMXYES=BMXDT_U_+BMXDATA

                       End DoDot:2

               End DoDot:1

 +21      ;

 +22       IF 'BMXYES

               QUIT ""

 +23      ;

 +24       SET BMXAPPT=$$FMTE^XLFDT(+BMXYES,"1P")_" with "

 +25       SET BMXAPPT=BMXAPPT_$PIECE($GET(^SC($PIECE(BMXYES,U,2),0)),U)

 +26       QUIT BMXAPPT