LRMISTF1.m

LRMISTF1 ;SLC/CJS/BA/DALOI/FHS - MASS DATA ENTRY INTO FILE 63.05 ;2/25/03  22:24

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

 ;

 ;;VA LR Patche(s): 121,128,202,263,264,295

 ; 

 ; Reference to ^DPT( Supported by Reference #10035

 ; Reference to ^ORD(100.99 Supported by Reference #2414

 ; Reference to YN^DICN Supported by Reference #10009

 ; Reference to ^DIE Supported by Reference #10018

 ; Reference to $$NOW^XLFDT Supported by Reference #10103

 ; Reference to $$CJ^XLFSTR  Supported by Reference #10104

 ;from LRMISTF

ASK F I=0:0 D GET Q:LREND=99  D:'LREND ACC S:LREND LREND=0 D MORE Q:LREND  K LRAUTO

 Q

GET S X1="",LREND=0 I LRMODE<3 D

 . F  R !,"What do you want entered?: ",X1:DTIME Q:'$T!(X1[U)!(X1="")  D  I $L(X1),$E(X1)'="?" S LREND=0 Q

 . . I $S(X1[":":1,X1[";":1,1:0) S X1="?" D INFO Q

 . . S X=X1 S:X[";" X="?" D @$S($G(H9)=11.57:"PN^LRNUM",$G(H9)=24:"AFS^LRNUM",1:"^LRMIXPD") S:'$D(X) X1="?" Q:X1'="?"  D INFO

 I X1[U S LREND=99 Q

 S:LRMODE<3 LRSTUFF=X1 W !,"I will ",$S(LRMODE=1:"automatically stuff ",1:"prompt "),LRMF W:$D(LRSTUFF) !,"with ",LRSTUFF

 F  W !,"   ...OK" S %=1 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 I %'=1 S LREND=1 Q

 I LRPF="P" S DR="S:$S($D(^LR(LRDFN,""MI"",LRIDT,"_LRSB_")):$P(^("_LRSB_"),U,2),1:"""")=""F"" Y="_$S(LRSB=1:11.55,LRSB=5:15.5,LRSB=8:19.5,LRSB=11:25.5,LRSB=16:35)_";"

 I LRPF="F" S DR=""

 S DR=DR_$S(LRSB=1:"11.5///"_LRPF_";11.55",LRSB=5:"15///"_LRPF_";15.5",LRSB=8:"19///"_LRPF_";19.5",LRSB=11:"23///"_LRPF_";25.5",1:"34///"_LRPF_";35")

 S DR=DR_"////"_DUZ_";"_H9_$S(LRMODE=1:"///"_LRSTUFF,LRMODE=2:"//"_LRSTUFF,1:"")

 ; F  W !,"Verify all work automatically" S %=1 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 F I=0:0 W !,"Verify all work automatically" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 ;----- END IHS/OIT/MKK - LR*5.2*1030

 I %=-1 S LREND=1 Q

 I %=1 S DR=DR_";"_$S(LRSB=1:11,LRSB=5:14,LRSB=8:18,LRSB=11:22,1:33)_"///T",LRAUTO=""

 ; S LRCO=0 F  W !,"Designate the individual test as complete" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 S LRCO=0 F I=0:0 W !,"Designate the individual test as complete" S %=1 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 ;----- END IHS/OIT/MKK - LR*5.2*1030

 S:%=1 LRCO=1 S:%=-1 LREND=1

 Q

INFO W !,$$CJ^XLFSTR("What you enter will go through the input transform to be stored in the.",IOM)

 W !,$$CJ^XLFSTR("Result field of the test",IOM)

 W !,$$CJ^XLFSTR("The punctuations of ';' or ':'  are not allowed in Batch Data Entry.",IOM),!

 Q

ACC K LRSTUFF,DIC W !,"Enter the accessions you wish to edit." D LRAN^LRMIUT

 I +$O(LRAN(0))>0 W !,"Editing the following:" S (J,LRAN)=0 F  S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  W !,LRAN S J=J+1 I J#(IOSL-2)=0 R !,"Press return to continue or '^' to escape ",X:DTIME I X[U S LREND=1 Q

 Q:LREND

 F  W !,"Everything OK" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 Q:%'=1

 S LRAN=0 F  S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  D STUFF Q:LREND

 Q

STUFF I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$D(^(3)) W !,"Acc: ",LRAN," not set up." Q

 I $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4) W !,"Acc: ",LRAN," has been previously verified by a microbiology supervisor." Q

 S LRNOP=1,J=0 F  S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,J)) Q:J<1  I LRTEST=+^(J,0) S LRNOP=$P(^(0),U,5) Q

 I LRNOP=1 W !,"Acc: ",LRAN," doesn't have the test required." Q

 I LRNOP>1 W !,"Acc: ",LRAN," has been completed for the selected test." Q

 I H9=11.57!(H9=11.58) S LROK=0 D @$S(H9=11.57:"UR",1:"SPUT") I 'LROK W !,"Acc: ",LRAN," doesn't have the specimen required." Q

 W !,"Acc: ",LRAN S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(^(0),U,7),LRODT=$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)

 ; S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,SSN I LRDPF=2,$D(^DPT(DFN,.1)) W ?65,^(.1)

 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,HRCN I LRDPF=2,$D(^DPT(DFN,.1)) W ?65,^(.1)

 ;----- END IHS/OIT/MKK - LR*5.2*1030

 I LRDPF=2,DFN,$P($G(^ORD(100.99,1,"CONV")),"^")=0 D EN^LR7OV2(DFN_";DPT(",1)

 ; W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT) I $D(Y) S LREND=1 Q

 ; W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE  I $D(Y) S LREND=1 Q  ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders

 I '$$PATCH^BLRUTIL4("PXRM*1.5*12") W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE  I $D(Y) S LREND=1 Q                                ; IHS/MSC/MKK - LR*5.2*1031

 I $$PATCH^BLRUTIL4("PXRM*1.5*12") W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT) I $D(Y) S LREND=1 Q  ; IHS/MSC/MKK - LR*5.2*1031

 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 D:BLRLOG ^BLREVTQ("M","R","MICRO",,LRAA_","_LRAD_","_LRAN)

 ;----- END IHS/OIT/MKK - LR*5.2*1030

 I LRCO S X=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5) K:X ^LRO(68,LRAA,1,LRAD,1,"AD",$P(X,"."),LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",X,LRAN)

 I LRCO D

 . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,4)=DUZ,$P(^(0),U,8)=$G(LRCDEF)

 . S Y=$$NOW^XLFDT

 . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5)=Y

 . S ^LRO(68,LRAA,1,LRAD,1,"AD",$P(Y,"."),LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",Y,LRAN)=""

 . I $$VER^LR7OU1<3 N I S I=LRTEST D V^LROR ;OE/RR 2.5

 . N CORRECT S:$G(LRCORECT) CORRECT=1 D NEW^LR7OB1(LRODT,LRSN,"RE")

 ; I $D(LRAUTO) D STF^LRMIUT

 ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 ;      Added per Appendix A of RPMS E-Sig Enhancement V 5.2 technical manual

 I $$ADDON^BLRUTIL("LR*5.2*1013","BLRALAF",DUZ(2)) D ^BLRALAF

 D STF^LRMIUT                ; Not verified always appears on VT

 ;----- END IHS/OIT/MKK - LR*5.2*1030

 Q

MORE S LREND=1 F  W !,"Do you wish to make a new entry for the ",LRMF," field" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 I %=1 S LREND=0

 Q

UR S J=0 F  S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J)) Q:J<1  I LRURINE=+^(J,0) S LROK=1 Q

 Q

SPUT S J=0 F  S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J)) Q:J<1  I 360=+^(J,0) S LROK=1 Q

 Q

LRMISTF1  ;SLC/CJS/BA/DALOI/FHS - MASS DATA ENTRY INTO FILE 63.05 ;2/25/03  22:24

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

 +2       ;

 +3       ;;VA LR Patche(s): 121,128,202,263,264,295

 +4       ; 

 +5       ; Reference to ^DPT( Supported by Reference #10035

 +6       ; Reference to ^ORD(100.99 Supported by Reference #2414

 +7       ; Reference to YN^DICN Supported by Reference #10009

 +8       ; Reference to ^DIE Supported by Reference #10018

 +9       ; Reference to $$NOW^XLFDT Supported by Reference #10103

 +10      ; Reference to $$CJ^XLFSTR  Supported by Reference #10104

 +11      ;from LRMISTF

ASK        FOR I=0:0

               DO GET

               IF LREND=99

                   QUIT 

               IF 'LREND

                   DO ACC

               IF LREND

                   SET LREND=0

               DO MORE

               IF LREND

                   QUIT 

               KILL LRAUTO

 +1        QUIT 

GET        SET X1=""

           SET LREND=0

           IF LRMODE<3

               Begin DoDot:1

 +1                FOR 

                       READ !,"What do you want entered?: ",X1:DTIME

                       IF '$TEST!(X1[U)!(X1="")

                           QUIT 

                       Begin DoDot:2

 +2                        IF $SELECT(X1[":":1,X1[";":1,1:0)

                               SET X1="?"

                               DO INFO

                               QUIT 

 +3                        SET X=X1

                           IF X[";"

                               SET X="?"

                           DO @$SELECT($GET">GET(H9)=11.57:"PN^LRNUM",$GET">GET(H9)=24:"AFS^LRNUM",1:"^LRMIXPD")

                           IF '$DATA(X)

                               SET X1="?"

                           IF X1'="?"

                               QUIT 

                           DO INFO

                       End DoDot:2

                       IF $LENGTH(X1)

                           IF $EXTRACT(X1)'="?"

                               SET LREND=0

                               QUIT 

               End DoDot:1

 +4        IF X1[U

               SET LREND=99

               QUIT 

 +5        IF LRMODE<3

               SET LRSTUFF=X1

           WRITE !,"I will ",$SELECT(LRMODE=1:"automatically stuff ",1:"prompt "),LRMF

           IF $DATA(LRSTUFF)

               WRITE !,"with ",LRSTUFF

 +6        FOR 

               WRITE !,"   ...OK"

               SET %=1

               DO YN^DICN

               IF %

                   QUIT 

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

 +7        IF %'=1

               SET LREND=1

               QUIT 

 +8        IF LRPF="P"

               SET DR="S:$S($D(^LR(LRDFN,""MI"",LRIDT,"_LRSB_")):$P(^("_LRSB_"),U,2),1:"""")=""F"" Y="_$SELECT(LRSB=1:11.55,LRSB=5:15.5,LRSB=8:19.5,LRSB=11:25.5,LRSB=16:35)_";"

 +9        IF LRPF="F"

               SET DR=""

 +10       SET DR=DR_$SELECT(LRSB=1:"11.5///"_LRPF_";11.55",LRSB=5:"15///"_LRPF_";15.5",LRSB=8:"19///"_LRPF_";19.5",LRSB=11:"23///"_LRPF_";25.5",1:"34///"_LRPF_";35")

 +11       SET DR=DR_"////"_DUZ_";"_H9_$SELECT(LRMODE=1:"///"_LRSTUFF,LRMODE=2:"//"_LRSTUFF,1:"")

 +12      ; F  W !,"Verify all work automatically" S %=1 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 +13      ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 +14       FOR I=0:0

               WRITE !,"Verify all work automatically"

               SET %=2

               DO YN^DICN

               IF %

                   QUIT 

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

 +15      ;----- END IHS/OIT/MKK - LR*5.2*1030

 +16       IF %=-1

               SET LREND=1

               QUIT 

 +17       IF %=1

               SET DR=DR_";"_$SELECT(LRSB=1:11,LRSB=5:14,LRSB=8:18,LRSB=11:22,1:33)_"///T"

               SET LRAUTO=""

 +18      ; S LRCO=0 F  W !,"Designate the individual test as complete" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"

 +19      ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 +20       SET LRCO=0

           FOR I=0:0

               WRITE !,"Designate the individual test as complete"

               SET %=1

               DO YN^DICN

               IF %

                   QUIT 

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

 +21      ;----- END IHS/OIT/MKK - LR*5.2*1030

 +22       IF %=1

               SET LRCO=1

           IF %=-1

               SET LREND=1

 +23       QUIT 

INFO       WRITE !,$$CJ^XLFSTR("What you enter will go through the input transform to be stored in the.",IOM)

 +1        WRITE !,$$CJ^XLFSTR("Result field of the test",IOM)

 +2        WRITE !,$$CJ^XLFSTR("The punctuations of ';' or ':'  are not allowed in Batch Data Entry.",IOM),!

 +3        QUIT 

ACC        KILL LRSTUFF,DIC

           WRITE !,"Enter the accessions you wish to edit."

           DO LRAN^LRMIUT

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

               WRITE !,"Editing the following:"

               SET (J,LRAN)=0

               FOR 

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

                   IF LRAN<1

                       QUIT 

                   WRITE !,LRAN

                   SET J=J+1

                   IF J#(IOSL-2)=0

                       READ !,"Press return to continue or '^' to escape ",X:DTIME

                       IF X[U

                           SET LREND=1

                           QUIT 

 +2        IF LREND

               QUIT 

 +3        FOR 

               WRITE !,"Everything OK"

               SET %=2

               DO YN^DICN

               IF %

                   QUIT 

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

 +4        IF %'=1

               QUIT 

 +5        SET LRAN=0

           FOR 

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

               IF LRAN<1

                   QUIT 

               DO STUFF

               IF LREND

                   QUIT 

 +6        QUIT 

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

               WRITE !,"Acc: ",LRAN," not set up."

               QUIT 

 +1        IF $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)

               WRITE !,"Acc: ",LRAN," has been previously verified by a microbiology supervisor."

               QUIT 

 +2        SET LRNOP=1

           SET J=0

           FOR 

               SET J=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,J))

               IF J<1

                   QUIT 

               IF LRTEST=+^(J,0)

                   SET LRNOP=$PIECE(^(0),U,5)

                   QUIT 

 +3        IF LRNOP=1

               WRITE !,"Acc: ",LRAN," doesn't have the test required."

               QUIT 

 +4        IF LRNOP>1

               WRITE !,"Acc: ",LRAN," has been completed for the selected test."

               QUIT 

 +5        IF H9=11.57!(H9=11.58)

               SET LROK=0

               DO @$SELECT(H9=11.57:"UR",1:"SPUT")

               IF 'LROK

                   WRITE !,"Acc: ",LRAN," doesn't have the specimen required."

                   QUIT 

 +6        WRITE !,"Acc: ",LRAN

           SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)

           SET LRLLOC=$PIECE(^(0),U,7)

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

           SET LRSN=$PIECE(^(0),U,5)

 +7       ; S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W ?15,PNM,?45,SSN I LRDPF=2,$D(^DPT(DFN,.1)) W ?65,^(.1)

 +8       ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

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

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

           DO PT^LRX

           WRITE ?15,PNM,?45,HRCN

           IF LRDPF=2

               IF $DATA(^DPT(DFN,.1))

                   WRITE ?65,^(.1)

 +10      ;----- END IHS/OIT/MKK - LR*5.2*1030

 +11       IF LRDPF=2

               IF DFN

                   IF $PIECE($GET(^ORD(100.99,1,"CONV")),"^")=0

                       DO EN^LR7OV2(DFN_";DPT(",1)

 +12      ; W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT) I $D(Y) S LREND=1 Q

 +13      ; W ! S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT D ^DIE  I $D(Y) S LREND=1 Q  ; IHS/OIT/MKK - LR*5.2*1030 - RPMS Does NOT use Clinical Reminders

 +14      ; IHS/MSC/MKK - LR*5.2*1031

           IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")

               WRITE !

               SET LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3)

               SET LRIDT=+$PIECE(^(3),U,5)

               SET DIE="^LR("_LRDFN_",""MI"","

               SET DA=LRIDT

               DO ^DIE

               IF $DATA(Y)

                   SET LREND=1

                   QUIT 

 +15      ; IHS/MSC/MKK - LR*5.2*1031

           IF $$PATCH^BLRUTIL4("PXRM*1.5*12")

               WRITE !

               SET LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3)

               SET LRIDT=+$PIECE(^(3),U,5)

               SET DIE="^LR("_LRDFN_",""MI"","

               SET DA=LRIDT

               DO ^DIE

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

               IF $DATA(Y)

                   SET LREND=1

                   QUIT 

 +16      ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 +17       IF BLRLOG

               DO ^BLREVTQ("M","R","MICRO",,LRAA_","_LRAD_","_LRAN)

 +18      ;----- END IHS/OIT/MKK - LR*5.2*1030

 +19       IF LRCO

               SET X=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5)

               IF X

                   KILL ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(X,"."),LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",X,LRAN)

 +20       IF LRCO

               Begin DoDot:1

 +21               SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,4)=DUZ

                   SET $PIECE(^(0),U,8)=$GET(LRCDEF)

 +22               SET Y=$$NOW^XLFDT

 +23               SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5)=Y

 +24               SET ^LRO(68,LRAA,1,LRAD,1,"AD",$PIECE(Y,"."),LRAN)=""

                   SET ^LRO(68,LRAA,1,LRAD,1,"AC",Y,LRAN)=""

 +25      ;OE/RR 2.5

                   IF $$VER^LR7OU1<3

                       NEW I

                       SET I=LRTEST

                       DO V^LROR

 +26               NEW CORRECT

                   IF $GET(LRCORECT)

                       SET CORRECT=1

                   DO NEW^LR7OB1(LRODT,LRSN,"RE")

               End DoDot:1

 +27      ; I $D(LRAUTO) D STF^LRMIUT

 +28      ;----- BEGIN IHS/OIT/MKK - LR*5.2*1030

 +29      ;      Added per Appendix A of RPMS E-Sig Enhancement V 5.2 technical manual

 +30       IF $$ADDON^BLRUTIL("LR*5.2*1013","BLRALAF",DUZ(2))

               DO ^BLRALAF

 +31      ; Not verified always appears on VT

           DO STF^LRMIUT

 +32      ;----- END IHS/OIT/MKK - LR*5.2*1030

 +33       QUIT 

MORE       SET LREND=1

           FOR 

               WRITE !,"Do you wish to make a new entry for the ",LRMF," field"

               SET %=2

               DO YN^DICN

               IF %

                   QUIT 

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

 +1        IF %=1

               SET LREND=0

 +2        QUIT 

UR         SET J=0

           FOR 

               SET J=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J))

               IF J<1

                   QUIT 

               IF LRURINE=+^(J,0)

                   SET LROK=1

                   QUIT 

 +1        QUIT 

SPUT       SET J=0

           FOR 

               SET J=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J))

               IF J<1

                   QUIT 

               IF 360=+^(J,0)

                   SET LROK=1

                   QUIT 

 +1        QUIT