BMCAPI ; IHS/OIT/FCJ -API ADD,EDIT VIEW A NEW REFERRAL- PASSING PATIENT DFN ; [ 10/20/2006 1:51 PM ]
;;4.0;REFERRED CARE INFO SYSTEM;**2,3**;JAN 09, 2006;Build 101
;4.0*2 7/20/06 IHS/OIT/FCJ Added flg for closed ref, will no longer
; display as a selection for adding a Secondary ref or modifying
; added flg for display sec ref during sec ref data entry
; 4.0*3 5/16/07 multiple changes for testing closed ref, pat w/o ref, editing sec ref
; See ^BMCVDOC for system wide variables set by main menu
; Patient DFN is passed, BMCADD routine is called to ADD REF's
; Patient DFN is passed, BMCRDSP routine is called to DISPLAY REF's
; Patient DFN is passed, BMCMOD routine is called to EDIT REF's
; Security Key and Site Parameters are required to use options
; BMCDFN=patient ien
;
ADD(BMCDFN) ;ENTRY POINT TO ADD A REFERRAL FOR A PATIENT
D SECCHK
D:'BMCQ ADD2
D EOJ
Q
;
ADD2 ;
S BMCQ=0,BMCMODE="A",BMCLOOK=""
S APCDOVRR=""
D REFDISP^BMCADD
D ASK^BMCADD
D:'BMCQ GETDATE^BMCADD
Q
;
ADDSEC(BMCDFN) ; ENTRY POINT TO ADD A SECONDARY REFERRAL
D SECCHK
I '$D(^BMCREF("AA",DFN)) W !,"PATIENT DOES NOT HAVE ANY REFERRALS." D EOJ Q
D:'BMCQ ADDSEC2
D EOJ
Q
ADDSEC2 ;
S Y=$P(^DPT(BMCDFN,0),U)
S BMCAPI=1 ;4.0*2 7/20/06 IHS/OIT/FCJ ADDED FLG TO TST FOR CLOSED REF
S BMCAPIS=1 ;4.0*2 7/20/06 IHS/OIT/FCJ ADDED FLG TO TST FOR SEC REF
D PATLKUP^BMCLKID2
Q:'Y
I 'BMCRIEN W !,"Patient does not have any Active Referrals." Q ;4.0*3 5/16/07 IHS/OIT/FCJ added
S BMCMODE="A",BMCRIEN=BMCRIENT
;4.0*2 7/20/06 IHS/OIT/FCJ Cmmt out nxt 2 lns, flg added above
;I $P(^BMCREF(BMCRIEN,0),U,15)'="A" W !!,"This is a CLOSED referral, Please select another referral" G ADDSEC2
;I $P($G(^BMCREF(BMCRIEN,1)),U,1)'="" W !!,"Please select a PRIMARY referral" G ADDSEC2
S BMCREC=^BMCREF(BMCRIEN,0),BMCRNUMB=$P(BMCREC,U,2),BMCRTYPE=$P(BMCREC,U,4)
S BMCQ=0 D CALLIN^BMCADDS Q:BMCQ
S BMCQ=0 D ADD^BMCADDS Q:BMCQ
D MEDHX^BMCADDS
Q
;
EDIT(BMCDFN) ;ENTRY POINT TO EDIT A REFERRAL
D SECCHK
D:'BMCQ EDIT2
D EOJ
Q
EDIT2 ;
S Y=$P(^DPT(BMCDFN,0),U)
I '$D(^BMCREF("AA",BMCDFN)) W !,"PATIENT DOES NOT HAVE ANY REFERRALS." Q
S BMCAPI=1 ;4.0*2 7/20/06 IHS/OIT/FCJ ADDED FLG TO TST FOR CLOSED REF
D PATLKUP^BMCLKID2
Q:'Y
I 'BMCRIEN W !,"Patient does not have any Active Referrals." Q ;4.0*3 5/16/07 IHS/OIT/FCJ added
S BMCMODE="M"
S (Y,BMCRDATE)=$P(^BMCREF(BMCRIEN,0),U),BMCRNUMB=$P(^(0),U,2)
;4.0*2 7/20/06 IHS/OIT/FCJ Cmmt out nxt ln, flg added added above
;I $P(^BMCREF(BMCRIEN,0),U,15)'="A" W !!,"This is a CLOSED referral, Please select another referral" G EDIT2
D DD^%DT S BMCREC("REF DATE")=Y
I $P($G(^BMCREF(BMCRIEN,1)),U)'="" D Q ;4.0*3 5/16/07 IHS/OIT/FCJ added edit for Sec Ref
.S BMCSRIEN=BMCRIEN,BMCREC=^BMCREF(BMCSRIEN,0)
.S BMCRIEN=$P(^BMCREF(BMCSRIEN,1),U,2)
.D EDIT^BMCMODS,MEDHX^BMCMODS
F D TYPE^BMCMOD Q:BMCQ
I BMCDTYPE=13 G EDIT2
Q
;
VIEW(BMCDFN) ;ENTRY POINT TO VIEW A REFERRAL FOR A PATIENT
D SECCHK I BMCQ D EOJ Q
D VIEW2
D EOJ
Q
VIEW2 ;
S Y=$P(^DPT(BMCDFN,0),U)
I '$D(^BMCREF("AA",BMCDFN)) W !,"PATIENT DOES NOT HAVE ANY REFERRALS." Q
D PATLKUP^BMCLKID2
Q:'BMCRIENT ;4.0*3 5/16/07 IHS/OIT/FCJ CHG TEST FOR Q
D START2^BMCRDSP
Q
;
SECCHK ;TEST FOR USER ASSIGNED BMCZEDIT KEY AND PARAMETERS
I '$D(^BMCPARM(DUZ(2))) S BMCQ=1 W !,"RCIS parameters are not set up for this Facility" Q
D:$G(BMCPARM)="" PARMSET^BMC
S BMCQ=0
I '$D(^DIC(19.1,"B","BMCZEDIT")) D Q
.S BMCQ=1
.W !,"SECURITY KEY not found notify Site Manager"
S BMCKEY=0
S BMCKEY=$O(^DIC(19.1,"B","BMCZEDIT",BMCKEY))
I '$D(^VA(200,DUZ,51,BMCKEY)) D Q
.S BMCQ=1 W !,"Person does not have Keys to use this option"
Q
;
EOJ ;
D ^BMCKILL
D EN^XBVK("BMC")
Q
BMCAPI ; IHS/OIT/FCJ -API ADD,EDIT VIEW A NEW REFERRAL- PASSING PATIENT DFN ; [ 10/20/2006 1:51 PM ]
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**2,3**;JAN 09, 2006;Build 101
+2 ;4.0*2 7/20/06 IHS/OIT/FCJ Added flg for closed ref, will no longer
+3 ; display as a selection for adding a Secondary ref or modifying
+4 ; added flg for display sec ref during sec ref data entry
+5 ; 4.0*3 5/16/07 multiple changes for testing closed ref, pat w/o ref, editing sec ref
+6 ; See ^BMCVDOC for system wide variables set by main menu
+7 ; Patient DFN is passed, BMCADD routine is called to ADD REF's
+8 ; Patient DFN is passed, BMCRDSP routine is called to DISPLAY REF's
+9 ; Patient DFN is passed, BMCMOD routine is called to EDIT REF's
+10 ; Security Key and Site Parameters are required to use options
+11 ; BMCDFN=patient ien
+12 ;
ADD(BMCDFN) ;ENTRY POINT TO ADD A REFERRAL FOR A PATIENT
+1 DO SECCHK
+2 IF 'BMCQ
DO ADD2
+3 DO EOJ
+4 QUIT
+5 ;
ADD2 ;
+1 SET BMCQ=0
SET BMCMODE="A"
SET BMCLOOK=""
+2 SET APCDOVRR=""
+3 DO REFDISP^BMCADD
+4 DO ASK^BMCADD
+5 IF 'BMCQ
DO GETDATE^BMCADD
+6 QUIT
+7 ;
ADDSEC(BMCDFN) ; ENTRY POINT TO ADD A SECONDARY REFERRAL
+1 DO SECCHK
+2 IF '$DATA(^BMCREF("AA",DFN))
WRITE !,"PATIENT DOES NOT HAVE ANY REFERRALS."
DO EOJ
QUIT
+3 IF 'BMCQ
DO ADDSEC2
+4 DO EOJ
+5 QUIT
ADDSEC2 ;
+1 SET Y=$PIECE(^DPT(BMCDFN,0),U)
+2 ;4.0*2 7/20/06 IHS/OIT/FCJ ADDED FLG TO TST FOR CLOSED REF
SET BMCAPI=1
+3 ;4.0*2 7/20/06 IHS/OIT/FCJ ADDED FLG TO TST FOR SEC REF
SET BMCAPIS=1
+4 DO PATLKUP^BMCLKID2
+5 IF 'Y
QUIT
+6 ;4.0*3 5/16/07 IHS/OIT/FCJ added
IF 'BMCRIEN
WRITE !,"Patient does not have any Active Referrals."
QUIT
+7 SET BMCMODE="A"
SET BMCRIEN=BMCRIENT
+8 ;4.0*2 7/20/06 IHS/OIT/FCJ Cmmt out nxt 2 lns, flg added above
+9 ;I $P(^BMCREF(BMCRIEN,0),U,15)'="A" W !!,"This is a CLOSED referral, Please select another referral" G ADDSEC2
+10 ;I $P($G(^BMCREF(BMCRIEN,1)),U,1)'="" W !!,"Please select a PRIMARY referral" G ADDSEC2
+11 SET BMCREC=^BMCREF(BMCRIEN,0)
SET BMCRNUMB=$PIECE(BMCREC,U,2)
SET BMCRTYPE=$PIECE(BMCREC,U,4)
+12 SET BMCQ=0
DO CALLIN^BMCADDS
IF BMCQ
QUIT
+13 SET BMCQ=0
DO ADD^BMCADDS
IF BMCQ
QUIT
+14 DO MEDHX^BMCADDS
+15 QUIT
+16 ;
EDIT(BMCDFN) ;ENTRY POINT TO EDIT A REFERRAL
+1 DO SECCHK
+2 IF 'BMCQ
DO EDIT2
+3 DO EOJ
+4 QUIT
EDIT2 ;
+1 SET Y=$PIECE(^DPT(BMCDFN,0),U)
+2 IF '$DATA(^BMCREF("AA",BMCDFN))
WRITE !,"PATIENT DOES NOT HAVE ANY REFERRALS."
QUIT
+3 ;4.0*2 7/20/06 IHS/OIT/FCJ ADDED FLG TO TST FOR CLOSED REF
SET BMCAPI=1
+4 DO PATLKUP^BMCLKID2
+5 IF 'Y
QUIT
+6 ;4.0*3 5/16/07 IHS/OIT/FCJ added
IF 'BMCRIEN
WRITE !,"Patient does not have any Active Referrals."
QUIT
+7 SET BMCMODE="M"
+8 SET (Y,BMCRDATE)=$PIECE(^BMCREF(BMCRIEN,0),U)
SET BMCRNUMB=$PIECE(^(0),U,2)
+9 ;4.0*2 7/20/06 IHS/OIT/FCJ Cmmt out nxt ln, flg added added above
+10 ;I $P(^BMCREF(BMCRIEN,0),U,15)'="A" W !!,"This is a CLOSED referral, Please select another referral" G EDIT2
+11 DO DD^%DT
SET BMCREC("REF DATE")=Y
+12 ;4.0*3 5/16/07 IHS/OIT/FCJ added edit for Sec Ref
IF $PIECE($GET(^BMCREF(BMCRIEN,1)),U)'=""
Begin DoDot:1
+13 SET BMCSRIEN=BMCRIEN
SET BMCREC=^BMCREF(BMCSRIEN,0)
+14 SET BMCRIEN=$PIECE(^BMCREF(BMCSRIEN,1),U,2)
+15 DO EDIT^BMCMODS
DO MEDHX^BMCMODS
End DoDot:1
QUIT
+16 FOR
DO TYPE^BMCMOD
IF BMCQ
QUIT
+17 IF BMCDTYPE=13
GOTO EDIT2
+18 QUIT
+19 ;
VIEW(BMCDFN) ;ENTRY POINT TO VIEW A REFERRAL FOR A PATIENT
+1 DO SECCHK
IF BMCQ
DO EOJ
QUIT
+2 DO VIEW2
+3 DO EOJ
+4 QUIT
VIEW2 ;
+1 SET Y=$PIECE(^DPT(BMCDFN,0),U)
+2 IF '$DATA(^BMCREF("AA",BMCDFN))
WRITE !,"PATIENT DOES NOT HAVE ANY REFERRALS."
QUIT
+3 DO PATLKUP^BMCLKID2
+4 ;4.0*3 5/16/07 IHS/OIT/FCJ CHG TEST FOR Q
IF 'BMCRIENT
QUIT
+5 DO START2^BMCRDSP
+6 QUIT
+7 ;
SECCHK ;TEST FOR USER ASSIGNED BMCZEDIT KEY AND PARAMETERS
+1 IF '$DATA(^BMCPARM(DUZ(2)))
SET BMCQ=1
WRITE !,"RCIS parameters are not set up for this Facility"
QUIT
+2 IF $GET(BMCPARM)=""
DO PARMSET^BMC
+3 SET BMCQ=0
+4 IF '$DATA(^DIC(19.1,"B","BMCZEDIT"))
Begin DoDot:1
+5 SET BMCQ=1
+6 WRITE !,"SECURITY KEY not found notify Site Manager"
End DoDot:1
QUIT
+7 SET BMCKEY=0
+8 SET BMCKEY=$ORDER(^DIC(19.1,"B","BMCZEDIT",BMCKEY))
+9 IF '$DATA(^VA(200,DUZ,51,BMCKEY))
Begin DoDot:1
+10 SET BMCQ=1
WRITE !,"Person does not have Keys to use this option"
End DoDot:1
QUIT
+11 QUIT
+12 ;
EOJ ;
+1 DO ^BMCKILL
+2 DO EN^XBVK("BMC")
+3 QUIT
