Routine: BNIGE

BNIGE ; IHS/CMI/LAB - BNI GUI Save Utilities 2/3/2006 8:53:46 AM ;

 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006

 ;this routine will save off the data from the GUI client

DEBUG(BNIRET,BNISTR) ;-- call the serenji debugger for testing

 D DEBUG^%Serenji("GEN^BNIGE(.BNIRET,.BNISTR)")

FILE(BNIRET,BNISTR) ;-- file generic data

 S X="MERR^BNIU",@^%ZOSF("TRAP") ; m error trap

 N P,BNIFL,BNIDAS,BNIFLDS,BNII,BNIMOD,R,BNIPAT,BNIIA

 S P="|",R="~"

 K ^BNITMP($J)

 S BNIRET="^BNITMP("_$J_")"

 S BNII=0

 S ^BNITMP($J,BNII)="T00007Error^T00080Return String"_$C(30)

 S BNII=BNII+1

 I $G(BNISTR)="" D CATSTR^BNIGU(.BNISTR,.BNISTR)

 S BNIMOD=$P($P(BNISTR,P),R)

 ;S BNIFL=$P($P(BNISTR,P),R,2)

 S BNIPAT=$P($P(BNISTR,P),R,3)

 S BNIIA=$P($P(BNISTR,P),R,4)

 I BNIPAT]"" S DFN=BNIPAT

 S BNIDAS=$P(BNISTR,P,2)

 S BNIFLDS=$P(BNISTR,P,3,999)

 N BNIIENS,BNIFDA,BNIERR

 S BNILV=$L(BNIIA,",")

 I BNILV>1 D

 . Q:BNIMOD="D"

 . N J

 . F J=1:1 D  Q:$P(BNIIA,",",(J))=""

 .. Q:$P(BNIIA,",",(J))=""

 .. Q:(BNILV-J)=0

 .. S BNIIENS(BNILV-J)=$P(BNIIA,",",J)

 I BNIMOD="D" D  Q

 . D DIK(BNIFL,BNIDAS)

 . S ^BNITMP($J,BNII)="1^Data Filed Successfully For File "_BNIFL_$C(30)

 . S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)

 S BNIIENS=BNIDAS

 F I=1:1 D  Q:$P(BNIFLDS,"|",I)=""

 . Q:$P(BNIFLDS,"|",I)=""

 . N BNIFLD,BNIVAL,BNITYP,BNIS

 . S BNIS=$P(BNIFLDS,P,I)

 . S BNIFL=$P(BNIS,R)

 . S BNIFLD=$P(BNIS,R,2)

 . S BNIVAL=$P(BNIS,R,3)

 . ;I $P(BNIS,R,5)]"" S BNIIENS=$P(BNIS,R,5)

 . I $P(BNIS,R,4)="E" D

 .. S BNIVAL=$$LOOK(BNIFL,BNIFLD,BNIVAL)

 . S BNIFDA(BNIFL,$S($P(BNIS,R,5)]"":$P(BNIS,R,5),1:BNIIENS),BNIFLD)=BNIVAL

 I BNIMOD="A" D

 . D UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 I BNIMOD="E" D

 . D FILE^DIE("K","BNIFDA","BNIERR(1)")

 I $D(BNIERR(1)) D  Q

 . S ^BNITMP($J,BNII)="0^Error Filing Data For File "_BNIFL_$C(30)

 . S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)

 S ^BNITMP($J,BNII)=$S($G(BNIIENS(1)):BNIIENS(1),1:+$G(BNIIENS))_"^Data Filed Successfully For File "_BNIFL_$C(30)

 S ^BNITMP($J,BNII+1)=$C(31)_$G(BNIERR)

