AMHRDSP.m

AMHRDSP ; IHS/CMI/LAB - display record in detail ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**1,5**;JUN 02, 2010;Build 18

 ;

 ;CALLER passes AMHR as record ien

EN ;EP

 Q:'$G(AMHR)

 Q:'$D(^AMHREC(AMHR,0))

 D DSPLY

 D EOJ

 Q

 ;

DSPLY ;

 W:$D(IOF) @IOF

 NEW D0,DA,DIC,DIQ,DR,DL,DK,DX,S

 S AMHBRK=0 ;ACC

 S AMHVDSH="----------------------"

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 S X="",$P(X,"~",80)="" W !!,X,!!,AMHVDSH,"     BH RECORD     ",AMHVDSH

 S DIC="^AMHREC(",DA=AMHR D EN^DIQ

DSPLY1 ;DISPLAY V FILE DATA

 S AMHVFLE=9002011 F AMHVL=0:0 S AMHVFLE=$O(^DIC(AMHVFLE)) Q:AMHVFLE>9002011.49!(AMHVFLE'=+AMHVFLE)!(AMHBRK)  D DSPLY2 Q:AMHBRK  ;ACC

 I 'AMHBRK S X="",$P(X,"~",80)="" W !!,X,!!

 Q

 ;

DSPLY2 S AMHVNM=$P(^DIC(AMHVFLE,0),U)

 S AMHVDG=^DIC(AMHVFLE,0,"GL"),AMHVIGR=AMHVDG_"""AD"",AMHR,AMHVDFN)"

 S AMHVDFN=""!(AMHBRK) F AMHVI=1:1 S AMHVDFN=$O(@AMHVIGR) Q:AMHVDFN=""  D DSPLY3 Q:AMHBRK  ;ACC

 Q

 ;

DSPLY3 ;

 I $Y>(IOSL-5) D

 .I '$D(ZTQUEUED),$E(IOST)="C" W !!,"Enter to continue, '^' to halt " R AMHX:DTIME S:'$T AMHBRK=1 S:AMHX="^" AMHBRK=1 K S

 .W:$D(IOF) @IOF

 .Q

 Q:AMHBRK

 I AMHVI<2 S X=20-$L(AMHVNM),Y=X\2,Z=X-Y W !,AMHVDSH," ",$J("",Z),AMHVNM,$J("",Y)," ",AMHVDSH

 S DIC=AMHVDG,DA=AMHVDFN,DIQ(0)="C" D EN^DIQ

 Q

 ;

EOJ ; EOJ CLEANUP

 I 'AMHBRK,$E(IOST)="C",'$D(ZTQUEUED) S DIR(0)="EO",DIR("A")="End of record display, press <ENTER> to continue" K DA D ^DIR K DIR

 K X,Y

 K AMHVDFN,AMHVDG,AMHVDSH,AMHVFLE,AMHVI,AMHVIGR,AMHVL,AMHVNM,AMHX,AMHBRK

 Q

AMHRDSP   ; IHS/CMI/LAB - display record in detail ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**1,5**;JUN 02, 2010;Build 18

 +2       ;

 +3       ;CALLER passes AMHR as record ien

EN        ;EP

 +1        IF '$GET(AMHR)

               QUIT 

 +2        IF '$DATA(^AMHREC(AMHR,0))

               QUIT 

 +3        DO DSPLY

 +4        DO EOJ

 +5        QUIT 

 +6       ;

DSPLY     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        NEW D0,DA,DIC,DIQ,DR,DL,DK,DX,S

 +3       ;ACC

           SET AMHBRK=0

 +4        SET AMHVDSH="----------------------"

 +5        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +6        SET X=""

           SET $PIECE(X,"~",80)=""

           WRITE !!,X,!!,AMHVDSH,"     BH RECORD     ",AMHVDSH

 +7        SET DIC="^AMHREC("

           SET DA=AMHR

           DO EN^DIQ

DSPLY1    ;DISPLAY V FILE DATA

 +1       ;ACC

           SET AMHVFLE=9002011

           FOR AMHVL=0:0

               SET AMHVFLE=$ORDER(^DIC(AMHVFLE))

               IF AMHVFLE>9002011.49!(AMHVFLE'=+AMHVFLE)!(AMHBRK)

                   QUIT 

               DO DSPLY2

               IF AMHBRK

                   QUIT 

 +2        IF 'AMHBRK

               SET X=""

               SET $PIECE(X,"~",80)=""

               WRITE !!,X,!!

 +3        QUIT 

 +4       ;

DSPLY2     SET AMHVNM=$PIECE(^DIC(AMHVFLE,0),U)

 +1        SET AMHVDG=^DIC(AMHVFLE,0,"GL")

           SET AMHVIGR=AMHVDG_"""AD"",AMHR,AMHVDFN)"

 +2       ;ACC

           SET AMHVDFN=""!(AMHBRK)

           FOR AMHVI=1:1

               SET AMHVDFN=$ORDER(@AMHVIGR)

               IF AMHVDFN=""

                   QUIT 

               DO DSPLY3

               IF AMHBRK

                   QUIT 

 +3        QUIT 

 +4       ;

DSPLY3    ;

 +1        IF $Y>(IOSL-5)

               Begin DoDot:1

 +2                IF '$DATA(ZTQUEUED)

                       IF $EXTRACT(IOST)="C"

                           WRITE !!,"Enter to continue, '^' to halt "

                           READ AMHX:DTIME

                           IF '$TEST

                               SET AMHBRK=1

                           IF AMHX="^"

                               SET AMHBRK=1

                           KILL S

 +3                IF $DATA(IOF)

                       WRITE @IOF

 +4                QUIT 

               End DoDot:1

 +5        IF AMHBRK

               QUIT 

 +6        IF AMHVI<2

               SET X=20-$LENGTH(AMHVNM)

               SET Y=X\2

               SET Z=X-Y

               WRITE !,AMHVDSH," ",$JUSTIFY("",Z),AMHVNM,$JUSTIFY("",Y)," ",AMHVDSH

 +7        SET DIC=AMHVDG

           SET DA=AMHVDFN

           SET DIQ(0)="C"

           DO EN^DIQ

 +8        QUIT 

 +9       ;

EOJ       ; EOJ CLEANUP

 +1        IF 'AMHBRK

               IF $EXTRACT(IOST)="C"

                   IF '$DATA(ZTQUEUED)

                       SET DIR(0)="EO"

                       SET DIR("A")="End of record display, press <ENTER> to continue"

                       KILL DA

                       DO ^DIR

                       KILL DIR

 +2        KILL X,Y

 +3        KILL AMHVDFN,AMHVDG,AMHVDSH,AMHVFLE,AMHVI,AMHVIGR,AMHVL,AMHVNM,AMHX,AMHBRK

 +4        QUIT