- LRMIV1 ;VA/SLC/DLG - LAB ROUTINE DATA VERIFICATION ;2/25/03 22:44
- ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
- ;
- ;;VA LR Patche(s): 295
- ;
- PAT S X=LRAN F I=0:0 R:'$D(LRAN) !!,"Accession #: ",X:DTIME Q:X=""!(X[U) S LRANOK=1,LRCAPOK=1 D LRANX^LRMIU4 D:LRANOK PAT1 D:LRCAPOK&(LRANOK)&($P(LRPARAM,U,14)) LOOK^LRCAPV1 K:LRANOK LRAN I 'LRANOK W !,"Enter the accession number" K LRAN
- Q
- PAT1 ;
- K LRPRGSQ S N=0,I=0 F S I=$O(^LAH(LRLL,1,"C",LRAN,I)) Q:I<1 S N=N+1,LRSQ=I,LRPRGSQ(I)="" W !,?5,I
- G T4:N=1,T3 Q
- T1 R !,"What tray: ",X:DTIME Q:X["^"!'$T I X["?"!(X'?.N) W !,"Enter a number" G T1
- I X'="" S LRTRAY=X G T2
- I $D(^LRO(68.2,"AS",LRLL)) W !,"Can't MANUALLY add to a SEQUENCE instrument data file." Q
- W !,"Enter manually" S %=1 D YN^DICN Q:%<1 G T1:%=2 S LRSQ=-1 G T3
- G T3
- T2 R !,"What cup: ",X:DTIME Q:X["^"!'$T I X["?"!(X'?.N) W !,"Enter a number" G T2
- Q:X="" S LRTRCP=LRTRAY_";"_X
- K LRPRGSQ S N=0,I=0 F S I=$O(^LAH(LRLL,1,"B",LRTRCP,I)) Q:I<1 S N=N+1,LRSQ=I,LRPRGSQ(I)="" W !,?5,I
- T3 I N=0 W !,"No data for that accession." Q
- I N>1 R !,"Choose sequence number: ",X:DTIME Q:'$T I X["?"!(X'?.N) W !,"Enter a number" G T3
- I X["^"!(X="") K LRPRGSQ Q
- S:N'=1 LRSQ=X I '$D(^LAH(LRLL,1,LRSQ,0)) W !,"No data there" G T3
- T4 Q:LRSQ'>0 K LRPRGSQ(LRSQ)
- S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRIDT=9999999-^(3),LRCDT=+^(3),LREAL=$P(^(3),U,2),LRI=+$O(^(5,0)),LRSPEC=$S($D(^(LRI,0)):+^(0),1:"")
- I $D(^LR(LRDFN,"MI",LRIDT,0)) S Y(0)=^(0)
- I '$D(^LR(LRDFN,"MI",LRIDT,3,0)) D:'$D(^LR(LRDFN,"MI",LRIDT,0)) BB^LRMIV2 S ^LR(LRDFN,"MI",LRIDT,3,0)="^63.3PA^^"
- ; S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0 D PT^LRX W ?25," ",PNM,?47," ",SSN
- S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0 D PT^LRX W ?25," ",PNM,?47," ",HRCN ; IHS/OIT/MKK - LR*5.2*1030
- T5 S %=2 I $D(^LR(LRDFN,"MI",LRIDT,1)),+^(1) W !,"The Bact data has been approved, ADDING Data MAY change previous reported",!,"values. Are you sure you want to do this " D YN^DICN I %=2 W !,"DATA NOT LOADED.",! K % Q
- I %<1 W !,"Enter YES to reload data. NO to not reload data." K % G T5
- K % I $P(^LR(LRDFN,"MI",LRIDT,0),U,3)!$P(^LR(LRDFN,"MI",LRIDT,0),U,9) S LRUNDO=1 ;W:$P(^(0),U,9) !,"(This is an AMENDED report)",!
- K LRORG S LRORG=0 F I1=0:0 S I1=$O(^LR(LRDFN,"MI",LRIDT,3,I1)) Q:I1'>0 S LRORG(+^(I1,0))=I1,LRORG=I1
- F I1=0:0 S I1=$O(^LAH(LRLL,1,LRSQ,3,I1)) Q:I1'>0 S X=+^(I1,0),I2=$S($D(LRORG(X)):LRORG(X),1:0) D MOVE
- S X=^LAH(LRLL,1,LRSQ,0) K ^LAH(LRLL,1,LRSQ),^LAH(LRLL,1,"B",($P(X,U,1)_";"_$P(X,U,2)),LRSQ),^LAH(LRLL,1,"C",+$P(X,U,5),LRSQ)
- W !!,"Data moved over" S LRHC=1
- T51 D BRMK^LRMIPSZ2 S DIE="^LR(LRDFN,""MI"",LRIDT,",DA(1)=LRDFN,DA=LRIDT,DR=5,DR(1,63)=5,DR(2,63.05)="11;11.5;11.6;12;13;",DR(3,63.29)=".01;",DR(3,63.3)=".01;1;",DR(3,63.33)=".01;" D ^DIE
- S LREND=0 D BACT^LRMIV4
- T6 R !,"ENTER 'E' TO EDIT OR INITIALS TO VERIFY: ",X:DTIME
- ; I X="E" D PAT1^LRMIV2 K LRPRGSQ W !,"DATA APPROVED BUT NOT VERIFIED",! D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) G T51
- ; I X="E" D PAT1^LRMIV2 K LRPRGSQ W !,"DATA APPROVED BUT NOT VERIFIED",! G T51 ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
- I '$$PATCH^BLRUTIL4("PXRM*1.5*12") I X="E" D PAT1^LRMIV2 K LRPRGSQ W !,"DATA APPROVED BUT NOT VERIFIED",! G T51 ; IHS/MSC/MKK - LR*5.2*1031
- I $$PATCH^BLRUTIL4("PXRM*1.5*12") I X="E" D PAT1^LRMIV2 K LRPRGSQ W !,"DATA APPROVED BUT NOT VERIFIED",! D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) G T51 ; IHS/MSC/MKK - LR*5.2*1031
- ; I $L(X)>1,$O(^VA(200,"C",X,0))=DUZ S $P(^LR(LRDFN,"MI",LRIDT,0),U,3)=DT,^(1)=DT_"^F^"_DUZ W !,"DATA APPROVED AND VERIFIED",! D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) Q
- ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
- ; Per Appendix A of RPMS Lab E-Sig Enhancement v 5.2 Techincal Manual
- I $L(X)>1,$O(^VA(200,"C",X,0))=DUZ D Q
- . S $P(^LR(LRDFN,"MI",LRIDT,0),U,3)=DT,^(1)=DT_"^F^"_DUZ
- . W !,"DATA APPROVED AND VERIFIED",!
- . ; D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
- . I $$PATCH^BLRUTIL4("PXRM*1.5*12") D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; IHS/MSC/MKK - LR*5.2*1031
- . I $$ADDON^BLRUTIL("LR*5.2*1013","BLRALAF",DUZ(2)) D ^BLRALAF
- ; ----- END IHS/OIT/MKK - LR*5.2*1030
- ;
- I X=""!X="^" W "DATA NOT APPROVED OR VERIFIED. " Q
- I $L(X)>1,$O(^VA(200,"C",X,0))'=DUZ W "INITIALS DO NOT MATCH." G T6
- Q
- WAIT W !,"Type ""^"" to skip "
- WAIT1 R X:10 G LRMIV1:X[U,WAIT1:$O(^LAH(LRLL,1,"C",LRAN,0))<1 G LRMIV1
- Q
- MOVE ;Move data into ^LR(LRDFN,"MI",LRIDT,3,
- I I2'>0 S X=^LAH(LRLL,1,LRSQ,3,I1,0),DIC="^LR(LRDFN,""MI"",LRIDT,3,",DIC(0)="AMQ",DA(1)=LRIDT,DA(2)=LRDFN D FILE^DICN S I2=+Y K DIC
- S %X="^LAH(LRLL,1,LRSQ,3,I1,",%Y="^LR(LRDFN,""MI"",LRIDT,3,I2," D %XY^%RCR
- LRMIV1 ;VA/SLC/DLG - LAB ROUTINE DATA VERIFICATION ;2/25/03 22:44
- +1 ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
- +2 ;
- +3 ;;VA LR Patche(s): 295
- +4 ;
- PAT SET X=LRAN
- FOR I=0:0
- IF '$DATA(LRAN)
- READ !!,"Accession #: ",X:DTIME
- IF X=""!(X[U)
- QUIT
- SET LRANOK=1
- SET LRCAPOK=1
- DO LRANX^LRMIU4
- IF LRANOK
- DO PAT1
- IF LRCAPOK&(LRANOK)&($PIECE(LRPARAM,U,14))
- DO LOOK^LRCAPV1
- IF LRANOK
- KILL LRAN
- IF 'LRANOK
- WRITE !,"Enter the accession number"
- KILL LRAN
- +1 QUIT
- PAT1 ;
- +1 KILL LRPRGSQ
- SET N=0
- SET I=0
- FOR
- SET I=$ORDER(^LAH(LRLL,1,"C",LRAN,I))
- IF I<1
- QUIT
- SET N=N+1
- SET LRSQ=I
- SET LRPRGSQ(I)=""
- WRITE !,?5,I
- +2 IF N=1
- GOTO T4
- GOTO T3
- QUIT
- T1 READ !,"What tray: ",X:DTIME
- IF X["^"!'$TEST
- QUIT
- IF X["?"!(X'?.N)
- WRITE !,"Enter a number"
- GOTO T1
- +1 IF X'=""
- SET LRTRAY=X
- GOTO T2
- +2 IF $DATA(^LRO(68.2,"AS",LRLL))
- WRITE !,"Can't MANUALLY add to a SEQUENCE instrument data file."
- QUIT
- +3 WRITE !,"Enter manually"
- SET %=1
- DO YN^DICN
- IF %<1
- QUIT
- IF %=2
- GOTO T1
- SET LRSQ=-1
- GOTO T3
- +4 GOTO T3
- T2 READ !,"What cup: ",X:DTIME
- IF X["^"!'$TEST
- QUIT
- IF X["?"!(X'?.N)
- WRITE !,"Enter a number"
- GOTO T2
- +1 IF X=""
- QUIT
- SET LRTRCP=LRTRAY_";"_X
- +2 KILL LRPRGSQ
- SET N=0
- SET I=0
- FOR
- SET I=$ORDER(^LAH(LRLL,1,"B",LRTRCP,I))
- IF I<1
- QUIT
- SET N=N+1
- SET LRSQ=I
- SET LRPRGSQ(I)=""
- WRITE !,?5,I
- T3 IF N=0
- WRITE !,"No data for that accession."
- QUIT
- +1 IF N>1
- READ !,"Choose sequence number: ",X:DTIME
- IF '$TEST
- QUIT
- IF X["?"!(X'?.N)
- WRITE !,"Enter a number"
- GOTO T3
- +2 IF X["^"!(X="")
- KILL LRPRGSQ
- QUIT
- +3 IF N'=1
- SET LRSQ=X
- IF '$DATA(^LAH(LRLL,1,LRSQ,0))
- WRITE !,"No data there"
- GOTO T3
- T4 IF LRSQ'>0
- QUIT
- KILL LRPRGSQ(LRSQ)
- +1 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
- SET LRIDT=9999999-^(3)
- SET LRCDT=+^(3)
- SET LREAL=$PIECE(^(3),U,2)
- SET LRI=+$ORDER(^(5,0))
- SET LRSPEC=$SELECT($DATA(^(LRI,0)):+^(0),1:"")
- +2 IF $DATA(^LR(LRDFN,"MI",LRIDT,0))
- SET Y(0)=^(0)
- +3 IF '$DATA(^LR(LRDFN,"MI",LRIDT,3,0))
- IF '$DATA(^LR(LRDFN,"MI",LRIDT,0))
- DO BB^LRMIV2
- SET ^LR(LRDFN,"MI",LRIDT,3,0)="^63.3PA^^"
- +4 ; S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0 D PT^LRX W ?25," ",PNM,?47," ",SSN
- +5 ; IHS/OIT/MKK - LR*5.2*1030
- SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- SET DFN=$PIECE(^(0),U,3)
- SET LRUNDO=0
- DO PT^LRX
- WRITE ?25," ",PNM,?47," ",HRCN
- T5 SET %=2
- IF $DATA(^LR(LRDFN,"MI",LRIDT,1))
- IF +^(1)
- WRITE !,"The Bact data has been approved, ADDING Data MAY change previous reported",!,"values. Are you sure you want to do this "
- DO YN^DICN
- IF %=2
- WRITE !,"DATA NOT LOADED.",!
- KILL %
- QUIT
- +1 IF %<1
- WRITE !,"Enter YES to reload data. NO to not reload data."
- KILL %
- GOTO T5
- +2 ;W:$P(^(0),U,9) !,"(This is an AMENDED report)",!
- KILL %
- IF $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)!$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,9)
- SET LRUNDO=1
- +3 KILL LRORG
- SET LRORG=0
- FOR I1=0:0
- SET I1=$ORDER(^LR(LRDFN,"MI",LRIDT,3,I1))
- IF I1'>0
- QUIT
- SET LRORG(+^(I1,0))=I1
- SET LRORG=I1
- +4 FOR I1=0:0
- SET I1=$ORDER(^LAH(LRLL,1,LRSQ,3,I1))
- IF I1'>0
- QUIT
- SET X=+^(I1,0)
- SET I2=$SELECT($DATA(LRORG(X)):LRORG(X),1:0)
- DO MOVE
- +5 SET X=^LAH(LRLL,1,LRSQ,0)
- KILL ^LAH(LRLL,1,LRSQ),^LAH(LRLL,1,"B",($PIECE(X,U,1)_";"_$PIECE(X,U,2)),LRSQ),^LAH(LRLL,1,"C",+$PIECE(X,U,5),LRSQ)
- +6 WRITE !!,"Data moved over"
- SET LRHC=1
- T51 DO BRMK^LRMIPSZ2
- SET DIE="^LR(LRDFN,""MI"",LRIDT,"
- SET DA(1)=LRDFN
- SET DA=LRIDT
- SET DR=5
- SET DR(1,63)=5
- SET DR(2,63.05)="11;11.5;11.6;12;13;"
- SET DR(3,63.29)=".01;"
- SET DR(3,63.3)=".01;1;"
- SET DR(3,63.33)=".01;"
- DO ^DIE
- +1 SET LREND=0
- DO BACT^LRMIV4
- T6 READ !,"ENTER 'E' TO EDIT OR INITIALS TO VERIFY: ",X:DTIME
- +1 ; I X="E" D PAT1^LRMIV2 K LRPRGSQ W !,"DATA APPROVED BUT NOT VERIFIED",! D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) G T51
- +2 ; I X="E" D PAT1^LRMIV2 K LRPRGSQ W !,"DATA APPROVED BUT NOT VERIFIED",! G T51 ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
- +3 ; IHS/MSC/MKK - LR*5.2*1031
- IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
- IF X="E"
- DO PAT1^LRMIV2
- KILL LRPRGSQ
- WRITE !,"DATA APPROVED BUT NOT VERIFIED",!
- GOTO T51
- +4 ; IHS/MSC/MKK - LR*5.2*1031
- IF $$PATCH^BLRUTIL4("PXRM*1.5*12")
- IF X="E"
- DO PAT1^LRMIV2
- KILL LRPRGSQ
- WRITE !,"DATA APPROVED BUT NOT VERIFIED",!
- DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
- GOTO T51
- +5 ; I $L(X)>1,$O(^VA(200,"C",X,0))=DUZ S $P(^LR(LRDFN,"MI",LRIDT,0),U,3)=DT,^(1)=DT_"^F^"_DUZ W !,"DATA APPROVED AND VERIFIED",! D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) Q
- +6 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
- +7 ; Per Appendix A of RPMS Lab E-Sig Enhancement v 5.2 Techincal Manual
- +8 IF $LENGTH(X)>1
- IF $ORDER(^VA(200,"C",X,0))=DUZ
- Begin DoDot:1
- +9 SET $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)=DT
- SET ^(1)=DT_"^F^"_DUZ
- +10 WRITE !,"DATA APPROVED AND VERIFIED",!
- +11 ; D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
- +12 ; IHS/MSC/MKK - LR*5.2*1031
- IF $$PATCH^BLRUTIL4("PXRM*1.5*12")
- DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
- +13 IF $$ADDON^BLRUTIL("LR*5.2*1013","BLRALAF",DUZ(2))
- DO ^BLRALAF
- End DoDot:1
- QUIT
- +14 ; ----- END IHS/OIT/MKK - LR*5.2*1030
- +15 ;
- +16 IF X=""!X="^"
- WRITE "DATA NOT APPROVED OR VERIFIED. "
- QUIT
- +17 IF $LENGTH(X)>1
- IF $ORDER(^VA(200,"C",X,0))'=DUZ
- WRITE "INITIALS DO NOT MATCH."
- GOTO T6
- +18 QUIT
- WAIT WRITE !,"Type ""^"" to skip "
- WAIT1 READ X:10
- IF X[U
- GOTO LRMIV1
- IF $ORDER(^LAH(LRLL,1,"C",LRAN,0))<1
- GOTO WAIT1
- GOTO LRMIV1
- +1 QUIT
- MOVE ;Move data into ^LR(LRDFN,"MI",LRIDT,3,
- +1 IF I2'>0
- SET X=^LAH(LRLL,1,LRSQ,3,I1,0)
- SET DIC="^LR(LRDFN,""MI"",LRIDT,3,"
- SET DIC(0)="AMQ"
- SET DA(1)=LRIDT
- SET DA(2)=LRDFN
- DO FILE^DICN
- SET I2=+Y
- KILL DIC
- +2 SET %X="^LAH(LRLL,1,LRSQ,3,I1,"
- SET %Y="^LR(LRDFN,""MI"",LRIDT,3,I2,"
- DO %XY^%RCR
