BVPAGV.m

BVPAGV ; IHS/ITSC/LJF - PATIENT DATA VIEW ;

 ;;1.0;VIEW PATIENT RECORD;;NOV 17, 2004

 ;Copy of AGSEENLY, modified to remove user interaction

 ;IHS/ITSC/LJF 08/21/2003 added L2 line label and changed references from L1 to L2

 ;

 D ^AGVAR

L1 ;D ^AG W !!!?27,"Patient Data View System",!!

 ;D PTLK^AG

 I $D(DFN) S AGSEENLY="",AGPAGE=1 G L5

L2 ;Added line label

 K AG,AGSEENLY,DIC,AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AGPAGE

 Q

L5 ;

 D @($P($T(@AGPAGE),";;",2)) W !,AGLINE("EQ")

 I AGPAGE<10 S DIR("A")="                               Press RETURN " D READ

 ;G L1:$D(DTOUT)!$D(DFOUT)

 G L2:$D(DTOUT)!$D(DFOUT)

 ;I $D(DUOUT) S AGPAGE=AGPAGE-1 G L5:AGPAGE>0,L1

 I $D(DUOUT) S AGPAGE=AGPAGE-1 G L5:AGPAGE>0,L2

 I $D(AG("ED")) S AGPAGE=AG("ED") G L5

 ;S AGPAGE=AGPAGE+1 G L5:AGPAGE<10,L1

 S AGPAGE=AGPAGE+1 G L5:AGPAGE<10,L2

READ ;

 K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,AG("ED"),AG("ERR"),DIROUT

 S DIR(0)="FO^1:3"

 D ^DIR

 Q:$D(DTOUT)

 S:Y="/.,"!(Y="^^") DFOUT=""

 S:Y="" DLOUT=""

 S:Y="^" (DUOUT,Y)=""

 S:Y?1"?".E!(Y["^") (DQOUT,Y)=""

 I $E(Y,1)="P" D

 . S AG("ED")=+$E(Y,2,99)

 . I AG("ED")<1!(AG("ED")>9) D

 .. W *7,!!,"Use only pages 1 through 9."

 .. H 2

 .. K AG("ED")

 .. S AG("ERR")=""

 Q

1 ;;^AGED1

2 ;;DRAW^AGED2

3 ;;DRAW^AGED3

4 ;;^AGED4A

5 ;;^AGED4B

6 ;;^AGED13

7 ;;^AGED8

8 ;;^AGED11

9 ;;^AGED11A

BVPAGV    ; IHS/ITSC/LJF - PATIENT DATA VIEW ;

 +1       ;;1.0;VIEW PATIENT RECORD;;NOV 17, 2004

 +2       ;Copy of AGSEENLY, modified to remove user interaction

 +3       ;IHS/ITSC/LJF 08/21/2003 added L2 line label and changed references from L1 to L2

 +4       ;

 +5        DO ^AGVAR

L1        ;D ^AG W !!!?27,"Patient Data View System",!!

 +1       ;D PTLK^AG

 +2        IF $DATA(DFN)

               SET AGSEENLY=""

               SET AGPAGE=1

               GOTO L5

L2        ;Added line label

 +1        KILL AG,AGSEENLY,DIC,AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AGPAGE

 +2        QUIT 

L5        ;

 +1        DO @($PIECE($TEXT(@AGPAGE),";;",2))

           WRITE !,AGLINE("EQ")

 +2        IF AGPAGE<10

               SET DIR("A")="                               Press RETURN "

               DO READ

 +3       ;G L1:$D(DTOUT)!$D(DFOUT)

 +4        IF $DATA(DTOUT)!$DATA(DFOUT)

               GOTO L2

 +5       ;I $D(DUOUT) S AGPAGE=AGPAGE-1 G L5:AGPAGE>0,L1

 +6        IF $DATA(DUOUT)

               SET AGPAGE=AGPAGE-1

               IF AGPAGE>0

                   GOTO L5

               GOTO L2

 +7        IF $DATA(AG("ED"))

               SET AGPAGE=AG("ED")

               GOTO L5

 +8       ;S AGPAGE=AGPAGE+1 G L5:AGPAGE<10,L1

 +9        SET AGPAGE=AGPAGE+1

           IF AGPAGE<10

               GOTO L5

           GOTO L2

READ      ;

 +1        KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT,AG("ED"),AG("ERR"),DIROUT

 +2        SET DIR(0)="FO^1:3"

 +3        DO ^DIR

 +4        IF $DATA(DTOUT)

               QUIT 

 +5        IF Y="/.,"!(Y="^^")

               SET DFOUT=""

 +6        IF Y=""

               SET DLOUT=""

 +7        IF Y="^"

               SET (DUOUT,Y)=""

 +8        IF Y?1"?".E!(Y["^")

               SET (DQOUT,Y)=""

 +9        IF $EXTRACT(Y,1)="P"

               Begin DoDot:1

 +10               SET AG("ED")=+$EXTRACT(Y,2,99)

 +11               IF AG("ED")<1!(AG("ED")>9)

                       Begin DoDot:2

 +12                       WRITE *7,!!,"Use only pages 1 through 9."

 +13                       HANG 2

 +14                       KILL AG("ED")

 +15                       SET AG("ERR")=""

                       End DoDot:2

               End DoDot:1

 +16       QUIT 

1         ;;^AGED1

2         ;;DRAW^AGED2

3         ;;DRAW^AGED3

4         ;;^AGED4A

5         ;;^AGED4B

6         ;;^AGED13

7         ;;^AGED8

8         ;;^AGED11

9         ;;^AGED11A