BRNPTR.m

BRNPTR ; IHS/PHXAO/TMJ - PT RECORD ; 

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

 ;

 ;

START ;Get Patient

 S BRNPAT=""

 D GETPAT

 I BRNPAT="" W !!,"No PATIENT Selected!" D EOJ Q

 S BRNANS=0,BRNQ=0

 D GETANS

 I BRNQ=1 D EOJ Q

 D GETDIS

 D EOJ

 Q

 ;

GETPAT ;Get Patient Name

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S BRNPAT=+Y

 Q

 ;

 ;

GETANS ;Ask if User wants to Print Suspended Disclosures

 ;

 S DIR(0)="YO",DIR("A")="Do You Wish to print SUSPENDED Disclosures",DIR("B")="NO" K DA D ^DIR K DIR

 I $D(DIRUT) S BRNQ=1 Q

 ;I Y=0 S BRNQ=1 Q

 S BRNANS=+Y

 Q

GETDIS ;Get this Patient's Disclosure Records

 ;

 Q:'BRNPAT

 S BRNCT=0

 W ! K IOP S %ZIS="P" K IO("Q") D ^%ZIS

 D HEADER

BEGIN ;Begin $ORDER

 S BRNIEN="" F  S BRNIEN=$O(^BRNREC("E",BRNPAT,BRNIEN)) Q:BRNIEN'=+BRNIEN  D

 . S BRNQUIT=0

 . S BRNSSDT=$P($G(^BRNREC(BRNIEN,24)),U,3) ;SUSPEND START DATE

 . S BRNSEDT=$P($G(^BRNREC(BRNIEN,24)),U,4) ;SUSPEND END DATE

 . I BRNSSDT'=""  D

 . . Q:BRNANS'=0  ;Quit if User wants to Print Suspsended Disclosures

 . . I BRNSSDT<DT&(BRNSEDT>DT) S BRNQUIT=1

 . Q:BRNQUIT=1

 . S BRNCT=BRNCT+1

 . S BRNDN=$P($G(^BRNREC(BRNIEN,0)),U,2)

 . S BRNDT=$P($G(^BRNREC(BRNIEN,0)),U)

 . S BRNDTP=$$FMTE^XLFDT(BRNDT,"2P")

 . S BRNPTY=$P($G(^BRNREC(BRNIEN,0)),U,6)

 . S BRNPTYP=$P($G(^BRNTREQ(BRNPTY,0)),U)

 . S BRNPTYP=$E(BRNPTYP,1,21)

 . S BRNTYP=$P($G(^BRNREC(BRNIEN,0)),U,4)

 . S BRNST=$P($G(^BRNREC(BRNIEN,0)),U,8)

 . W ?5,BRNCT_")",?12,BRNDN,?23,BRNDTP,?37,BRNPTYP,?62,BRNTYP,?73,BRNST,!

 I BRNCT=0 W !,?5,"**NO DISCLOSURE RECORDS TO PRINT FOR THIS PATIENT**",!

 ;

 Q

PRINT ;Print the Disclosure Records

 ;

 ;

 Q

 ;

HEADER ;Print the Header for Display

 W !!,?5,"CUMMULATIVE DISCLOSURE RECORDS FOR: "_$P($G(^DPT(BRNPAT,0)),U),!

 W ?5,"HEALTH RECORD #: " W ?25,$$HRN^AUPNPAT(BRNPAT,DUZ(2),2),!

 W ?5,"DISPLAY DATE: "_$$FMTE^XLFDT(DT,"1P")

 ;W !!,?5,"PT NAME",?40,"DISCLOSURE #",?55,"DISC DT",!!

 W !!,?3,"Number",?12,"DISC #",?23,"DT REC'D",?37,"REQUESTING PARTY",?60,"TYPE",?70,"STATUS",!

 W ?3,"____________________________________________________________________________",!

 Q

EOJ ;End of Job

 K %,%DT,%X,%Y

 K BRNPAT,BRNDIS,BRNCT,BRNDN,BRNDT,BRNDTP,BRNIEN,BRNPTY,BRNPTYP,BRNTYP,BRNST,BRNSEDT,BRNSSDT,BRNQUIT,BRNANS,BRNQ

 D KILL^AUPNPAT

 Q

BRNPTR    ; IHS/PHXAO/TMJ - PT RECORD ; 

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

 +2       ;

 +3       ;

START     ;Get Patient

 +1        SET BRNPAT=""

 +2        DO GETPAT

 +3        IF BRNPAT=""

               WRITE !!,"No PATIENT Selected!"

               DO EOJ

               QUIT 

 +4        SET BRNANS=0

           SET BRNQ=0

 +5        DO GETANS

 +6        IF BRNQ=1

               DO EOJ

               QUIT 

 +7        DO GETDIS

 +8        DO EOJ

 +9        QUIT 

 +10      ;

