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

BMCMODS.m

Go to the documentation of this file. 
  1. BMCMODS ;IHS/ITSC/FCJ - EDIT SECONDARY REFERRAL ;   
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**3,6,8,9**;JAN 09, 2006;Build 101
  1.  ;
  1.  ; This option allows the user to EDIT Secondary Referrals
  1.  ;   BMCRIEN=Primary referral
  1.  ;   BMCSRIEN=Secondary referral ien
  1.  ;   BMCVCT=Vist count
  1.  ;4.0 ADDED THE BMCMODE VARIABLE AND TYPE OF REF TO EDIT
  1.  ;4.0*3 8.13.07 IHS.OIT.FCJ ADD BO/CHS COMMENTS
  1.  ;4.0*3 12.10.2007 IHS.OIT.FCJ ADDED EP LABEL TO LINES EDIT AND MEDHX
  1.  ;4.0*6 4.22.2010 IHS.OIT.FCJ MODIFIED TO ALLOW EDIT OF CLOSED REF
  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="M"
  1.  D GETREF ;             get referral record to modify
  1.  Q:BMCQ
  1.  D GETSNO^BMCADD3  ;BMC*4.0*8
  1.  D EDIT  Q:BMCQ    ;EDIT SEC REF
  1.  I BMCPCC,BMCSCOD S BMCIEN=BMCRIEN,BMCRIEN=BMCSRIEN D VREF^BMCMOD S BMCRIEN=BMCIEN ;BMC*4.0*8 Update V Ref file
  1.  E  I BMCSCOD S BMCIEN=BMCRIEN,BMCRIEN=BMCSRIEN D SNO^BMCMOD S BMCRIEN=BMCIEN       ;BMC*4.0*9 UPDATE SNOMED CODE IN REF
  1.  D MEDHX
  1.  D SBCOM     ;BMC*4.0*3 8.13.07 IHS.OIT.FCJ ADD BO/CHS COMMENTS
  1.  D STA       ;BMC*4.0*9 IHS.OIT.FCJ ADD STATUS EDIT FR ACTIVE TO APPROVED
  1.  Q
  1.  ;
  1. GETREF ;
  1.  S BMCQ=1
  1.  W !! S BMCREF=""
  1.  ;S DIC="^BMCPROV(",DIC(0)="AEMQ",DIC("A")="Select Secondary Referral by Patient Name or date of referral: " D ^DIC K DA,DIC
  1.  S DIC="^BMCREF(",DIC(0)="AEMQ",DIC("A")="Select Secondary Referral by Patient Name or by Referral Date or #: "
  1.  ;BMC*4.0*6 4.22.2010 IHS.OIT.FCJ MODIFIED NXT LINE TO ALLOW EDIT OF CLOSED REF
  1.  ;S DIC("S")="I $$FILTER^BMCFLTR(0,0,1)"     ;BMC*4.0*6
  1.  S DIC("S")="I $$FILTER^BMCFLTR(3,0,1)"      ;BMC*4.0*6
  1.  D DIC^BMCFMC
  1.  Q:Y=-1
  1.  S (BMCRIEN,BMCSRIEN)=+Y
  1.  S BMCREC=^BMCREF(BMCSRIEN,0)
  1.  ;S BMCRIEN=$P(^BMCREF(BMCSRIEN,1),U,2)
  1.  S BMCQ=0
  1.  Q
  1.  ;
  1. EDIT ;EP;DISPLAY AND EDIT SEC REF
  1.  S BMCRIEN=$P(^BMCREF(BMCSRIEN,1),U,2)
  1.  S BMCSUF=$P(^BMCREF(BMCSRIEN,1),U)
  1.  S BMCVCT=$P(^BMCREF(BMCSRIEN,11),U,11)
  1.  ; EDIT REFERRAL RECORD JUST ADDED
  1.  ;S DDSFILE=90001.04,DA=BMCSRIEN,DR="[BMC SECONDARY REF ADD]",DDSPARM="C"
  1.  S DDSFILE=90001,DA=BMCSRIEN,DDSPARM="C"
  1.  S DR=$S($P(^BMCREF(BMCSRIEN,0),U,6)="":"[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.  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.  S BMCCTYP="M"
  1.  W @IOF,!,$$CTR^BMC("MEDICAL COMMENTS FROM PRIMARY REFERRAL",80)
  1.  W !,$$CTR^BMC("REFERRAL: "_$P(BMCREC,U,2)_"   PATIENT: "_$$VAL^XBDIQ1(90001,BMCSRIEN,.03),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.  S DIR(0)="EO",DIR("A")="Hit return to continue..." K DA D ^DIR K DIR
  1. MEDCOM ;DISPLAY AND ADD COMMENTS FOR MED HX
  1.  S BMCV="COM",BMCTERM="Medical HX/Findings Comments",BMCATEMP="[BMC COMMENTS ADD]",BMCG="^BMCCOM(",BMCETEMP="[BMC COMMENTS EDIT]"
  1.  S BMCCTYP="M"
  1.  S BMCTMPP=BMCRIEN,BMCRIEN=BMCSRIEN
  1.  D ASK^BMCMOD
  1.  S BMCRIEN=BMCTMPP
  1.  Q
  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 BMCTMPP=BMCRIEN,BMCRIEN=BMCSRIEN
  1.  D ASK^BMCMOD
  1.  S BMCRIEN=BMCTMPP
  1.  Q
  1. STA ;EDIT STATUS OF REF;NEW FOR P9
  1.  W @IOF,!
  1.  S BMCTMPP=BMCRIEN,BMCRIEN=BMCSRIEN
  1.  D 17^BMCMOD
  1.  S BMCRIEN=BMCTMPP
  1.  Q
  1.  ;
  1. EXIT ;EXIT PROGRAM
  1.  D ^BMCKILL
  1.  K DDSCHANG,DDSPARM,DILN,DISYS,DIWI,DIWTC,DIWX,DIC,DIE,DA,Y,Y1,W1
  1.  K BMCMODE,BMCRSTAT,BMCSUF,BMCVCT,BMCREF,BMCSRIEN,BMCVST,BMCVSTP,BMCTMPP
  1.  Q