BLRTN1.m

BLRTN1 ; IHS/HQT/MJL - CREATE/EDIT TRANSACTIONS ; [ 11/19/2002  8:22 AM ]

 ;;5.2;LR;**1011,1013,1015**;NOV 18, 2002

SETPRNT ;

 K BLR

 S BLRCDT=^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRCDT")\1,BLR("STATUS FLAG")="R"

 ;S BLRLTST=0 F  S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST=""  S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) I BLRSEQ'="",$P(^BLRTXLOG(BLRSEQ,12),U)=$G(BLRCDT) S BLRANSEQ(BLRSEQ)=""

 Q:$G(BLRACCN)=""  ;IHS/ITSC/TPF 06/06/02 IF WE DON'T HAVE AN ACCESSION

 ;                  NUM WE CAN'T PROCESS

 ;                  DUE TO DELETION 

 S BLRLTST=0 F  S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:'BLRLTST  S BLRSEQ=0 F  S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,BLRSEQ)) Q:'BLRSEQ  I $P($G(^BLRTXLOG(BLRSEQ,12)),U)\1=BLRCDT S BLRANSEQ(BLRSEQ)=""

 S BLRSEQ="" F  S BLRSEQ=$O(BLRANSEQ(BLRSEQ),-1) Q:BLRSEQ=""  S BLRDEL=$G(^BLRTXLOG(BLRSEQ,1)),BLRPAR=$P(BLRDEL,U),BLRDEL=$P(BLRDEL,U,2)="D" S:BLRPAR'="" BLRPAR(BLRPAR)=$G(BLRPAR(BLRPAR)) D

 .;A CHILD WHOSE PARENT IS DISQUALIFIED

 .;I 'BLRCMP,BLRPAR,BLRPAR(BLRPAR) Q

 .I BLRPAR,BLRPAR(BLRPAR) Q

 .;A PARENT

 .I $D(BLRPAR(BLRSEQ)) D  Q

 ..;I 'BLRCMP,BLRPAR(BLRSEQ) S:BLRPAR'="" BLRPAR(BLRPAR)=1 Q

 ..I BLRPAR(BLRSEQ) S:BLRPAR'="" BLRPAR(BLRPAR)=1 Q

 ..I 'BLRDEL S BLR("SEQUENCE NUMBER")=BLRSEQ,BLRIEN=BLRSEQ_",",BLRENT=BLRSEQ,BLRENTS(1)=BLRENT D ^BLRNFLTL Q

 .;NOT A PARENT

 .I $P($G(^BLRTXLOG(BLRSEQ,20)),U)="" D  Q

 ..;I 'BLRCMP,BLRPAR,$P(^LAB(60,$P(^BLRTXLOG(BLRSEQ,0),U,6),0),U,17) S BLRPAR(BLRPAR)=1 Q

 ..I BLRPAR,$P(^LAB(60,$P(^BLRTXLOG(BLRSEQ,0),U,6),0),U,17) S BLRPAR(BLRPAR)=1 Q

 .; NOT NEEDED - ONLY PARENTS S/B UPDATED -- DEACTIVATED - Q ADDED TO

 .; DO DOING THIS BLOCK

 .;I BLRCMP,'BLRDEL S BLR("SEQUENCE NUMBER")=BLRSEQ,BLRIEN=BLRSEQ_",",BLRENT=BLRSEQ D ^BLRNFLTL Q

 K BLRANSEQ,BLRHSEQ,BLRLSEQ,BLRLTST,BLRPAR

 Q

BLRTN1    ; IHS/HQT/MJL - CREATE/EDIT TRANSACTIONS ; [ 11/19/2002  8:22 AM ]

 +1       ;;5.2;LR;**1011,1013,1015**;NOV 18, 2002

