BRNADD.m

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