Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMCLKID2

BMCLKID2.m

Go to the documentation of this file.
  1. BMCLKID2 ; IHS/OIT/FCJ - IDENTIFIERS FOR REFERRAL LOOKUP 3 ; [ 09/27/2006 2:03 PM ]
  1. ;;4.0;REFERRED CARE INFO SYSTEM;**2**;JAN 09, 2006;Build 101
  1. ;4.0*2 IHS/OIT/FCJ Added Entry point for API rtn
  1. ; and test variable to screen closed variables and sec ref
  1. ;This Routine Displays Lookup for BMCREF Global
  1. ;This routine is called from ^BMCRDSP and if selected by patient name
  1. ;then display of last entered referral is displayed first
  1. ;
  1. ;At Lookup - Displays Date Initiated
  1. ; Referral Number
  1. ; Facility or Provider Referred To
  1. ; Purpose of Referral
  1. ; If Facility Referred to or Purpose are Null Displays UNKNOWN
  1. ;
  1. START ; ENTRY POINT -
  1. ; IF DISPLAY SELECTED BY PATIENT AND LAST IN FIRST OUT DISPLAY OF REF
  1. W !
  1. S DIR(0)="FO^1:30"
  1. S DIR("A")="Select RCIS REFERRAL by Patient or by Referral Date or #"
  1. S DIR("?")="Enter the Patient name, Referral # or last 5 digits of referral # (and) secondary suffix."
  1. D ^DIR K DIR Q:$D(DIRUT)!$D(DTOUT)
  1. I Y=" " S Y=^DISV(DUZ,"^BMCREF(") G REFLKUP1
  1. W !,Y S X=Y
  1. I $E(Y,1)?1A D PATLKUP,XIT Q
  1. REFLKUP ;
  1. S DIC="^BMCREF(",DIC(0)="QEM",X=Y
  1. D DIC^BMCFMC
  1. Q:Y<1
  1. REFLKUP1 S BMCRIEN=+Y
  1. D XIT
  1. Q
  1. PATLKUP ;EP FOR PATIENT LOOK UP CALLED BY BMCAPI ;BMC*4.0*2 IHS/OIT/FCJ
  1. S DIC="^AUPNPAT(",DIC(0)="QEM",X=Y
  1. D DIC^BMCFMC
  1. Q:Y<1
  1. S BMCDFN=+Y,BMCREC("PAT NAME")=$P(^DPT(+Y,0),U)
  1. REFDISP ;DISPLAY LATEST REFERRAL ENTERED-5 AT A TIME
  1. S BMCFLG=1,BMCQ=1
  1. I '$D(^BMCREF("AA",BMCDFN)) W !,"PATIENT DOES NOT HAVE ANY REFERRALS" Q
  1. S BMCDT="",BMCCT=0,BMCRIENT="",BMCQ=0
  1. F S BMCDT=$O(^BMCREF("AA",BMCDFN,BMCDT),-1) Q:BMCDT'?1N.N D Q:BMCQ
  1. .S BMCRIEN=""
  1. .F S BMCRIEN=$O(^BMCREF("AA",BMCDFN,BMCDT,BMCRIEN),-1) Q:BMCRIEN'?1N.N D Q:BMCQ
  1. .. I $G(BMCAPI) Q:$P(^BMCREF(BMCRIEN,0),U,15)'="A"
  1. .. I $G(BMCAPIS) Q:$P($G(^BMCREF(BMCRIEN,1)),U)'=""
  1. .. S BMCCT=BMCCT+1,^TMP("BMCRDSP",$J,BMCCT)=BMCRIEN
  1. .. D START^BMCLKID1
  1. ..I BMCCT#5=0 D CONT
  1. I BMCCT#5'=0 D CONT
  1. S:BMCRIENT BMCRIEN=BMCRIENT Q:BMCRIENT!$D(DUOUT)
  1. I 'BMCRIENT S BMCQ=1
  1. Q
  1. CONT ;Ask to Continue
  1. S DIR("A")="Select referral to display OR Return to continue"
  1. S BMCQ=0
  1. W !! S DIR(0)="NO^1:"_BMCCT
  1. K DA D ^DIR K DIR
  1. I $D(DUOUT) S BMCQ=1 Q
  1. I Y>0 S BMCRIENT=$P(^TMP("BMCRDSP",$J,Y),U),BMCQ=1
  1. Q
  1. ;
  1. XIT ;Kill off Variables no longer needed
  1. K BMCPAT,BMCPTDFN,BMCPURP,BMCPURPP,BMCRFAC,BMCSVDT,BMCSVDTP,BMCRDT,BMCRDTP,BMCRNUMB
  1. K BMCFLG,BMCCT,^TMP("BMCRDSP",$J)
  1. Q
  1. ;