SETPRNT   ;

 +1        KILL BLR

 +2        SET BLRCDT=^BLRSITE(BLRQSITE,20,BLRQDH,1,BLRLTP,"LRCDT")\1

           SET BLR("STATUS FLAG")="R"

 +3       ;S BLRLTST=0 F  S BLRLTST=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST)) Q:BLRLTST=""  S BLRSEQ=$O(^BLRTXLOG("AAT",BLRACCN,BLRLTST,""),-1) I BLRSEQ'="",$P(^BLRTXLOG(BLRSEQ,12),U)=$G(BLRCDT) S BLRANSEQ(BLRSEQ)=""

 +4       ;IHS/ITSC/TPF 06/06/02 IF WE DON'T HAVE AN ACCESSION

           IF $GET(BLRACCN)=""

               QUIT 

 +5       ;                  NUM WE CAN'T PROCESS

 +6       ;                  DUE TO DELETION 

 +7        SET BLRLTST=0

           FOR 

               SET BLRLTST=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRLTST))

               IF 'BLRLTST

                   QUIT 

               SET BLRSEQ=0

               FOR 

                   SET BLRSEQ=$ORDER(^BLRTXLOG("AAT",BLRACCN,BLRLTST,BLRSEQ))

                   IF 'BLRSEQ

                       QUIT 

                   IF $PIECE($GET(^BLRTXLOG(BLRSEQ,12)),U)\1=BLRCDT

                       SET BLRANSEQ(BLRSEQ)=""

 +8        SET BLRSEQ=""

           FOR 

               SET BLRSEQ=$ORDER(BLRANSEQ(BLRSEQ),-1)

               IF BLRSEQ=""

                   QUIT 

               SET BLRDEL=$GET(^BLRTXLOG(BLRSEQ,1))

               SET BLRPAR=$PIECE(BLRDEL,U)

               SET BLRDEL=$PIECE(BLRDEL,U,2)="D"

               IF BLRPAR'=""

                   SET BLRPAR(BLRPAR)=$GET(BLRPAR(BLRPAR))

               Begin DoDot:1

 +9       ;A CHILD WHOSE PARENT IS DISQUALIFIED

 +10      ;I 'BLRCMP,BLRPAR,BLRPAR(BLRPAR) Q

 +11               IF BLRPAR

                       IF BLRPAR(BLRPAR)

                           QUIT 

 +12      ;A PARENT

 +13               IF $DATA(BLRPAR(BLRSEQ))

                       Begin DoDot:2

 +14      ;I 'BLRCMP,BLRPAR(BLRSEQ) S:BLRPAR'="" BLRPAR(BLRPAR)=1 Q

 +15                       IF BLRPAR(BLRSEQ)

                               IF BLRPAR'=""

                                   SET BLRPAR(BLRPAR)=1

                               QUIT 

 +16                       IF 'BLRDEL

                               SET BLR("SEQUENCE NUMBER")=BLRSEQ

                               SET BLRIEN=BLRSEQ_","

                               SET BLRENT=BLRSEQ

                               SET BLRENTS(1)=BLRENT

                               DO ^BLRNFLTL

                               QUIT 

                       End DoDot:2

                       QUIT 

 +17      ;NOT A PARENT

 +18               IF $PIECE($GET(^BLRTXLOG(BLRSEQ,20)),U)=""

                       Begin DoDot:2

 +19      ;I 'BLRCMP,BLRPAR,$P(^LAB(60,$P(^BLRTXLOG(BLRSEQ,0),U,6),0),U,17) S BLRPAR(BLRPAR)=1 Q

 +20                       IF BLRPAR

                               IF $PIECE(^LAB(60,$PIECE(^BLRTXLOG(BLRSEQ,0),U,6),0),U,17)

                                   SET BLRPAR(BLRPAR)=1

                                   QUIT 

                       End DoDot:2

                       QUIT 

 +21      ; NOT NEEDED - ONLY PARENTS S/B UPDATED -- DEACTIVATED - Q ADDED TO

 +22      ; DO DOING THIS BLOCK

 +23      ;I BLRCMP,'BLRDEL S BLR("SEQUENCE NUMBER")=BLRSEQ,BLRIEN=BLRSEQ_",",BLRENT=BLRSEQ D ^BLRNFLTL Q

               End DoDot:1

 +24       KILL BLRANSEQ,BLRHSEQ,BLRLSEQ,BLRLTST,BLRPAR

 +25       QUIT