LOOK(FL,FLD,VAL) ;-- get the file pointed to

 I VAL="" Q ""

 N PTR

 S PTR=$P($G(^DD(FL,FLD,0)),U,3)

 S PTR="^"_PTR_"""B"")"

 Q $O(@PTR@(VAL,0))

DIK(FL,DAS) ;-- remove an entry from the file

 S LVLS=$L(DAS,",")

 S DFN=$P(DAS,",")

 I LVLS>1 F I=1:1:LVLS D  I DAS="ERR" S OUT="Invalid DAS string" Q  ; MAKE DAS ARRAY.  MIRRORS THE DA() ARRAY

 . I I=LVLS S DAS=$P(DAS,",",I) Q  ; SET DAS OF SUBFILE

 . S %=$P(DAS,",",I) I '% S DAS="ERR" Q

 . S DAS(LVLS-I)=% ; SET DAS(S) OF PARENT FILE(S). LIKE DA(), THE LARGER THE DAS SUBSCRIPT, THE HIGHER THE LEVEL

. Q

 S %=$$REF^BMXADOF(FL,.DAS)

 S OREF=$P(%,"|",2)

 S FILE=FL

 D DIK^BMXADOF(OREF,.DAS)

CMT(BNIRET,BNISTR) ;-- save additional comments

 S X="MERR^BNIGU",@^%ZOSF("TRAP") ; m error trap

 N P,BNIREC,BNIFL,BNITXT

 S P="|"

 K ^BNITMP($J)

 S BNIRET="^BNITMP("_$J_")"

 S BNII=0

 S ^BNITMP($J,BNII)="T00007Error^T00080Return String"_$C(30)

 S BNII=BNII+1

 I $G(BNISTR)]"" D

 . S BNIREC=$P(BNISTR,P)

 . S BNIFL=$P(BNISTR,P,2)

 . S BNITXT(1)=$P(BNISTR,P,3)

 I $G(BNISTR)="" D

 . S BPHTXT(1)=""

 . D CATSTR^BNIGU(.BNISTR,.BNISTR)

 . S BNIREC=$P($G(BNISTR),P)

 . S BNIFL=$P(BNISTR,P,2)

 . S BNITXT(1)=$P($G(BNISTR),P,3)

 N BNIIENS,BNIFLD,BNIERR

 S BNIIENS=BNIREC_","

 S BNIFLD=1400

 D WP^DIE(BNIFL,BNIIENS,BNIFLD,,"BNITXT","BNIERR")

 I $D(BNIERR(1)) D  Q

 . S ^BNITMP($J,BNII)="0^Error Saving Additional Comments"_$C(30)

 . S ^BNITMP($J,BNII+1)=$C(31)

 S ^BNITMP($J,BNII)=$G(BNIIENS(1))_U_$C(30)

 S ^BNITMP($J,BNII+1)=$C(31)

DELREC(BNIRET,BNISTR) ;-- delete records

 S X="MERR^BNIGU",@^%ZOSF("TRAP") ; m error trap

 N P,I,BNII,R

 S P="|",R="~"

 S BNIRET="^BNITMP("_$J_")"

 K ^BNITMP($J)

 S BNII=0

 S ^BNITMP($J,BNII)="T00001Error"_$C(30)

 F I=1:1 D  Q:$P(BNISTR,R,I)=""

 . Q:$P(BNISTR,R,I)=""

 . S DA=$P(BNISTR,R,I)

 . S DIK="^BNIREC("

 . D ^DIK

 S ^BNITMP($J,BNII+1)=$C(31)

GEN(RETVAL,BNISTR) ;-- save general retrieval then queue

 N P,R,A,C

 S P="|",R="~",A="*",C=","

 S RETVAL="^BNITMP("_$J_")"

 I $G(BNISTR)="" D CATSTR^BNIGU(.BNISTR,.BNISTR)

 K ^BNITMP($J)

 N BNII

 S BNII=0

 S ^BNITMP($J,BNII)="T00080Error"_$C(30)

 N BNINM,BNIPERM,BNINOR,BNISP,BNITYP,BNISRT,BNISRTE,BNIFL,BNIDUZ,BNIREC,BNIPRT,BNIPR

 S BNIDUZ=$P(BNISTR,P,13)

 S BNINM=$P($G(^VA(200,BNIDUZ,0)),U)_"-"_$$FMTE^XLFDT($$NOW^XLFDT)

 S BNIPERM=$P(BNISTR,P,2)

 S BNINOR=$P(BNISTR,P,3)

 S BNISP=$P(BNISTR,P,4)

 S BNITYP=$P(BNISTR,P,5)

 S BNISRT=$P(BNISTR,P,7)

 S BNISRTE=$P(BNISTR,P,8)

 S BNIFL=$P(BNISTR,P,12)

 S BNIREC=$P(BNISTR,P,14)

 S BNIPRT=$P(BNISTR,P,15)

 N BNIBG,BNIED,BNICUST

 S BNIBG=$P(BNISTR,P,16)

 S BNIED=$P(BNISTR,P,17)

 S BNICUST=$P(BNISTR,P,18)

 S BNIPR=$P(BNISTR,P,19)

 I $G(BNIPR)]"" D  Q

 . S BNIIEN1=$O(^BNIRTMP("C",BNIPR,0))

 . D BDMG^BNIGVL(BNIBG,BNIED,BNIIEN1,BNICUST)

 . I '$G(BNIIEN) D  Q

 .. S ^BNITMP($J,1)=0_$C(30)

 .. S ^BNITMP($J,2)=$C(31)

 . S ^BNITMP($J,1)=$G(BNIIEN)_$C(30)

 . S ^BNITMP($J,2)=$C(31)

 N BNIFDA,BNIIENS,BNIERR

 S BNIIENS=""

 S BNIFDA(90512.88,"+1,",.01)=BNINM

 S BNIFDA(90512.88,"+1,",.02)=BNIPERM

 S BNIFDA(90512.88,"+1,",.03)=BNINOR

 S BNIFDA(90512.88,"+1,",.04)=BNISP

 S BNIFDA(90512.88,"+1,",.05)=BNITYP

 S BNIFDA(90512.88,"+1,",.06)="R"

 S BNIFDA(90512.88,"+1,",.07)=BNISRT

 S BNIFDA(90512.88,"+1,",.08)=BNISRTE

 S BNIFDA(90512.88,"+1,",.12)=BNIFL

 S BNIFDA(90512.88,"+1,",.13)=BNIDUZ

 D UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 I $G(BNIERR(1)) D  Q

 . S ^BNITMP($J,1)=0_$C(30)

 . S ^BNITMP($J,2)=$C(31)

 S BNIIEN1=$G(BNIIENS(1))

 N BNIJ

 F BNIJ=1:1 D  Q:$P(BNIREC,R,BNIJ)=""

 . Q:$P(BNIREC,R,BNIJ)=""

 . N BNIITM,BNIFITM

 . S BNIITM=$P(BNIREC,R,BNIJ)

 . S BNIFITM=$P(BNIITM,A,1)

 . N BNIFDA,BNIIENS,BNIERR

 . S BNIIENS(1)=BNIIEN1

 . S BNIIENS(2)=BNIFITM

 . S BNIIENS="+2,"_BNIIEN1_","

 . S BNIFDA(90512.89101,BNIIENS,.01)=BNIFITM

 . D UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 . I $G(BNIERR(1)) D  Q

 .. S ^BNITMP($J,1)=0_$C(30)

 .. S ^BNITMP($J,2)=$C(31)

 . S BNIIEN2=$G(BNIIENS(2))

 . N BNIK

 . F BNIK=2:1 D  Q:$P(BNIITM,A,BNIK)=""

 .. Q:$P(BNIITM,A,BNIK)=""

 .. N BNISITM,BNISITM2

 .. S BNISITM=$P(BNIITM,A,BNIK)

 .. I $G(BNISITM)["," S BNISITM2=$P(BNISITM,",",2),BNISITM=$P(BNISITM,",",1)

 .. N BNIFDA,BNIIENS,BNIERR

 .. S BNIIENS(1)=BNIIEN1

 .. S BNIIENS(2)=BNIIEN2

 .. S BNIIENS="+3,"_BNIIEN2_","_BNIIEN1_","

 .. S BNIFDA(90512.8910101,BNIIENS,.01)=BNISITM

 .. S BNIFDA(90512.8910101,BNIIENS,.02)=$G(BNISITM2)

 .. D UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 .. I $G(BNIERR(1)) D  Q

 ... S ^BNITMP($J,1)=0_$C(30)

 ... S ^BNITMP($J,2)=$C(31)

 .. S BNIIENS3=$G(BNIIENS(3))

 N BNIL

 F BNIL=1:1 D  Q:$P(BNIPRT,R,BNIL)=""

 . Q:$P(BNIPRT,R,BNIL)=""

 . N BNIPREC,BNIPITM,BNILNG

 . S BNIPREC=$P(BNIPRT,R,BNIL)

 . S BNIPITM=$P(BNIPREC,A,1)

 . S BNILNG=$P(BNIPREC,A,2)

 . N BNIFDA,BNIIENS,BNIERR

 . S BNIIENS(1)=BNIIEN1

 . S BNIIENS="+2,"_BNIIEN1_","

 . S BNIFDA(90512.89102,BNIIENS,.01)=BNIPITM

 . S BNIFDA(90512.89102,BNIIENS,.02)=BNILNG

 . D UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 . I $G(BNIERR(1)) D  Q

 .. S ^BNITMP($J,1)=0_$C(30)

 .. S ^BNITMP($J,2)=$C(31)

 . S BNIIENP2=$G(BNIIENS(2))

 ;call loris stuff if we get this far

 D BDMG^BNIGVL(BNIBG,BNIED,BNIIEN1,BNICUST)

 I '$G(BNIIEN) D  Q

 . S ^BNITMP($J,1)=0_$C(30)

 . S ^BNITMP($J,2)=$C(31)

 S ^BNITMP($J,1)=$G(BNIIEN)_$C(30)

 S ^BNITMP($J,2)=$C(31)

BNIGE     ; IHS/CMI/LAB - BNI GUI Save Utilities 2/3/2006 8:53:46 AM ;

 +1       ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006

 +2       ;

 +3       ;

 +4       ;

 +5       ;

 +6       ;

 +7       ;this routine will save off the data from the GUI client

 +8       ;

DEBUG(BNIRET,BNISTR) ;-- call the serenji debugger for testing

 +1        DO DEBUG^%Serenji("GEN^BNIGE(.BNIRET,.BNISTR)")

 +2        QUIT

 +3       ;

FILE(BNIRET,BNISTR) ;-- file generic data

 +1       ; m error trap

           SET X="MERR^BNIU"

           SET @^%ZOSF("TRAP")

 +2        NEW P,BNIFL,BNIDAS,BNIFLDS,BNII,BNIMOD,R,BNIPAT,BNIIA

 +3        SET P="|"

           SET R="~"

 +4        KILL ^BNITMP($JOB)

 +5        SET BNIRET="^BNITMP("_$JOB_")"

 +6        SET BNII=0

 +7        SET ^BNITMP($JOB,BNII)="T00007Error^T00080Return String"_$CHAR(30)

 +8        SET BNII=BNII+1

 +9        IF $GET(BNISTR)=""

               DO CATSTR^BNIGU(.BNISTR,.BNISTR)

 +10       SET BNIMOD=$PIECE($PIECE(BNISTR,P),R)

 +11      ;S BNIFL=$P($P(BNISTR,P),R,2)

 +12       SET BNIPAT=$PIECE($PIECE(BNISTR,P),R,3)

 +13       SET BNIIA=$PIECE($PIECE(BNISTR,P),R,4)

 +14       IF BNIPAT]""

               SET DFN=BNIPAT

 +15       SET BNIDAS=$PIECE(BNISTR,P,2)

 +16       SET BNIFLDS=$PIECE(BNISTR,P,3,999)

 +17       NEW BNIIENS,BNIFDA,BNIERR

 +18       SET BNILV=$LENGTH(BNIIA,",")

 +19       IF BNILV>1

               Begin DoDot:1

 +20               IF BNIMOD="D"

                       QUIT

 +21               NEW J

 +22               FOR J=1:1

                       Begin DoDot:2

 +23                       IF $PIECE(BNIIA,",",(J))=""

                               QUIT

 +24                       IF (BNILV-J)=0

                               QUIT

 +25                       SET BNIIENS(BNILV-J)=$PIECE(BNIIA,",",J)

                       End DoDot:2

                       IF $PIECE(BNIIA,",",(J))=""

                           QUIT

               End DoDot:1

 +26       IF BNIMOD="D"

               Begin DoDot:1

 +27               DO DIK(BNIFL,BNIDAS)

 +28               SET ^BNITMP($JOB,BNII)="1^Data Filed Successfully For File "_BNIFL_$CHAR(30)

 +29               SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)

               End DoDot:1

               QUIT

 +30       SET BNIIENS=BNIDAS

 +31       FOR I=1:1

               Begin DoDot:1

 +32               IF $PIECE(BNIFLDS,"|",I)=""

                       QUIT

 +33               NEW BNIFLD,BNIVAL,BNITYP,BNIS

 +34               SET BNIS=$PIECE(BNIFLDS,P,I)

 +35               SET BNIFL=$PIECE(BNIS,R)

 +36               SET BNIFLD=$PIECE(BNIS,R,2)

 +37               SET BNIVAL=$PIECE(BNIS,R,3)

 +38      ;I $P(BNIS,R,5)]"" S BNIIENS=$P(BNIS,R,5)

 +39               IF $PIECE(BNIS,R,4)="E"

                       Begin DoDot:2

 +40                       SET BNIVAL=$$LOOK(BNIFL,BNIFLD,BNIVAL)

                       End DoDot:2

 +41               SET BNIFDA(BNIFL,$SELECT($PIECE(BNIS,R,5)]"":$PIECE(BNIS,R,5),1:BNIIENS),BNIFLD)=BNIVAL

               End DoDot:1

               IF $PIECE(BNIFLDS,"|",I)=""

                   QUIT

 +42       IF BNIMOD="A"

               Begin DoDot:1

 +43               DO UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

               End DoDot:1

 +44       IF BNIMOD="E"

               Begin DoDot:1

 +45               DO FILE^DIE("K","BNIFDA","BNIERR(1)")

               End DoDot:1

 +46       IF $DATA(BNIERR(1))

               Begin DoDot:1

 +47               SET ^BNITMP($JOB,BNII)="0^Error Filing Data For File "_BNIFL_$CHAR(30)

 +48               SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)

               End DoDot:1

               QUIT

 +49       SET ^BNITMP($JOB,BNII)=$SELECT($GET(BNIIENS(1)):BNIIENS(1),1:+$GET(BNIIENS))_"^Data Filed Successfully For File "_BNIFL_$CHAR(30)

 +50       SET ^BNITMP($JOB,BNII+1)=$CHAR(31)_$GET(BNIERR)

 +51       QUIT

 +52      ;

LOOK(FL,FLD,VAL) ;-- get the file pointed to

 +1        IF VAL=""

               QUIT ""

 +2        NEW PTR

 +3        SET PTR=$PIECE($GET(^DD(FL,FLD,0)),U,3)

 +4        SET PTR="^"_PTR_"""B"")"

 +5        QUIT $ORDER(@PTR@(VAL,0))

 +6       ;

