BRNADDM.m

BRNADDM ; IHS/OIT/LJF - ADD MULTIPLE PATIENTS UNDER ONE REQUEST

 ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003

 ; IHS/OIT/LJF 01/03/2008 PATCH 1 - routine added

 ;

 W !!,"This option allows you to enter multiple patients under one request."

 W !,"You will be asked the requesting information once and then the "

 W !,"specific information for each patient.",!

 ;

 NEW BRNQUIT,BRNRDATE,BRNTYPE,BRNOTHER,BRNMETH,BRNPARTY,BRNPUR,BRNPRIOR

DATE S BRNRDATE=$$READ^BRNU("90264,.01","DATE REQUEST INITIATED","TODAY")

 Q:BRNRDATE<1

 I '$$FACOK^BRNU(BRNRDATE) W !,"** MUST BE BEFORE YOUR DIVISION'S INACTIVATION DATE **",! D DATE Q

 ;

 S BRNTYPE=$$READ^BRNU("90264,.04") Q:BRNTYPE=U

 I BRNTYPE="O" S BRNOTHER=$$READ^BRNU("90264,.05")

 ;

 S BRNMETH=$$READ^BRNU("90264,.21") Q:BRNMETH=U

 S BRNPARTY=+$$READ^BRNU("90264,.06") Q:BRNPARTY=U

 S BRNPUR=$$READ^BRNU("90264,.07") Q:BRNPUR=U

 S Y=BRNPUR,C=$P(^DD(90264,.07,0),U,2) D Y^DIQ S BRNPUR=Y K C,Y

 S BRNPRIOR=$$READ^BRNU("90264,.09",,"NON-CRITICAL") Q:BRNPRIOR=U

 ;

PATS ; loop through patients, stuff common data and ask individual data

 NEW FIRST,BRNDFN,BRNRIEN

 S BRNQUIT=0,FIRST=1

 F  D  Q:BRNDFN<1

 . S PROMPT="Select "_$S(FIRST:"",1:"Another ")_"PATIENT",FIRST=0

 . S BRNDFN=+$$READ^BRNU("PO^2:EMQZ",PROMPT) Q:BRNDFN<1

 . ;

 . I $$DOD^AUPNPAT(BRNDFN) D  Q:BRNQUIT

 . . W !!,"This patient is deceased."

 . . I '$$READ^BRNU("Y","Are you sure you want this patient","NO") S BRNQUIT=1

 . ;

 . E  Q:'$$READ^BRNU("Y","Do you want to continue with adding a new Disclosure","YES")

 . ;

 . D ADDPAT Q:BRNQUIT

 . ;

 . S DIE="^BRNREC(",DA=BRNRIEN,DR="[BRN MULTIPLE ADD]",DIE("NO^")=1

 . D ^DIE K DA,DR,DIE,DIE("NO^")

 . W !

 Q

 ;

ADDPAT ; add new disclosure for this patient

 NEW DIC,Y,DD,DO,DLAYGO

 S DIC="^BRNREC(",DIC(0)="L",DLAYGO=90264,DIC("DR")=".03////"_BRNDFN,X=BRNRDATE

 D FILE^DICN

 I Y<0 D  Q

 . W !,"Error creating DISCLOSURE.",!,"Notify programmer.",!

 . D PAUSE^BRNU

 . S BRNQUIT=1

 ;

 S BRNRIEN=+Y

 W !!,"DISCLOSURE NUMBER: ",$$GET1^DIQ(90264,BRNRIEN,.02)

 Q

BRNADDM   ; IHS/OIT/LJF - ADD MULTIPLE PATIENTS UNDER ONE REQUEST

 +1       ;;2.0;RELEASE OF INFO SYSTEM;*1*;APR 10, 2003

 +2       ; IHS/OIT/LJF 01/03/2008 PATCH 1 - routine added

 +3       ;

 +4        WRITE !!,"This option allows you to enter multiple patients under one request."

 +5        WRITE !,"You will be asked the requesting information once and then the "

 +6        WRITE !,"specific information for each patient.",!

 +7       ;

 +8        NEW BRNQUIT,BRNRDATE,BRNTYPE,BRNOTHER,BRNMETH,BRNPARTY,BRNPUR,BRNPRIOR

