BRNADD ; IHS/PHXAO/TMJ - ADD A NEW DISCLOSURE DATE ;
;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
;IHS/OIT/LJF 01/04/2008 PATCH 1 Added screen on date for facility inactivation date
;
; Subscripted BRNREC is EXTERNAL form.
; BRNREC("PAT NAME")=patient name
; BRNREC("REF DATE")=disclosure date
; BRNDFN=patient ien
; BRNRDATE=disclosure date in internal FileMan form
; BRNRNUMB=disclosure number
; BRNRIEN=Disclosure ien
; BRNMODE=A for add, M for modify
; BRNRTYPE=type of disclousre (.04 field)
;
START ;
F D MAIN Q:BRNQ D HDR^BRN
D EOJ
Q
;
MAIN ;
S BRNQ=0
S BRNMODE="A",BRNLOOK=""
;S APCDOVRR="" ;for provider narrative lookup
D PATIENT ; get patient being referred
Q:BRNQ
D REFDISP
I BRNQ=1 G GETDATE
;
D ASK
Q:BRNQ
;
GETDATE ;Do Get Date if no existing Disclosures
D DATE ; get date of Disclosure
Q:BRNQ
D ADD ; add new Disclosure record
Q:BRNQ
D EDIT ; edit Disclosure record just added
Q
;
PATIENT ; GET PATIENT
F D PATIENT2 I BRNQ!($G(BRNDFN)) Q
Q
;
PATIENT2 ; ASK FOR PATIENT UNTIL USER SELECTS OR QUITS
S BRNQ=1
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D DIC^BRNFMC
Q:Y<1
S BRNDFN=+Y,BRNREC("PAT NAME")=$P(^DPT(+Y,0),U)
S BRNQ=0
I $$DOD^AUPNPAT(BRNDFN) D I 'Y K BRNDFN,BRNREC("PAT NAME") Q
. W !!,"This patient is deceased."
. S DIR(0)="YO",DIR("A")="Are you sure you want this patient",DIR("B")="NO" K DA D ^DIR K DIR
. W !
. Q
Q
;
;
ASK ;Ask to Continue
S BRNQ=0
W !! S DIR(0)="Y",DIR("A")="Do you want to continue with adding a new Disclosure",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT) S BRNQ=1 Q
I 'Y S BRNQ=1 Q
Q
;
REFDISP ;Display if Patient has existing Disclosures
W !!,?25,"********************",!
W ?25,"**LAST 4 DISCLOSURES**",!,?25,"********************",!
I '$D(^BRNREC("AA",BRNDFN)) W !,?20,"**--NO EXISTING DISCLOSURES--**",! S BRNQ=1 Q
S BRNQ=0
S BRNDT=""
F I=1:1:5 S BRNDT=$O(^BRNREC("AA",BRNDFN,BRNDT),-1) Q:BRNDT="" D NEXT
Q
NEXT ;2ND $O
S BRNRIEN=""
F S BRNRIEN=$O(^BRNREC("AA",BRNDFN,BRNDT,BRNRIEN),-1) Q:BRNRIEN'=+BRNRIEN D
. Q:BRNDT=""
. Q:BRNRIEN=""
. D START^BRNLKI1
. S I=I+1 ; increment outer loop counter to limit display to 4 Disclosures
. Q
Q
;
;
;
DATE ; GET DATE OF DISCLOSURE
W !
S BRNQ=1
;
S DIR(0)="90264,.01",DIR("B")="TODAY" K DA D ^DIR K DIR
Q:$D(DIRUT)
I '$$FACOK^BRNU(+Y) W !,"** MUST BE BEFORE YOUR DIVISION'S INACTIVATION DATE **",! D PAUSE^BRNU,DATE Q ;IHS/OIT/LJF 01/04/2008 PATCH 1
S BRNRDATE=+Y,BRNREC("REF DATE")=Y(0)
S BRNQ=0
Q
;
ADD ; ADD NEW DISCLOSURE RECORD
S BRNRR=""
Q:BRNQ
I BRNRR="" D Q
.S DIC="^BRNREC(",DIC(0)="L",DLAYGO=90264,DIC("DR")=".03////"_BRNDFN,X=BRNRDATE
.D FILE^BRNFMC
.I Y<0 W !,"Error creating DISCLOSURE.",!,"Notify programmer.",! D EOP^BRN Q
.;
.S BRNRIEN=+Y
. W !!,"DISCLOSURE NUMBER: ",$$VAL^XBDIQ1(90264,BRNRIEN,.02)
.S BRNQ=0
.Q
EDIT ; EDIT DISCLOSURE RECORD JUST ADDED
S DIE="^BRNREC(",DA=BRNRIEN,DR="[BRN JCK BRANCH]",DIE("NO^")=1 D ^DIE K DA,DR,DIE,DIE("NO^")
;
RECVAR ;Get Record Variables
;
S Y=BRNRIEN
D ^BRNREF ; set standard variables from record
Q
;
DELETE ; DELETE DISCLOSURE JUST ADDED BECAUSE OPERATOR DIDN'T FINISH
W !!,"INCOMPLETE DISCLOSURE BEING DELETED!",!!
S DIK="^BRNREC(",DA=BRNRIEN D ^DIK
D PAUSE^BRN
Q
;
;
EOJ ; END OF JOB
D ^BRNKILL
Q
BRNADD ; IHS/PHXAO/TMJ - ADD A NEW DISCLOSURE DATE ;
+1 ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003
+2 ;IHS/OIT/LJF 01/04/2008 PATCH 1 Added screen on date for facility inactivation date
+3 ;
+4 ; Subscripted BRNREC is EXTERNAL form.
+5 ; BRNREC("PAT NAME")=patient name
+6 ; BRNREC("REF DATE")=disclosure date
+7 ; BRNDFN=patient ien
+8 ; BRNRDATE=disclosure date in internal FileMan form
+9 ; BRNRNUMB=disclosure number
+10 ; BRNRIEN=Disclosure ien
+11 ; BRNMODE=A for add, M for modify
+12 ; BRNRTYPE=type of disclousre (.04 field)
+13 ;
START ;
+1 FOR
DO MAIN
IF BRNQ
QUIT
DO HDR^BRN
+2 DO EOJ
+3 QUIT
+4 ;
MAIN ;
+1 SET BRNQ=0
+2 SET BRNMODE="A"
SET BRNLOOK=""
+3 ;S APCDOVRR="" ;for provider narrative lookup
+4 ; get patient being referred
DO PATIENT
+5 IF BRNQ
QUIT
+6 DO REFDISP
+7 IF BRNQ=1
GOTO GETDATE
+8 ;
+9 DO ASK
+10 IF BRNQ
QUIT
+11 ;
GETDATE ;Do Get Date if no existing Disclosures
+1 ; get date of Disclosure
DO DATE
+2 IF BRNQ
QUIT
+3 ; add new Disclosure record
DO ADD
+4 IF BRNQ
QUIT
+5 ; edit Disclosure record just added
DO EDIT
+6 QUIT
+7 ;
PATIENT ; GET PATIENT
+1 FOR
DO PATIENT2
IF BRNQ!($GET(BRNDFN))
QUIT
+2 QUIT
+3 ;
PATIENT2 ; ASK FOR PATIENT UNTIL USER SELECTS OR QUITS
+1 SET BRNQ=1
+2 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO DIC^BRNFMC
+3 IF Y<1
QUIT
+4 SET BRNDFN=+Y
SET BRNREC("PAT NAME")=$PIECE(^DPT(+Y,0),U)
+5 SET BRNQ=0
+6 IF $$DOD^AUPNPAT(BRNDFN)
Begin DoDot:1
+7 WRITE !!,"This patient is deceased."
+8 SET DIR(0)="YO"
SET DIR("A")="Are you sure you want this patient"
SET DIR("B")="NO"
KILL DA
DO ^DIR
KILL DIR
+9 WRITE !
+10 QUIT
End DoDot:1
IF 'Y
KILL BRNDFN,BRNREC("PAT NAME")
QUIT
+11 QUIT
+12 ;
+13 ;
ASK ;Ask to Continue
+1 SET BRNQ=0
+2 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue with adding a new Disclosure"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET BRNQ=1
QUIT
+4 IF 'Y
SET BRNQ=1
QUIT
+5 QUIT
+6 ;
REFDISP ;Display if Patient has existing Disclosures
+1 WRITE !!,?25,"********************",!
+2 WRITE ?25,"**LAST 4 DISCLOSURES**",!,?25,"********************",!
+3 IF '$DATA(^BRNREC("AA",BRNDFN))
WRITE !,?20,"**--NO EXISTING DISCLOSURES--**",!
SET BRNQ=1
QUIT
+4 SET BRNQ=0
+5 SET BRNDT=""
+6 FOR I=1:1:5
SET BRNDT=$ORDER(^BRNREC("AA",BRNDFN,BRNDT),-1)
IF BRNDT=""
QUIT
DO NEXT
+7 QUIT
NEXT ;2ND $O
+1 SET BRNRIEN=""
+2 FOR
SET BRNRIEN=$ORDER(^BRNREC("AA",BRNDFN,BRNDT,BRNRIEN),-1)
IF BRNRIEN'=+BRNRIEN
QUIT
Begin DoDot:1
+3 IF BRNDT=""
QUIT
+4 IF BRNRIEN=""
QUIT
+5 DO START^BRNLKI1
+6 ; increment outer loop counter to limit display to 4 Disclosures
SET I=I+1
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
+10 ;
+11 ;
DATE ; GET DATE OF DISCLOSURE
+1 WRITE !
+2 SET BRNQ=1
+3 ;
+4 SET DIR(0)="90264,.01"
SET DIR("B")="TODAY"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 ;IHS/OIT/LJF 01/04/2008 PATCH 1
IF '$$FACOK^BRNU(+Y)
WRITE !,"** MUST BE BEFORE YOUR DIVISION'S INACTIVATION DATE **",!
DO PAUSE^BRNU
DO DATE
QUIT
+7 SET BRNRDATE=+Y
SET BRNREC("REF DATE")=Y(0)
+8 SET BRNQ=0
+9 QUIT
+10 ;
ADD ; ADD NEW DISCLOSURE RECORD
+1 SET BRNRR=""
+2 IF BRNQ
QUIT
+3 IF BRNRR=""
Begin DoDot:1
+4 SET DIC="^BRNREC("
SET DIC(0)="L"
SET DLAYGO=90264
SET DIC("DR")=".03////"_BRNDFN
SET X=BRNRDATE
+5 DO FILE^BRNFMC
+6 IF Y<0
WRITE !,"Error creating DISCLOSURE.",!,"Notify programmer.",!
DO EOP^BRN
QUIT
+7 ;
+8 SET BRNRIEN=+Y
+9 WRITE !!,"DISCLOSURE NUMBER: ",$$VAL^XBDIQ1(90264,BRNRIEN,.02)
+10 SET BRNQ=0
+11 QUIT
End DoDot:1
QUIT
EDIT ; EDIT DISCLOSURE RECORD JUST ADDED
+1 SET DIE="^BRNREC("
SET DA=BRNRIEN
SET DR="[BRN JCK BRANCH]"
SET DIE("NO^")=1
DO ^DIE
KILL DA,DR,DIE,DIE("NO^")
+2 ;
RECVAR ;Get Record Variables
+1 ;
+2 SET Y=BRNRIEN
+3 ; set standard variables from record
DO ^BRNREF
+4 QUIT
+5 ;
DELETE ; DELETE DISCLOSURE JUST ADDED BECAUSE OPERATOR DIDN'T FINISH
+1 WRITE !!,"INCOMPLETE DISCLOSURE BEING DELETED!",!!
+2 SET DIK="^BRNREC("
SET DA=BRNRIEN
DO ^DIK
+3 DO PAUSE^BRN
+4 QUIT
+5 ;
+6 ;
EOJ ; END OF JOB
+1 DO ^BRNKILL
+2 QUIT