DIK(FL,DAS) ;-- remove an entry from the file

 +1        SET LVLS=$LENGTH(DAS,",")

 +2        SET DFN=$PIECE(DAS,",")

 +3       ; MAKE DAS ARRAY.  MIRRORS THE DA() ARRAY

           IF LVLS>1

               FOR I=1:1:LVLS

                   Begin DoDot:1

 +4       ; SET DAS OF SUBFILE

                       IF I=LVLS

                           SET DAS=$PIECE(DAS,",",I)

                           QUIT

 +5                    SET %=$PIECE(DAS,",",I)

                       IF '%

                           SET DAS="ERR"

                           QUIT

 +6       ; SET DAS(S) OF PARENT FILE(S). LIKE DA(), THE LARGER THE DAS SUBSCRIPT, THE HIGHER THE LEVEL

                       SET DAS(LVLS-I)=%

 +7                    QUIT

                   End DoDot:1

                   IF DAS="ERR"

                       SET OUT="Invalid DAS string"

                       QUIT

 +8        SET %=$$REF^BMXADOF(FL,.DAS)

 +9        SET OREF=$PIECE(%,"|",2)

 +10       SET FILE=FL

 +11       DO DIK^BMXADOF(OREF,.DAS)

 +12      ;

CMT(BNIRET,BNISTR) ;-- save additional comments

 +1       ; m error trap

           SET X="MERR^BNIGU"

           SET @^%ZOSF("TRAP")

 +2        NEW P,BNIREC,BNIFL,BNITXT

 +3        SET P="|"

 +4        KILL ^BNITMP($JOB)

 +5        SET BNIRET="^BNITMP("_$JOB_")"

 +6        SET BNII=0

 +7        SET ^BNITMP($JOB,BNII)="T00007Error^T00080Return String"_$CHAR(30)

 +8        SET BNII=BNII+1

 +9        IF $GET(BNISTR)]""

               Begin DoDot:1

 +10               SET BNIREC=$PIECE(BNISTR,P)

 +11               SET BNIFL=$PIECE(BNISTR,P,2)

 +12               SET BNITXT(1)=$PIECE(BNISTR,P,3)

               End DoDot:1

 +13       IF $GET(BNISTR)=""

               Begin DoDot:1

 +14               SET BPHTXT(1)=""

 +15               DO CATSTR^BNIGU(.BNISTR,.BNISTR)

 +16               SET BNIREC=$PIECE($GET(BNISTR),P)

 +17               SET BNIFL=$PIECE(BNISTR,P,2)

 +18               SET BNITXT(1)=$PIECE($GET(BNISTR),P,3)

               End DoDot:1

 +19       NEW BNIIENS,BNIFLD,BNIERR

 +20       SET BNIIENS=BNIREC_","

 +21       SET BNIFLD=1400

 +22       DO WP^DIE(BNIFL,BNIIENS,BNIFLD,,"BNITXT","BNIERR")

 +23       IF $DATA(BNIERR(1))

               Begin DoDot:1

 +24               SET ^BNITMP($JOB,BNII)="0^Error Saving Additional Comments"_$CHAR(30)

 +25               SET ^BNITMP($JOB,BNII+1)=$CHAR(31)

               End DoDot:1

               QUIT

 +26       SET ^BNITMP($JOB,BNII)=$GET(BNIIENS(1))_U_$CHAR(30)

 +27       SET ^BNITMP($JOB,BNII+1)=$CHAR(31)

 +28       QUIT

 +29      ;

