LRGVP.m

LRGVP ;VA/SLC/CJS - GROUP DATA REVIEW DISPLAY ; 13-Aug-2013 09:16 ; MKK

 ;;5.2;LR;**112,1013,411,1033**;NOV 1, 1997

 ;

EP ; EP

 I '$D(LRPARAM) D ^LRPARAM

 K LRORD S LRGVP="",LRPANEL="ALL" W !,"Print manually entered data by accession",!

 S DIC="^LRO(68,",DIC(0)="AEFOMQ" D ^DIC S LRAA=+Y,LRNAME=$P(Y,U,2) Q:LRAA<1  D PHD Q:LREND

 Q:'$D(^LRO(68,LRAA,1,LRAD,1,0))  S:'$D(LRNAME) LRNAME=$P(^LRO(68,LRAA,0),U,1)

 S %ZIS="Q" D ^%ZIS Q:POP

 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^LRGVP",ZTSAVE("LR*")="",ZTSAVE("^TMP(""LR"",$J,")="" D ^%ZTLOAD G END

DQ U IO D HED S LRAN=LRFAN-.01 F  S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:LRAN<1!(LRAN>LRLAN)  D PRINT  Q:$D(DUOUT)!$D(DTOUT)

 W:'$D(LRORD) !,"No data to review.",! D ^%ZISC

END K LRGFLPG G ^LRGVK

PRINT Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))  S LRDFN=+^(0),LRORD=$S($D(^(.1)):^(.1),1:0),LRODT=$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRLLOC=$P(^(0),U,7),LRSN=$P(^(0),U,5) Q:LRSN<1

 S LRDPF=$P(^LR(LRDFN,0),U,2) W:'$L($S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)):$P(^(3),U,3),1:""))&(LRDPF=2) !,"NOT COLLECTED"

 S DFN=$P(^LR(LRDFN,0),U,3) D PT^LRX W:$E(IOST,1,2)'="C-"&(IOSL\3*2<$Y) @IOF

 D:$E(IOST,1,2)="C-"&$D(LRGFLPG) PG Q:$D(DUOUT)!$D(DTOUT)  S LRGFLPG=""

 ; W !!,PNM,?30,"SSN: ",SSN,?50,"WARD: ",$S(LRDPF=2&($L(LRWRD)):LRWRD,1:LRLLOC) W:LRORD !,"ORDER NUMBER: ",LRORD

 W !!,PNM,?30,"HRCN: ",HRCN,?50,"WARD: ",$S(LRDPF=2&($L(LRWRD)):LRWRD,1:LRLLOC) W:LRORD !,"ORDER NUMBER: ",LRORD    ;IHS/ANMC/CLS 08/18/96

 S LRPANEL="ALL" D VER^LRVER1

 W !,"----" F I=1:5:IOM-6 W "-----"

 Q

PHD ;

 S X="N",%DT="T" D ^%DT D DD^LRX S LRDT=Y,%H=$H-$P(^LAB(69.9,1,0),"^",7) D YMD^LRX S LRTM60=9999999-X

 D ADATE^LRWU S LRAD=Y Q:LREND  D LRAN^LRWU3

 Q

PG K DTOUT,DUOUT

 S DIR(0)="E" D ^DIR K DIR

 W @IOF

 Q

HED W @IOF,!,"WorkList Name: ",LRNAME,?40,LRDT,!!

 Q

LRGVP     ;VA/SLC/CJS - GROUP DATA REVIEW DISPLAY ; 13-Aug-2013 09:16 ; MKK

 +1       ;;5.2;LR;**112,1013,411,1033**;NOV 1, 1997

 +2       ;

EP        ; EP

 +1        IF '$DATA(LRPARAM)

               DO ^LRPARAM

 +2        KILL LRORD

           SET LRGVP=""

           SET LRPANEL="ALL"

           WRITE !,"Print manually entered data by accession",!

 +3        SET DIC="^LRO(68,"

           SET DIC(0)="AEFOMQ"

           DO ^DIC

           SET LRAA=+Y

           SET LRNAME=$PIECE(Y,U,2)

           IF LRAA<1

               QUIT 

           DO PHD

           IF LREND

               QUIT 

 +4        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,0))

               QUIT 

           IF '$DATA(LRNAME)

               SET LRNAME=$PIECE(^LRO(68,LRAA,0),U,1)

 +5        SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               QUIT 

 +6        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="DQ^LRGVP"

               SET ZTSAVE("LR*")=""

               SET ZTSAVE("^TMP(""LR"",$J,")=""

               DO ^%ZTLOAD

               GOTO END

DQ         USE IO

           DO HED

           SET LRAN=LRFAN-.01

           FOR 

               SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))

               IF LRAN<1!(LRAN>LRLAN)

                   QUIT 

               DO PRINT

               IF $DATA(DUOUT)!$DATA(DTOUT)

                   QUIT 

 +1        IF '$DATA(LRORD)

               WRITE !,"No data to review.",!

           DO ^%ZISC

END        KILL LRGFLPG

           GOTO ^LRGVK

PRINT      IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))

               QUIT 

           SET LRDFN=+^(0)

           SET LRORD=$SELECT($DATA(^(.1)):^(.1),1:0)

           SET LRODT=$SELECT($PIECE(^(0),U,4):$PIECE(^(0),U,4),1:$PIECE(^(0),U,3))

           SET LRLLOC=$PIECE(^(0),U,7)

           SET LRSN=$PIECE(^(0),U,5)

           IF LRSN<1

               QUIT 

 +1        SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)

           IF '$LENGTH($SELECT($DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3))

               WRITE !,"NOT COLLECTED"

 +2        SET DFN=$PIECE(^LR(LRDFN,0),U,3)

           DO PT^LRX

           IF $EXTRACT(IOST,1,2)'="C-"&(IOSL\3*2<$Y)

               WRITE @IOF

 +3        IF $EXTRACT(IOST,1,2)="C-"&$DATA(LRGFLPG)

               DO PG

           IF $DATA(DUOUT)!$DATA(DTOUT)

               QUIT 

           SET LRGFLPG=""

 +4       ; W !!,PNM,?30,"SSN: ",SSN,?50,"WARD: ",$S(LRDPF=2&($L(LRWRD)):LRWRD,1:LRLLOC) W:LRORD !,"ORDER NUMBER: ",LRORD

 +5       ;IHS/ANMC/CLS 08/18/96

           WRITE !!,PNM,?30,"HRCN: ",HRCN,?50,"WARD: ",$SELECT(LRDPF=2&($LENGTH(LRWRD)):LRWRD,1:LRLLOC)

           IF LRORD

               WRITE !,"ORDER NUMBER: ",LRORD

 +6        SET LRPANEL="ALL"

           DO VER^LRVER1

 +7        WRITE !,"----"

           FOR I=1:5:IOM-6

               WRITE "-----"

 +8        QUIT 

PHD       ;

 +1        SET X="N"

           SET %DT="T"

           DO ^%DT

           DO DD^LRX

           SET LRDT=Y

           SET %H=$HOROLOG-$PIECE(^LAB(69.9,1,0),"^",7)

           DO YMD^LRX

           SET LRTM60=9999999-X

 +2        DO ADATE^LRWU

           SET LRAD=Y

           IF LREND

               QUIT 

           DO LRAN^LRWU3

 +3        QUIT 

PG         KILL DTOUT,DUOUT

 +1        SET DIR(0)="E"

           DO ^DIR

           KILL DIR

 +2        WRITE @IOF

 +3        QUIT 

HED        WRITE @IOF,!,"WorkList Name: ",LRNAME,?40,LRDT,!!

 +1        QUIT