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