BRNPTN.m

BRNPTN ; IHS/PHXAO/TMJ - ROI CUMMULATIVE PATIENT HX FOR CHART ; 

 ;;2.0;RELEASE OF INFO SYSTEM;**4**;APR 10, 2003;Build 15

 ;;IHS/OIT/GAB PATCH 4 - FIX UNDEFINED ERROR; April 2017

SERVICE ;PICK PATIENT NAME ENTRY

 W !!!

 S DIC=2 S DIC("A")="Enter a Patient Name: " S DIC(0)="AEMIQO" D ^DIC

 G END:Y<1 S BRNPTN=+Y

 I BRNPTN="" Q

 D CKDIS           ;IHS/OIT/GAB PATCH 4 CHECK FOR ANY DISCLOSURES

 G RETURN:NODIS=1  ;IHS/OIT/GAB PATCH 4 END SINCE NO DISCLOSURES

PRINT ;PRINT CUMMULATIVE PATIENT RECORD OF ALL DISCLOSURES

 W !

 S FLDS="[BRN GS ACCOUNTING RECORD]",BY="@INTERNAL(#.03)",DIC="^BRNREC(",L=0

 S FR=BRNPTN,TO=BRNPTN

 K DHIT,DIOEND,DIOBEG

 D EN1^DIP

 G RETURN

 Q

CKDIS ; IHS/OIT/GAB PATCH 4 - FIX UNDEF ERROR WHEN THERE ARE NO DISCLOSURES

 S NODIS=""

 I '$D(^BRNREC("AA",BRNPTN)) W !!,?20,"******** NO EXISTING DISCLOSURES FOR THIS PATIENT ***" S NODIS=1

 Q

RETURN ;   /IHS/GAB ADDED PATCH #4

 ; Press return to continue

 W !

 S DIR(0)="E"

 S DIR("A")="Press return to continue..."

 D ^DIR

 K DIR

END ;

 K BRNPTN,X,DD0,B Q

BRNPTN    ; IHS/PHXAO/TMJ - ROI CUMMULATIVE PATIENT HX FOR CHART ; 

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

 +2       ;;IHS/OIT/GAB PATCH 4 - FIX UNDEFINED ERROR; April 2017

SERVICE   ;PICK PATIENT NAME ENTRY

 +1        WRITE !!!

 +2        SET DIC=2

           SET DIC("A")="Enter a Patient Name: "

           SET DIC(0)="AEMIQO"

           DO ^DIC

 +3        IF Y<1

               GOTO END

           SET BRNPTN=+Y

 +4        IF BRNPTN=""

               QUIT 

 +5       ;IHS/OIT/GAB PATCH 4 CHECK FOR ANY DISCLOSURES

           DO CKDIS

 +6       ;IHS/OIT/GAB PATCH 4 END SINCE NO DISCLOSURES

           IF NODIS=1

               GOTO RETURN

PRINT     ;PRINT CUMMULATIVE PATIENT RECORD OF ALL DISCLOSURES

 +1        WRITE !

 +2        SET FLDS="[BRN GS ACCOUNTING RECORD]"

           SET BY="@INTERNAL(#.03)"

           SET DIC="^BRNREC("

           SET L=0

 +3        SET FR=BRNPTN

           SET TO=BRNPTN

 +4        KILL DHIT,DIOEND,DIOBEG

 +5        DO EN1^DIP

 +6        GOTO RETURN

 +7        QUIT 

CKDIS     ; IHS/OIT/GAB PATCH 4 - FIX UNDEF ERROR WHEN THERE ARE NO DISCLOSURES

 +1        SET NODIS=""

 +2        IF '$DATA(^BRNREC("AA",BRNPTN))

               WRITE !!,?20,"******** NO EXISTING DISCLOSURES FOR THIS PATIENT ***"

               SET NODIS=1

 +3        QUIT 

RETURN    ;   /IHS/GAB ADDED PATCH #4

 +1       ; Press return to continue

 +2        WRITE !

 +3        SET DIR(0)="E"

 +4        SET DIR("A")="Press return to continue..."

 +5        DO ^DIR

 +6        KILL DIR

END       ;

 +1        KILL BRNPTN,X,DD0,B

           QUIT