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

BMCADDS.m

Go to the documentation of this file. 
  1. BMCADDS ;IHS/ITSC/FCJ - ADD SECONDARY REFERRAL;        [ 09/27/2006  1:31 PM ]
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**1,2,3,8,12**;JAN 09, 2006;Build 101
  1.  ;
  1.  ; 4.0 ADD THE BMCMODE VAR AND CALLIN OPTION
  1.  ; 4.0*1 IHS/OIT/FCJ SP BAR VAR
  1.  ; 4.0*2 IHS/OIT/FCJ ADDED EP FOR API ROUTINE
  1.  ; 4.0*2 8/15/06 IHS/OIT/FCJ ADDED AUTO POP POV
  1.  ; 4.0*3 8.13.07 IHS.OIT.FCJ ADD BO/CHS COMMENTS
  1.  ; 4.0*12 9.12.17 IHS.OIT.FCJ ADDED CALL IN NOTIFICATION
  1.  ;
  1.  ; See ^BMCVDOC for system wide variables set by main menu
  1.  ; Subscripted BMCREC is EXTERNAL form.
  1.  ;   BMCREC("PAT NAME")=patient name
  1.  ;   BMCREC("REF DATE")=referral date
  1.  ;   BMCDFN=patient ien
  1.  ;   BMCRDATE=referral date in internal FileMan form
  1.  ;   BMCRNUMB=referral number
  1.  ;   BMCRIEN=referral ien
  1.  ;   BMCSRIEN=Secondary referral ien
  1.  ;   BMCMODE=A for add, M for modify
  1.  ;   BMCRSTAT=referral status (.15 field)
  1.  ;   BMCRTYPE=type of referral (.04 field)
  1.  ;   BMCRIO=Inpatient or Outpatient (.14 field)
  1.  ;   BMCVCT=Vist count
  1.  ;   BMCCURFY=Restrict access to current fiscal year only
  1.  ;
  1. START ;
  1.  D:'$D(BMCPARM) PARMCHK^BMC
  1.  F  D MAIN Q:BMCQ  D HDR^BMC
  1.  G EXIT
  1.  Q
  1.  ;
  1. MAIN ;
  1.  S BMCQ=0,BMCMODE="A",BMCSTRM="",BMCPROV="" ;BMC*4.0*8 ADDED BMCSTRM
  1.  D GETREF ;             Select Prim referral
  1.  Q:BMCQ
  1.  D CALLIN Q:BMCQ
  1.  D ADD Q:BMCQ  ;ADD NEW SEC REF
  1.  I BMCPCC,'$G(BMCOUTR),'BMCCAL S BMCIEN=BMCRIEN,BMCRIEN=BMCSRIEN D DSPV^BMCADDP S BMCRIEN=BMCIEN I BMCQ D DELETE Q  ;BMC*4.0*8 TEST FOR PCC LINK AND GO TO REQUIRE A VST
  1.  D EDIT I BMCQ D DELETE Q
  1.  I BMCPCC,'$G(BMCCAL) S BMCIEN=BMCRIEN,BMCRIEN=BMCSRIEN D ADDVREF^BMCADD S BMCRIEN=BMCIEN        ;BMC*4.0*8 Add to V Ref file
  1.  D MEDHX
  1.  D SBCOM       ;BMC*4.0*3 8.13.07 IHS.OIT.FCJ ADD BO/CHS COMMENTS 
  1.  Q
  1.  ;
  1. GETREF ;Screens out closed Referrals
  1.  S BMCQ=1
  1.  W !
  1.  I $G(BMCRIEN) S DA=BMCRIEN
  1.  ;S DIC="^BMCREF(",DIC("S")="I $$FILTER^BMCFLTR(0,BMCCURFY)",DIC(0)="AEMQ",DIC("A")="Select REFERRAL by Patient or by Referral Date or #: "
  1.  S DIC="^BMCREF(",DIC(0)="AEMQ",DIC("A")="Select REFERRAL by Patient or by Referral Date or #: "
  1.  ;S DIC("S")="I $$FILTER^BMCFLTR(0,BMCCURFY,0)"
  1.  ;S DIC("S")="I $$FILTER^BMCFLTR(0,0,0)"
  1.  S DIC("S")="I $$FILTER^BMCFLTR(3,0,0)"      ;*9 ALLOW CLOSED REF
  1.  D DIC^BMCFMC
  1.  Q:Y<1
  1.  S BMCRIEN=+Y
  1.  S BMCREC=^BMCREF(BMCRIEN,0)
  1.  S BMCQ=0
  1.  Q
  1. CALLIN ;EP;TEST FOR CALL-IN REF
  1.  S BMCCAL=0
  1.  S DIR(0)="Y",DIR("A")="Is this a Call-in Secondary Referral",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  ;S:Y=1 BMCCAL=1
  1.  I Y=1 S BMCCAL=1 D CALLIN^BMCADD     ;BMC*4.0*12
  1.  I $D(DUOUT) S BMCQ=1
  1.  Q
  1.  ;
  1. ADD ;EP;FIND SUFFIX
  1.  S (Y1,Y2,Y3)=0
  1.  I '$D(^BMCREF("S",BMCRNUMB)) S Y1=0
  1.  E  S Y="" F  S Y=$O(^BMCREF("S",BMCRNUMB,Y)) Q:Y=""  D
  1.  .S Y3=$E(Y,2,$L(Y)),Y2=Y2+1
  1.  .S:Y3>Y1 Y1=Y3
  1.  S Y1=Y1+1,Y2=Y2+1,BMCSUF="A"_Y1
  1.  ;VISTS REMAINING
  1.  S BMCVCT=($P(^BMCREF(BMCRIEN,11),U,11)-Y2)
  1.  S:BMCVCT<0 BMCVCT=0
  1.  ;ADD SECONDARY REF ENTRY
  1.  D ^XBFMK K DIADD,DINUM
  1.  S X=DT,DIC="^BMCREF(",DIC(0)="L",DLAYGO=90001
  1.  ;BMC*4.0*8 SPLIT NXT LINE AND ADDED TOC STATUS FIELD 1304
  1.  S BMCPROV=$P(BMCREC,U,6)
  1.  S DIC("DR")=".02////"_BMCRNUMB_";.03////"_BMCDFN_";.04////"_BMCRTYPE_";.25////"_DUZ_";1304////P"
  1.  S DIC("DR")=DIC("DR")_";101////"_BMCSUF_";102////"_BMCRIEN_";1111////"_BMCVCT
  1.  S DIC("DR")=DIC("DR")_";.11////"_$P(BMCREC,U,11)_";.14////"_$P(BMCREC,U,14)_";.15////A"_";.26////"_DT_";.32////"_$P(BMCREC,U,32)
  1.  I BMCCAL=0 S DIC("DR")=DIC("DR")_";.06////"_$P(BMCREC,U,6)
  1.  E  S DIC("DR")=DIC("DR")_";103////"_BMCCDT_";104////"_BMCCBY  ;BMC*4.0*12 OIT/IHS/FCJ CALL DATE AND BY
  1.  ;BMC 4.0*2 8/15/06 IHS/OIT/FCJ ADDED NXT LINE TO AUTO POP POV 1.26.07 ADD $TR TO STR BECAUSE OF FM
  1.  I $P($G(^BMCPARM(DUZ(2),4100)),U,6)="Y" S DIC("DR")=DIC("DR")_";1201////"_$TR($P(^BMCREF(BMCRIEN,12),U),";"," ")
  1.  K DD,DO D FILE^DICN S BMCSRIEN=+Y D ^XBFMK K DIADD,DINUM
  1.  Q  ;BMC*4.0*8 ADDED TO ADD CALL FOR VISIT
  1. EDIT ; EDIT REFERRAL RECORD JUST ADDED
  1.  S DDSFILE=90001,DA=BMCSRIEN,DDSPARM="C"
  1.  S DR=$S(BMCCAL=1:"[BMC SEC REF ADD CI]",1:"[BMC SEC REF ADD]")
  1.  D DDS^BMCFMC
  1.  I '$G(DDSCHANG) D DELETE S BMCQ=1 Q
  1.  S X=$S(BMCRTYPE="I":$P(^BMCREF(BMCSRIEN,0),U,8),BMCRTYPE="N":$P(^BMCREF(BMCSRIEN,0),U,23),1:$P(^BMCREF(BMCSRIEN,0),U,7))
  1.  I 'X W !,"You must enter a Vendor or IHS Facility, depending on the Referral type.",! D PAUSE^BMC G EDIT
  1.  Q
  1.  ;
  1. DELETE ; DELETE REFERRAL JUST ADDED BECAUSE OPERATOR DIDN'T FINISH
  1.  W !!,"INCOMPLETE SECONDARY REFERRAL...BEING DELETED!",!!
  1.  S DIK="^BMCREF(",DA=BMCSRIEN D ^DIK
  1.  D PAUSE^BMC
  1.  Q
  1. MEDHX ;EP;DISPLAY MED HX COMMENTS IF ANY AND ADD NEW COMMENTS TO SEC REF
  1.  S BMCV="COM",BMCTERM="Medical HX/Findings Comments",BMCATEMP="[BMC COMMENTS ADD]",BMCG="^BMCCOM(",BMCETEMP="[BMC COMMENTS EDIT]"
  1.  ;BMC*4.0*3 12.14.07 IHS.OIT.FCJ ADDED S BMCRIEN IN NXT LINE
  1.  S BMCCTYP="M",BMCRIEN=$P(^BMCREF(BMCSRIEN,1),U,2)
  1.  W @IOF,!,$$CTR^BMC("MEDICAL COMMENTS FROM PRIMARY REFERRAL",80)
  1.  W !,$$CTR^BMC("REFERRAL: "_BMCRNUMB_"   PATIENT: "_BMCREC("PAT NAME"),80),!
  1.  F I=1:1:80 W "-"
  1.  S BMCNONE=0 D DISPCOM^BMCMOD1
  1.  I BMCNONE=1 W !,"THERE ARE NOT ANY MEDICAL COMMENTS FROM PRIMARY REFERRAL TO DISPLAY...",!
  1.  W ! F I=1:1:80 W "-"
  1.  W !,"Enter Comments for Secondary Referral..."
  1. MEDCOM ;ADD MED HX COMMENTS
  1.  W !
  1.  S DIR("A")="Do you want to enter Medical History and Findings Comments"
  1.  S BMCCTYP="M"
  1.  S BMCTMPS=BMCSRIEN,BMCTMP=BMCRIEN,BMCRIEN=BMCSRIEN
  1.  D COMMENTS^BMCADD
  1.  S BMCRIEN=BMCTMP,BMCSRIEN=BMCTMPS
  1.  Q
  1.  ;
  1. SBCOM ;ADD BO/CHS COMMENTS ;BMC*4.0*3 8.13.07 IHS.OIT.FCJ ADD BO/CHS COMMENTS
  1.  S BMCV="COM",BMCTERM="Business Office/CHS Comments",BMCATEMP="[BMC COMMENTS ADD]",BMCG="^BMCCOM(",BMCETEMP="[BMC COMMENTS EDIT]"
  1.  S BMCCTYP="S"
  1.  S BMCTMPS=BMCSRIEN,BMCTMP=BMCRIEN,BMCRIEN=BMCSRIEN
  1.  D ASK^BMCMOD
  1.  S BMCRIEN=BMCTMP,BMCSRIEN=BMCTMPS
  1.  ;
  1. RECORD ;RECORD SECONDARY REFERRAL
  1.  W !!,"Secondary Referral has been completed, "_BMCRNUMB_BMCSUF,!
  1.  D PAUSE^BMC
  1.  S ^DISV(DUZ,"^BMCREF(")=$P(^BMCREF(BMCSRIEN,1),U,2)  ;BMC*4.0*1 IHS/OIT/FCJ SP BAR VAR
  1.  Q
  1.  ;
  1. BUSINESS ; EDIT BUSINESS OFFICE COMMENTS
  1.  D 80^BMCMOD
  1.  Q
  1. EXIT ;EXIT PROGRAM
  1.  D ^BMCKILL
  1.  K DDSCHANG,DDSPARM,DILN,DISYS,DIWI,DIWTC,DIWX,DIC,DIE,DA,Y,Y1,Y2,W1
  1.  K BMCMODE,BMCRSTAT,BMCRIEN,BMCSUF,BMCVCT,BMCTMP,BMCTMPS,BMCCAL
  1.  Q