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)")
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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 ;
