- LRMIV ;VA/SLC/DLG - MICROBIOLOGY VERIFY AUTO INST ROUTINE ;2/25/03 22:25
- ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
- ;
- ;;VA LR Patche(s): 295
- ;
- ;from LRVR and option LRMIV
- BEGIN S LREND=0,LRACC="",LRSS="MI" D ^LRPARAM,DATE
- END ;from LRFAST,LRVER
- K %,A6,AGE,C,D,D0,D1,DA,DFN,DIC,DIE,DLAYGO,DOB,DTOUT,DUOUT,DX,I,II,J,K,LRAA,LRACC,LRAD,LRANOK,LRBUG,LRCAPOK,LRCDT,LRDFN,LRDPF,LREAL,LREND,LRFIFO,LRI,LRIDT,LRLLOC,LRMIDEF,LRMIOTH,LRNB,LRODA,LRODIE
- K LRODT,LRPTP,LRSAME,LRSB,LRSCREEN,LRSN,LRSPEC,LRSS,LRTEC,LRTS,LRTX,LRUNDO,LRWRD,N,PNM,POP,S,SEX,SSN,X,Y,Z
- K HRCN ; IHS/OIT/MKK - LR*5.2*1030
- Q
- DATE I '$D(LRLABKY) W !,$C(7),"YOU DO NOT HAVE VERIFY KEY. CANNOT VERIFY",! Q
- S DIC="^LRO(68.2,",DIC(0)="AEMQZ" D ^DIC Q:Y'>0 S LRLL=+Y
- D ^LRMIU4 Q:LRAA<1 I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV
- S DIC=60,DIC("S")="I $P(^(0),U,4)=""MI""",DIC(0)="AEMOQ",DIC("A")="Select TEST/PROCEDURE: " D ^DIC K DIC Q:$D(DUOUT) S LRPTP=+Y
- I Y<1 W !,"None Preselected",!,"Accession # ",LRAN
- S (LRDFN,LRSS,LRIDT)=0 ;Added to prevent <UNDEF> in LRCAP if no accession selected
- S LRMIDEF=$P(^LAB(69.9,1,1),U,10),LRMIOTH=$P(^(1),U,11) D ^LRMIV1
- Q
- UNDO ;from LRMIV2
- ;W:'$P(^LR(LRDFN,"MI",LRIDT,0),U,9) !,"Report is changed to 'AMENDED'",!
- S $P(^LR(LRDFN,"MI",LRIDT,0),U,9)=1,$P(^(0),U,3,4)=U,$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)="",$P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,4,5)=DUZ_U_DT,^LRO(68,LRAA,1,LRAD,1,"AD",DT,+LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",DT,+LRAN)=""
- ; 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
- Q
- LRMIV ;VA/SLC/DLG - MICROBIOLOGY VERIFY AUTO INST ROUTINE ;2/25/03 22:25
- +1 ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
- +2 ;
- +3 ;;VA LR Patche(s): 295
- +4 ;
- +5 ;from LRVR and option LRMIV
- BEGIN SET LREND=0
- SET LRACC=""
- SET LRSS="MI"
- DO ^LRPARAM
- DO DATE
- END ;from LRFAST,LRVER
- +1 KILL %,A6,AGE,C,D,D0,D1,DA,DFN,DIC,DIE,DLAYGO,DOB,DTOUT,DUOUT,DX,I,II,J,K,LRAA,LRACC,LRAD,LRANOK,LRBUG,LRCAPOK,LRCDT,LRDFN,LRDPF,LREAL,LREND,LRFIFO,LRI,LRIDT,LRLLOC,LRMIDEF,LRMIOTH,LRNB,LRODA,LRODIE
- +2 KILL LRODT,LRPTP,LRSAME,LRSB,LRSCREEN,LRSN,LRSPEC,LRSS,LRTEC,LRTS,LRTX,LRUNDO,LRWRD,N,PNM,POP,S,SEX,SSN,X,Y,Z
- +3 ; IHS/OIT/MKK - LR*5.2*1030
- KILL HRCN
- +4 QUIT
- DATE IF '$DATA(LRLABKY)
- WRITE !,$CHAR(7),"YOU DO NOT HAVE VERIFY KEY. CANNOT VERIFY",!
- QUIT
- +1 SET DIC="^LRO(68.2,"
- SET DIC(0)="AEMQZ"
- DO ^DIC
- IF Y'>0
- QUIT
- SET LRLL=+Y
- +2 DO ^LRMIU4
- IF LRAA<1
- QUIT
- IF $PIECE(LRPARAM,U,14)
- IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)
- DO ^LRCAPV
- +3 SET DIC=60
- SET DIC("S")="I $P(^(0),U,4)=""MI"""
- SET DIC(0)="AEMOQ"
- SET DIC("A")="Select TEST/PROCEDURE: "
- DO ^DIC
- KILL DIC
- IF $DATA(DUOUT)
- QUIT
- SET LRPTP=+Y
- +4 IF Y<1
- WRITE !,"None Preselected",!,"Accession # ",LRAN
- +5 ;Added to prevent <UNDEF> in LRCAP if no accession selected
- SET (LRDFN,LRSS,LRIDT)=0
- +6 SET LRMIDEF=$PIECE(^LAB(69.9,1,1),U,10)
- SET LRMIOTH=$PIECE(^(1),U,11)
- DO ^LRMIV1
- +7 QUIT
- UNDO ;from LRMIV2
- +1 ;W:'$P(^LR(LRDFN,"MI",LRIDT,0),U,9) !,"Report is changed to 'AMENDED'",!
- +2 SET $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,9)=1
- SET $PIECE(^(0),U,3,4)=U
- SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
- SET $PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS,0),U,4,5)=DUZ_U_DT
- SET ^LRO(68,LRAA,1,LRAD,1,"AD",DT,+LRAN)=""
- SET ^LRO(68,LRAA,1,LRAD,1,"AC",DT,+LRAN)=""
- +3 ; D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders
- +4 ; IHS/MSC/MKK - LR*5.2*1031
- IF $$PATCH^BLRUTIL4("PXRM*1.5*12")
- DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
- +5 QUIT