DATE       SET BRNRDATE=$$READ^BRNU("90264,.01","DATE REQUEST INITIATED","TODAY")

 +1        IF BRNRDATE<1

               QUIT 

 +2        IF '$$FACOK^BRNU(BRNRDATE)

               WRITE !,"** MUST BE BEFORE YOUR DIVISION'S INACTIVATION DATE **",!

               DO DATE

               QUIT 

 +3       ;

 +4        SET BRNTYPE=$$READ^BRNU("90264,.04")

           IF BRNTYPE=U

               QUIT 

 +5        IF BRNTYPE="O"

               SET BRNOTHER=$$READ^BRNU("90264,.05")

 +6       ;

 +7        SET BRNMETH=$$READ^BRNU("90264,.21")

           IF BRNMETH=U

               QUIT 

 +8        SET BRNPARTY=+$$READ^BRNU("90264,.06")

           IF BRNPARTY=U

               QUIT 

 +9        SET BRNPUR=$$READ^BRNU("90264,.07")

           IF BRNPUR=U

               QUIT 

 +10       SET Y=BRNPUR

           SET C=$PIECE(^DD(90264,.07,0),U,2)

           DO Y^DIQ

           SET BRNPUR=Y

           KILL C,Y

 +11       SET BRNPRIOR=$$READ^BRNU("90264,.09",,"NON-CRITICAL")

           IF BRNPRIOR=U

               QUIT 

 +12      ;

PATS      ; loop through patients, stuff common data and ask individual data

 +1        NEW FIRST,BRNDFN,BRNRIEN

 +2        SET BRNQUIT=0

           SET FIRST=1

 +3        FOR 

               Begin DoDot:1

 +4                SET PROMPT="Select "_$SELECT(FIRST:"",1:"Another ")_"PATIENT"

                   SET FIRST=0

 +5                SET BRNDFN=+$$READ^BRNU("PO^2:EMQZ",PROMPT)

                   IF BRNDFN<1

                       QUIT 

 +6       ;

 +7                IF $$DOD^AUPNPAT(BRNDFN)

                       Begin DoDot:2

 +8                        WRITE !!,"This patient is deceased."

 +9                        IF '$$READ^BRNU("Y","Are you sure you want this patient","NO")

                               SET BRNQUIT=1

                       End DoDot:2

                       IF BRNQUIT

                           QUIT 

 +10      ;

 +11              IF '$TEST

                       IF '$$READ^BRNU("Y","Do you want to continue with adding a new Disclosure","YES")

                           QUIT 

 +12      ;

 +13               DO ADDPAT

                   IF BRNQUIT

                       QUIT 

 +14      ;

 +15               SET DIE="^BRNREC("

                   SET DA=BRNRIEN

                   SET DR="[BRN MULTIPLE ADD]"

                   SET DIE("NO^")=1

 +16               DO ^DIE

                   KILL DA,DR,DIE,DIE("NO^")

 +17               WRITE !

               End DoDot:1

               IF BRNDFN<1

                   QUIT 

 +18       QUIT 

 +19      ;

ADDPAT    ; add new disclosure for this patient

 +1        NEW DIC,Y,DD,DO,DLAYGO

 +2        SET DIC="^BRNREC("

           SET DIC(0)="L"

           SET DLAYGO=90264

           SET DIC("DR")=".03////"_BRNDFN

           SET X=BRNRDATE

 +3        DO FILE^DICN

 +4        IF Y<0

               Begin DoDot:1

 +5                WRITE !,"Error creating DISCLOSURE.",!,"Notify programmer.",!

 +6                DO PAUSE^BRNU

 +7                SET BRNQUIT=1

               End DoDot:1

               QUIT 

 +8       ;

 +9        SET BRNRIEN=+Y

 +10       WRITE !!,"DISCLOSURE NUMBER: ",$$GET1^DIQ(90264,BRNRIEN,.02)

 +11       QUIT