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