DELREC(BNIRET,BNISTR) ;-- delete records

 +1       ; m error trap

           SET X="MERR^BNIGU"

           SET @^%ZOSF("TRAP")

 +2        NEW P,I,BNII,R

 +3        SET P="|"

           SET R="~"

 +4        SET BNIRET="^BNITMP("_$JOB_")"

 +5        KILL ^BNITMP($JOB)

 +6        SET BNII=0

 +7        SET ^BNITMP($JOB,BNII)="T00001Error"_$CHAR(30)

 +8        FOR I=1:1

               Begin DoDot:1

 +9                IF $PIECE(BNISTR,R,I)=""

                       QUIT

 +10               SET DA=$PIECE(BNISTR,R,I)

 +11               SET DIK="^BNIREC("

 +12               DO ^DIK

               End DoDot:1

               IF $PIECE(BNISTR,R,I)=""

                   QUIT

 +13       SET ^BNITMP($JOB,BNII+1)=$CHAR(31)

 +14       QUIT

 +15      ;

GEN(RETVAL,BNISTR) ;-- save general retrieval then queue

 +1        NEW P,R,A,C

 +2        SET P="|"

           SET R="~"

           SET A="*"

           SET C=","

 +3        SET RETVAL="^BNITMP("_$JOB_")"

 +4        IF $GET(BNISTR)=""

               DO CATSTR^BNIGU(.BNISTR,.BNISTR)

 +5        KILL ^BNITMP($JOB)

 +6        NEW BNII

 +7        SET BNII=0

 +8        SET ^BNITMP($JOB,BNII)="T00080Error"_$CHAR(30)

 +9        NEW BNINM,BNIPERM,BNINOR,BNISP,BNITYP,BNISRT,BNISRTE,BNIFL,BNIDUZ,BNIREC,BNIPRT,BNIPR

 +10       SET BNIDUZ=$PIECE(BNISTR,P,13)

 +11       SET BNINM=$PIECE($GET(^VA(200,BNIDUZ,0)),U)_"-"_$$FMTE^XLFDT($$NOW^XLFDT)

 +12       SET BNIPERM=$PIECE(BNISTR,P,2)

 +13       SET BNINOR=$PIECE(BNISTR,P,3)

 +14       SET BNISP=$PIECE(BNISTR,P,4)

 +15       SET BNITYP=$PIECE(BNISTR,P,5)

 +16       SET BNISRT=$PIECE(BNISTR,P,7)

 +17       SET BNISRTE=$PIECE(BNISTR,P,8)

 +18       SET BNIFL=$PIECE(BNISTR,P,12)

 +19       SET BNIREC=$PIECE(BNISTR,P,14)

 +20       SET BNIPRT=$PIECE(BNISTR,P,15)

 +21       NEW BNIBG,BNIED,BNICUST

 +22       SET BNIBG=$PIECE(BNISTR,P,16)

 +23       SET BNIED=$PIECE(BNISTR,P,17)

 +24       SET BNICUST=$PIECE(BNISTR,P,18)

 +25       SET BNIPR=$PIECE(BNISTR,P,19)

 +26       IF $GET(BNIPR)]""

               Begin DoDot:1

 +27               SET BNIIEN1=$ORDER(^BNIRTMP("C",BNIPR,0))

 +28               DO BDMG^BNIGVL(BNIBG,BNIED,BNIIEN1,BNICUST)

 +29               IF '$GET(BNIIEN)

                       Begin DoDot:2

 +30                       SET ^BNITMP($JOB,1)=0_$CHAR(30)

 +31                       SET ^BNITMP($JOB,2)=$CHAR(31)

                       End DoDot:2

                       QUIT

 +32               SET ^BNITMP($JOB,1)=$GET(BNIIEN)_$CHAR(30)

 +33               SET ^BNITMP($JOB,2)=$CHAR(31)

               End DoDot:1

               QUIT

 +34       NEW BNIFDA,BNIIENS,BNIERR

 +35       SET BNIIENS=""

 +36       SET BNIFDA(90512.88,"+1,",.01)=BNINM

 +37       SET BNIFDA(90512.88,"+1,",.02)=BNIPERM

 +38       SET BNIFDA(90512.88,"+1,",.03)=BNINOR

 +39       SET BNIFDA(90512.88,"+1,",.04)=BNISP

 +40       SET BNIFDA(90512.88,"+1,",.05)=BNITYP

 +41       SET BNIFDA(90512.88,"+1,",.06)="R"

 +42       SET BNIFDA(90512.88,"+1,",.07)=BNISRT

 +43       SET BNIFDA(90512.88,"+1,",.08)=BNISRTE

 +44       SET BNIFDA(90512.88,"+1,",.12)=BNIFL

 +45       SET BNIFDA(90512.88,"+1,",.13)=BNIDUZ

 +46       DO UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 +47       IF $GET(BNIERR(1))

               Begin DoDot:1

 +48               SET ^BNITMP($JOB,1)=0_$CHAR(30)

 +49               SET ^BNITMP($JOB,2)=$CHAR(31)

               End DoDot:1

               QUIT

 +50       SET BNIIEN1=$GET(BNIIENS(1))

 +51       NEW BNIJ

 +52       FOR BNIJ=1:1

               Begin DoDot:1

 +53               IF $PIECE(BNIREC,R,BNIJ)=""

                       QUIT

 +54               NEW BNIITM,BNIFITM

 +55               SET BNIITM=$PIECE(BNIREC,R,BNIJ)

 +56               SET BNIFITM=$PIECE(BNIITM,A,1)

 +57               NEW BNIFDA,BNIIENS,BNIERR

 +58               SET BNIIENS(1)=BNIIEN1

 +59               SET BNIIENS(2)=BNIFITM

 +60               SET BNIIENS="+2,"_BNIIEN1_","

 +61               SET BNIFDA(90512.89101,BNIIENS,.01)=BNIFITM

 +62               DO UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 +63               IF $GET(BNIERR(1))

                       Begin DoDot:2

 +64                       SET ^BNITMP($JOB,1)=0_$CHAR(30)

 +65                       SET ^BNITMP($JOB,2)=$CHAR(31)

                       End DoDot:2

                       QUIT

 +66               SET BNIIEN2=$GET(BNIIENS(2))

 +67               NEW BNIK

 +68               FOR BNIK=2:1

                       Begin DoDot:2

 +69                       IF $PIECE(BNIITM,A,BNIK)=""

                               QUIT

 +70                       NEW BNISITM,BNISITM2

 +71                       SET BNISITM=$PIECE(BNIITM,A,BNIK)

 +72                       IF $GET(BNISITM)[","

                               SET BNISITM2=$PIECE(BNISITM,",",2)

                               SET BNISITM=$PIECE(BNISITM,",",1)

 +73                       NEW BNIFDA,BNIIENS,BNIERR

 +74                       SET BNIIENS(1)=BNIIEN1

 +75                       SET BNIIENS(2)=BNIIEN2

 +76                       SET BNIIENS="+3,"_BNIIEN2_","_BNIIEN1_","

 +77                       SET BNIFDA(90512.8910101,BNIIENS,.01)=BNISITM

 +78                       SET BNIFDA(90512.8910101,BNIIENS,.02)=$GET(BNISITM2)

 +79                       DO UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 +80                       IF $GET(BNIERR(1))

                               Begin DoDot:3

 +81                               SET ^BNITMP($JOB,1)=0_$CHAR(30)

 +82                               SET ^BNITMP($JOB,2)=$CHAR(31)

                               End DoDot:3

                               QUIT

 +83                       SET BNIIENS3=$GET(BNIIENS(3))

                       End DoDot:2

                       IF $PIECE(BNIITM,A,BNIK)=""

                           QUIT

               End DoDot:1

               IF $PIECE(BNIREC,R,BNIJ)=""

                   QUIT

 +84       NEW BNIL

 +85       FOR BNIL=1:1

               Begin DoDot:1

 +86               IF $PIECE(BNIPRT,R,BNIL)=""

                       QUIT

 +87               NEW BNIPREC,BNIPITM,BNILNG

 +88               SET BNIPREC=$PIECE(BNIPRT,R,BNIL)

 +89               SET BNIPITM=$PIECE(BNIPREC,A,1)

 +90               SET BNILNG=$PIECE(BNIPREC,A,2)

 +91               NEW BNIFDA,BNIIENS,BNIERR

 +92               SET BNIIENS(1)=BNIIEN1

 +93               SET BNIIENS="+2,"_BNIIEN1_","

 +94               SET BNIFDA(90512.89102,BNIIENS,.01)=BNIPITM

 +95               SET BNIFDA(90512.89102,BNIIENS,.02)=BNILNG

 +96               DO UPDATE^DIE("","BNIFDA","BNIIENS","BNIERR(1)")

 +97               IF $GET(BNIERR(1))

                       Begin DoDot:2

 +98                       SET ^BNITMP($JOB,1)=0_$CHAR(30)

 +99                       SET ^BNITMP($JOB,2)=$CHAR(31)

                       End DoDot:2

                       QUIT

 +100              SET BNIIENP2=$GET(BNIIENS(2))

               End DoDot:1

               IF $PIECE(BNIPRT,R,BNIL)=""

                   QUIT

 +101     ;call loris stuff if we get this far

 +102      DO BDMG^BNIGVL(BNIBG,BNIED,BNIIEN1,BNICUST)

 +103      IF '$GET(BNIIEN)

               Begin DoDot:1

 +104              SET ^BNITMP($JOB,1)=0_$CHAR(30)

 +105              SET ^BNITMP($JOB,2)=$CHAR(31)

               End DoDot:1

               QUIT

 +106      SET ^BNITMP($JOB,1)=$GET(BNIIEN)_$CHAR(30)

 +107      SET ^BNITMP($JOB,2)=$CHAR(31)

 +108      QUIT

 +109     ;

BNIGE.m