- 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
