- LRGVP ;SLC/CJS - GROUP DATA REVIEW DISPLAY ;2/5/91 13:29 ;
- ;;5.2;LAB SERVICE;**112,411**;Sep 27, 1994;Build 2
- 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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRGVP 1653 printed Feb 18, 2025@23:40:57 Page 2
- LRGVP ;SLC/CJS - GROUP DATA REVIEW DISPLAY ;2/5/91 13:29 ;
- +1 ;;5.2;LAB SERVICE;**112,411**;Sep 27, 1994;Build 2
- +2 IF '$DATA(LRPARAM)
- DO ^LRPARAM
- +3 KILL LRORD
- SET LRGVP=""
- SET LRPANEL="ALL"
- WRITE !,"Print manually entered data by accession",!
- +4 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
- +5 if '$DATA(^LRO(68,LRAA,1,LRAD,1,0))
- QUIT
- if '$DATA(LRNAME)
- SET LRNAME=$PIECE(^LRO(68,LRAA,0),U,1)
- +6 SET %ZIS="Q"
- DO ^%ZIS
- if POP
- QUIT
- +7 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 WRITE !!,PNM,?30,"SSN: ",SSN,?50,"WARD: ",$SELECT(LRDPF=2&($LENGTH(LRWRD)):LRWRD,1:LRLLOC)
- if LRORD
- WRITE !,"ORDER NUMBER: ",LRORD
- +5 SET LRPANEL="ALL"
- DO VER^LRVER1
- +6 WRITE !,"----"
- FOR I=1:5:IOM-6
- WRITE "-----"
- +7 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