BMCLKID1.m

BMCLKID1 ; IHS/PHXAO/TMJ - IDENTIFIERS FOR REFERRAL LOOKUP 2 ;    [ 09/27/2006  1:37 PM ]

 ;;4.0;REFERRED CARE INFO SYSTEM;**1**;JAN 09, 2006;Build 101

 ;This Routine Displays Lookup for BMCREF Global

 ;This routine is called from ^BMCADD and uses different global

 ;references than ^BMCLKID

 ;

 ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ ADDED NUMBER COUNT DISPLAY FOR CALLED BY BMCLKID2 AND FIXED THE UNKNOWN SERVICE DATE PRINT

 ;At Lookup - Displays Date Initiated

 ;            Referral Number

 ;            Patient Name

 ;            Facility or Provider Referred To

 ;            Purpose of Referral

 ;    If Facility Referred to or Purpose are Null Displays UNKNOWN

 ;

START ; EXTERNAL ENTRY POINT - 

 ; DISPLAY OF REFERRALS BEFORE ADDING NEW REFERRAL AND DISPLAYING

 W !

 W:$G(BMCFLG) BMCCT_". "  ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ

 S BMCRDT=$$REFDTI^BMCRLU(BMCRIEN,"S") S BMCRDTP=$S(BMCRDT'="":BMCRDT,1:"UNKNOWN DATE INITIATED") W ?4,BMCRDTP

 W ?13,$P(^BMCREF(BMCRIEN,0),U,2),$P($G(^BMCREF(BMCRIEN,1)),U)," "

 S BMCPAT=$P(^DPT(BMCDFN,0),U) W:'$G(BMCFLG) $E(BMCPAT,1,15)," "

 S BMCRFAC=$$FACREF^BMCRLU(BMCRIEN) W ?50,$E($S(BMCRFAC'="":BMCRFAC,1:"UNKNOWN"),1,30)

 ;Returns either Estimated or Actual Beg Service Date

 ;S BMCSVDT=$$AVDOS^BMCRLU(BMCRIEN,"C") S BMCSVDTP=$S(BMCSVDT'="":BMCSVDT,1:"UNKNOWN SERVICE DATE") W !,?25,BMCSVDTP  ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ

 S BMCVST=$P($G(^BMCREF(BMCRIEN,11)),U,11) S BMCVSTP=$S(BMCVST'="":BMCVST,1:"I") ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ

 S BMCSVDT=$$AVDOS^BMCRLU(BMCRIEN,"C") S BMCSVDTP=$S(BMCSVDT'="":BMCSVDT,1:"UNKNOWN SERVICE DATE") W !,?25,BMCSVDTP_" - "_BMCVSTP  ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ

 ;

 S BMCPURP=$P($G(^BMCREF(BMCRIEN,12)),U) S BMCPURPP=$S(BMCPURP'="":BMCPURP,1:"Purpose - NONE RECORDED") W ?50,$E(BMCPURPP,1,30)

 W !

 S BMCRNUMB=$P(^BMCREF(BMCRIEN,0),U,2)

 I $P($G(^BMCREF(BMCRIEN,1)),U)="" D SEC^BMCLKID

XIT ;Kill off Variables no longer needed

 K BMCPAT,BMCPTDFN,BMCPURP,BMCPURPP,BMCRFAC,BMCSVDT,BMCSVDTP,BMCRDT,BMCRDTP,BMCRNUMB

 Q

 ;

 ;

BMCLKID1  ; IHS/PHXAO/TMJ - IDENTIFIERS FOR REFERRAL LOOKUP 2 ;    [ 09/27/2006  1:37 PM ]

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

 +2       ;This Routine Displays Lookup for BMCREF Global

 +3       ;This routine is called from ^BMCADD and uses different global

 +4       ;references than ^BMCLKID

 +5       ;

 +6       ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ ADDED NUMBER COUNT DISPLAY FOR CALLED BY BMCLKID2 AND FIXED THE UNKNOWN SERVICE DATE PRINT

 +7       ;At Lookup - Displays Date Initiated

 +8       ;            Referral Number

 +9       ;            Patient Name

 +10      ;            Facility or Provider Referred To

 +11      ;            Purpose of Referral

 +12      ;    If Facility Referred to or Purpose are Null Displays UNKNOWN

 +13      ;

START     ; EXTERNAL ENTRY POINT - 

 +1       ; DISPLAY OF REFERRALS BEFORE ADDING NEW REFERRAL AND DISPLAYING

 +2        WRITE !

 +3       ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ

           IF $GET(BMCFLG)

               WRITE BMCCT_". "

 +4        SET BMCRDT=$$REFDTI^BMCRLU(BMCRIEN,"S")

           SET BMCRDTP=$SELECT(BMCRDT'="":BMCRDT,1:"UNKNOWN DATE INITIATED")

           WRITE ?4,BMCRDTP

 +5        WRITE ?13,$PIECE(^BMCREF(BMCRIEN,0),U,2),$PIECE($GET(^BMCREF(BMCRIEN,1)),U)," "

 +6        SET BMCPAT=$PIECE(^DPT(BMCDFN,0),U)

           IF '$GET(BMCFLG)

               WRITE $EXTRACT(BMCPAT,1,15)," "

 +7        SET BMCRFAC=$$FACREF^BMCRLU(BMCRIEN)

           WRITE ?50,$EXTRACT($SELECT(BMCRFAC'="":BMCRFAC,1:"UNKNOWN"),1,30)

 +8       ;Returns either Estimated or Actual Beg Service Date

 +9       ;S BMCSVDT=$$AVDOS^BMCRLU(BMCRIEN,"C") S BMCSVDTP=$S(BMCSVDT'="":BMCSVDT,1:"UNKNOWN SERVICE DATE") W !,?25,BMCSVDTP  ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ

 +10      ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ

           SET BMCVST=$PIECE($GET(^BMCREF(BMCRIEN,11)),U,11)

           SET BMCVSTP=$SELECT(BMCVST'="":BMCVST,1:"I")

 +11      ;BMC*4.0*1 4.9.06 IHS/OIT/FCJ

           SET BMCSVDT=$$AVDOS^BMCRLU(BMCRIEN,"C")

           SET BMCSVDTP=$SELECT(BMCSVDT'="":BMCSVDT,1:"UNKNOWN SERVICE DATE")

           WRITE !,?25,BMCSVDTP_" - "_BMCVSTP

 +12      ;

 +13       SET BMCPURP=$PIECE($GET(^BMCREF(BMCRIEN,12)),U)

           SET BMCPURPP=$SELECT(BMCPURP'="":BMCPURP,1:"Purpose - NONE RECORDED")

           WRITE ?50,$EXTRACT(BMCPURPP,1,30)

 +14       WRITE !

 +15       SET BMCRNUMB=$PIECE(^BMCREF(BMCRIEN,0),U,2)

 +16       IF $PIECE($GET(^BMCREF(BMCRIEN,1)),U)=""

               DO SEC^BMCLKID

XIT       ;Kill off Variables no longer needed

 +1        KILL BMCPAT,BMCPTDFN,BMCPURP,BMCPURPP,BMCRFAC,BMCSVDT,BMCSVDTP,BMCRDT,BMCRDTP,BMCRNUMB

 +2        QUIT 

 +3       ;

 +4       ;