LRMIV.m

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