BCHUDSP.m

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

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;

 ;CALLER passes BCHR as record ien

EN ;EP

 Q:'$G(BCHR)

 Q:'$D(^BCHR(BCHR,0))

 D @("HEAD"_(2-($E(IOST,1,2)="C-")))

 ;D EOP

 D EOJ

 Q

 ;

HEAD1 ; if terminal

 W:$D(IOF) @IOF

HEAD2 ; if printer    

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

 S BCHBRK=0 ;ACC

 S BCHVDSH="----------------------------"

 ;S X="",$P(X,"~",80)="" W X,!!

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

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

 W BCHVDSH,"     CHR RECORD     ",BCHVDSH

 S DIC="^BCHR(",DA=BCHR D EN^DIQ

DSPLY1 ;DISPLAY V FILE DATA

 S BCHVFLE=90002 F BCHVL=0:0 S BCHVFLE=$O(^DIC(BCHVFLE)) Q:BCHVFLE>90002.09!(BCHVFLE'=+BCHVFLE)!(BCHBRK)  D DSPLY2 Q:BCHBRK  ;ACC

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

 Q

 ;

DSPLY2 S BCHVNM=$P(^DIC(BCHVFLE,0),U)

 S BCHVDG=^DIC(BCHVFLE,0,"GL"),BCHVIGR=BCHVDG_"""AD"",BCHR,BCHVDFN)"

 S BCHVDFN=""!(BCHBRK) F BCHVI=1:1 S BCHVDFN=$O(@BCHVIGR) Q:BCHVDFN=""  D DSPLY3 Q:BCHBRK  ;ACC

 Q

 ;

DSPLY3 ;

 ;I $Y<(IOSL-5) W !!,"Return to continue, '^' to halt " R BCHX:DTIME S:'$T BCHBRK=1 S:BCHX="^" BCHBRK=1 K S W:$D(IOF) @IOF

 I $Y>(IOSL-5) D EOP

 Q:BCHBRK

 I BCHVI<2 S X=20-$L(BCHVNM),Y=X\2,Z=X-Y W !,BCHVDSH," ",$J("",Z),BCHVNM,$J("",Y)," ",BCHVDSH

 K DR

 S DIC=BCHVDG,DA=BCHVDFN,DIQ(0)="C" D EN^DIQ

 Q

 ;

EOJ ; EOJ CLEANUP

 I 'BCHBRK,IOST["C-" W ! S DIR(0)="E",DIR("A")="End of record display, HIT <RETURN> to continue" K DA D ^DIR K DIR

 K BCHVDFN,BCHVDG,BCHVDSH,BCHVFLE,BCHVI,BCHVIGR,BCHVL,BCHVNM,BCHX,BCHBRK

 Q

 ;

EOP ; pause OR form feed between pages for terminal/printer

 I $E(IOST,1,2)="P-"!($D(IO("S"))) W @IOF Q

 W ! S DIR(0)="EO" D ^DIR K DIR S:$D(DUOUT) (DIRUT,BCHBRK)=1

 Q

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

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

 +3       ;CALLER passes BCHR as record ien

EN        ;EP

 +1        IF '$GET(BCHR)

               QUIT 

 +2        IF '$DATA(^BCHR(BCHR,0))

               QUIT 

 +3        DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))

 +4       ;D EOP

 +5        DO EOJ

 +6        QUIT 

 +7       ;

HEAD1     ; if terminal

 +1        IF $DATA(IOF)

               WRITE @IOF

HEAD2     ; if printer    

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

 +2       ;ACC

           SET BCHBRK=0

 +3        SET BCHVDSH="----------------------------"

 +4       ;S X="",$P(X,"~",80)="" W X,!!

 +5        SET X=""

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

           WRITE !,X,!!

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

 +7        WRITE BCHVDSH,"     CHR RECORD     ",BCHVDSH

 +8        SET DIC="^BCHR("

           SET DA=BCHR

           DO EN^DIQ

DSPLY1    ;DISPLAY V FILE DATA

 +1       ;ACC

           SET BCHVFLE=90002

           FOR BCHVL=0:0

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

               IF BCHVFLE>90002.09!(BCHVFLE'=+BCHVFLE)!(BCHBRK)

                   QUIT 

               DO DSPLY2

               IF BCHBRK

                   QUIT 

 +2        IF 'BCHBRK

               SET X=""

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

               WRITE !!,X,!!

 +3        QUIT 

 +4       ;

DSPLY2     SET BCHVNM=$PIECE(^DIC(BCHVFLE,0),U)

 +1        SET BCHVDG=^DIC(BCHVFLE,0,"GL")

           SET BCHVIGR=BCHVDG_"""AD"",BCHR,BCHVDFN)"

 +2       ;ACC

           SET BCHVDFN=""!(BCHBRK)

           FOR BCHVI=1:1

               SET BCHVDFN=$ORDER(@BCHVIGR)

               IF BCHVDFN=""

                   QUIT 

               DO DSPLY3

               IF BCHBRK

                   QUIT 

 +3        QUIT 

 +4       ;

DSPLY3    ;

 +1       ;I $Y<(IOSL-5) W !!,"Return to continue, '^' to halt " R BCHX:DTIME S:'$T BCHBRK=1 S:BCHX="^" BCHBRK=1 K S W:$D(IOF) @IOF

 +2        IF $Y>(IOSL-5)

               DO EOP

 +3        IF BCHBRK

               QUIT 

 +4        IF BCHVI<2

               SET X=20-$LENGTH(BCHVNM)

               SET Y=X\2

               SET Z=X-Y

               WRITE !,BCHVDSH," ",$JUSTIFY("",Z),BCHVNM,$JUSTIFY("",Y)," ",BCHVDSH

 +5        KILL DR

 +6        SET DIC=BCHVDG

           SET DA=BCHVDFN

           SET DIQ(0)="C"

           DO EN^DIQ

 +7        QUIT 

 +8       ;

EOJ       ; EOJ CLEANUP

 +1        IF 'BCHBRK

               IF IOST["C-"

                   WRITE !

                   SET DIR(0)="E"

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

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +2        KILL BCHVDFN,BCHVDG,BCHVDSH,BCHVFLE,BCHVI,BCHVIGR,BCHVL,BCHVNM,BCHX,BCHBRK

 +3        QUIT 

 +4       ;

EOP       ; pause OR form feed between pages for terminal/printer

 +1        IF $EXTRACT(IOST,1,2)="P-"!($DATA(IO("S")))

               WRITE @IOF

               QUIT 

 +2        WRITE !

           SET DIR(0)="EO"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET (DIRUT,BCHBRK)=1

 +3        QUIT