LRMINEW1.m

LRMINEW1 ;SLC/CJS/BA - NEW DATA TO BE REVIEWED/VERIFIED ;5/6/04  12:04

 ;;5.2;LAB SERVICE;**1013,1030,1031**;NOV 01, 1997

 ;

 ;;VA LR Patche(s): 295

 ;

VER W !!,"Indicate those you wish to exclude from verification."

 D CHECK

 I $O(LRAN(0))>0 W !,"Verifying all but the following:" F LRAN=0:0 S LRAN=$O(LRAN(LRAN)) Q:LRAN=""  W !,LRAN

 ; F I=0:0 W !,"Want the approved reports to be printed at the requesting locations" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 F I=0:0 W !,"Want the approved reports to be printed at the requesting locations" S %=1 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"  ;IHS/OIT/MKK - LR*5.2*1030

 Q:%=-1  S LRMIQUE=$S(%=1:1,1:0)

 F I=0:0 W !!,"Are you ready to verify" S %=2 D YN^DICN Q:%  W !,"If you're not sure, it's not too late to quit."

 Q:%'=1

 S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)

 S LRAN=0 F I=0:0 S LRAN=+$O(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) Q:LRAN<1  I +^(LRAN)=LRDXZ!(LRDXZ=0) D STUFF

 W !,"ALL DONE"

 Q

STUFF Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))  Q:'$D(^(3))  S Y=^(0),LRDFN=+Y,LRLLOC=$P(Y,U,7),LRODT=$S($P(Y,U,4):$P(Y,U,4),1:$P(Y,U,3)),LRSN=$P(Y,U,5),LRIDT=9999999-^(3),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX

 S $P(^LR(LRDFN,"MI",LRIDT,LRSB),U)=DT,$P(^(LRSB),U,$S(LRSB=11:5,1:3))=DUZ

 ; 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

 S LRCDT=9999999-LRIDT,Y=DT D VT^LRMIUT1

 K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)

 D:LRMIQUE TSKM^LRMIUT

 Q

CHECK ;from LRMINEW

 D LRAN^LRMIUT S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  S LROK=1 D CHECK1 I 'LROK K LRAN(LRAN)

 Q

CHECK1 I '$D(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) W !,LRAN," is not defined." S LROK=0 Q

 I LRDXZ'=0,+^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)'=LRDXZ W !,LRAN," is not your accession." S LROK=0

 Q

LRMINEW1  ;SLC/CJS/BA - NEW DATA TO BE REVIEWED/VERIFIED ;5/6/04  12:04

 +1       ;;5.2;LAB SERVICE;**1013,1030,1031**;NOV 01, 1997

 +2       ;

 +3       ;;VA LR Patche(s): 295

 +4       ;

VER        WRITE !!,"Indicate those you wish to exclude from verification."

 +1        DO CHECK

 +2        IF $ORDER(LRAN(0))>0

               WRITE !,"Verifying all but the following:"

               FOR LRAN=0:0

                   SET LRAN=$ORDER(LRAN(LRAN))

                   IF LRAN=""

                       QUIT 

                   WRITE !,LRAN

 +3       ; F I=0:0 W !,"Want the approved reports to be printed at the requesting locations" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 +4       ;IHS/OIT/MKK - LR*5.2*1030

           FOR I=0:0

               WRITE !,"Want the approved reports to be printed at the requesting locations"

               SET %=1

               DO YN^DICN

               IF %

                   QUIT 

               WRITE !,"Answer 'Y'es or 'N'o"

 +5        IF %=-1

               QUIT 

           SET LRMIQUE=$SELECT(%=1:1,1:0)

 +6        FOR I=0:0

               WRITE !!,"Are you ready to verify"

               SET %=2

               DO YN^DICN

               IF %

                   QUIT 

               WRITE !,"If you're not sure, it's not too late to quit."

 +7        IF %'=1

               QUIT 

 +8        SET LRAN=0

           FOR I=0:0

               SET LRAN=+$ORDER(LRAN(LRAN))

               IF LRAN<1

                   QUIT 

               KILL ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)

 +9        SET LRAN=0

           FOR I=0:0

               SET LRAN=+$ORDER(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN))

               IF LRAN<1

                   QUIT 

               IF +^(LRAN)=LRDXZ!(LRDXZ=0)

                   DO STUFF

 +10       WRITE !,"ALL DONE"

 +11       QUIT 

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

               QUIT 

           IF '$DATA(^(3))

               QUIT 

           SET Y=^(0)

           SET LRDFN=+Y

           SET LRLLOC=$PIECE(Y,U,7)

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

           SET LRSN=$PIECE(Y,U,5)

           SET LRIDT=9999999-^(3)

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

           SET DFN=$PIECE(^(0),U,3)

           DO PT^LRX

 +1        SET $PIECE(^LR(LRDFN,"MI",LRIDT,LRSB),U)=DT

           SET $PIECE(^(LRSB),U,$SELECT(LRSB=11:5,1:3))=DUZ

 +2       ; D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)   ; 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")

               DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)

 +4        SET LRCDT=9999999-LRIDT

           SET Y=DT

           DO VT^LRMIUT1

 +5        KILL ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)

 +6        IF LRMIQUE

               DO TSKM^LRMIUT

 +7        QUIT 

CHECK     ;from LRMINEW

 +1        DO LRAN^LRMIUT

           SET LRAN=0

           FOR I=0:0

               SET LRAN=+$ORDER(LRAN(LRAN))

               IF LRAN<1

                   QUIT 

               SET LROK=1

               DO CHECK1

               IF 'LROK

                   KILL LRAN(LRAN)

 +2        QUIT 

CHECK1     IF '$DATA(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN))

               WRITE !,LRAN," is not defined."

               SET LROK=0

               QUIT 

 +1        IF LRDXZ'=0

               IF +^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)'=LRDXZ

                   WRITE !,LRAN," is not your accession."

                   SET LROK=0

 +2        QUIT