GETPAT    ;Get Patient Name

 +1        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +2        IF Y<0

               QUIT 

 +3        SET BRNPAT=+Y

 +4        QUIT 

 +5       ;

 +6       ;

GETANS    ;Ask if User wants to Print Suspended Disclosures

 +1       ;

 +2        SET DIR(0)="YO"

           SET DIR("A")="Do You Wish to print SUSPENDED Disclosures"

           SET DIR("B")="NO"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET BRNQ=1

               QUIT 

 +4       ;I Y=0 S BRNQ=1 Q

 +5        SET BRNANS=+Y

 +6        QUIT 

GETDIS    ;Get this Patient's Disclosure Records

 +1       ;

 +2        IF 'BRNPAT

               QUIT 

 +3        SET BRNCT=0

 +4        WRITE !

           KILL IOP

           SET %ZIS="P"

           KILL IO("Q")

           DO ^%ZIS

 +5        DO HEADER

BEGIN     ;Begin $ORDER

 +1        SET BRNIEN=""

           FOR 

               SET BRNIEN=$ORDER(^BRNREC("E",BRNPAT,BRNIEN))

               IF BRNIEN'=+BRNIEN

                   QUIT 

               Begin DoDot:1

 +2                SET BRNQUIT=0

 +3       ;SUSPEND START DATE

                   SET BRNSSDT=$PIECE($GET(^BRNREC(BRNIEN,24)),U,3)

 +4       ;SUSPEND END DATE

                   SET BRNSEDT=$PIECE($GET(^BRNREC(BRNIEN,24)),U,4)

 +5                IF BRNSSDT'=""

                       Begin DoDot:2

 +6       ;Quit if User wants to Print Suspsended Disclosures

                           IF BRNANS'=0

                               QUIT 

 +7                        IF BRNSSDT<DT&(BRNSEDT>DT)

                               SET BRNQUIT=1

                       End DoDot:2

 +8                IF BRNQUIT=1

                       QUIT 

 +9                SET BRNCT=BRNCT+1

 +10               SET BRNDN=$PIECE($GET(^BRNREC(BRNIEN,0)),U,2)

 +11               SET BRNDT=$PIECE($GET(^BRNREC(BRNIEN,0)),U)

 +12               SET BRNDTP=$$FMTE^XLFDT(BRNDT,"2P")

 +13               SET BRNPTY=$PIECE($GET(^BRNREC(BRNIEN,0)),U,6)

 +14               SET BRNPTYP=$PIECE($GET(^BRNTREQ(BRNPTY,0)),U)

 +15               SET BRNPTYP=$EXTRACT(BRNPTYP,1,21)

 +16               SET BRNTYP=$PIECE($GET(^BRNREC(BRNIEN,0)),U,4)

 +17               SET BRNST=$PIECE($GET(^BRNREC(BRNIEN,0)),U,8)

 +18               WRITE ?5,BRNCT_")",?12,BRNDN,?23,BRNDTP,?37,BRNPTYP,?62,BRNTYP,?73,BRNST,!

               End DoDot:1

 +19       IF BRNCT=0

               WRITE !,?5,"**NO DISCLOSURE RECORDS TO PRINT FOR THIS PATIENT**",!

 +20      ;

 +21       QUIT 

PRINT     ;Print the Disclosure Records

 +1       ;

 +2       ;

 +3        QUIT 

 +4       ;

HEADER    ;Print the Header for Display

 +1        WRITE !!,?5,"CUMMULATIVE DISCLOSURE RECORDS FOR: "_$PIECE($GET(^DPT(BRNPAT,0)),U),!

 +2        WRITE ?5,"HEALTH RECORD #: "

           WRITE ?25,$$HRN^AUPNPAT(BRNPAT,DUZ(2),2),!

 +3        WRITE ?5,"DISPLAY DATE: "_$$FMTE^XLFDT(DT,"1P")

 +4       ;W !!,?5,"PT NAME",?40,"DISCLOSURE #",?55,"DISC DT",!!

 +5        WRITE !!,?3,"Number",?12,"DISC #",?23,"DT REC'D",?37,"REQUESTING PARTY",?60,"TYPE",?70,"STATUS",!

 +6        WRITE ?3,"____________________________________________________________________________",!

 +7        QUIT 

EOJ       ;End of Job

 +1        KILL %,%DT,%X,%Y

 +2        KILL BRNPAT,BRNDIS,BRNCT,BRNDN,BRNDT,BRNDTP,BRNIEN,BRNPTY,BRNPTYP,BRNTYP,BRNST,BRNSEDT,BRNSSDT,BRNQUIT,BRNANS,BRNQ

 +3        DO KILL^AUPNPAT

 +4        QUIT