BGP1ULF1 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 02 Jul 2010 9:38 AM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
PROCEO ;EP
W !,"Processing",!
S BGP0=$P($G(^TMP("BGPUPL",$J,1,0)),"|",9)
S BGPG=$P($G(^TMP("BGPUPL",$J,1,0)),"|")
F X=1:1:14 S Y="BGP"_X,@Y=$P(BGP0,U,X)
;find existing entry and if exists, delete it
S (X,BGPOIEN)=0 F S X=$O(^BGPEOCB(X)) Q:X'=+X D
.I '$D(^BGPEOCB(X,0)) K ^BGPEOCB(X) Q
.S Y=^BGPEOCB(X,0)
.Q:$P(Y,U)'=BGP1
.Q:$P(Y,U,2)'=BGP2
.Q:$P(Y,U,3)'=BGP3
.Q:$P(Y,U,4)'=BGP4
.Q:$P(Y,U,5)'=BGP5
.Q:$P(Y,U,6)'=BGP6
.Q:$P(Y,U,8)'=BGP8
.Q:$P(Y,U,9)'=BGP9
.Q:$P(Y,U,10)'=BGP10
.Q:$P(Y,U,11)'=BGP11
.Q:$P(Y,U,12)'=BGP12
.Q:$P(Y,U,14)'=BGP14
.S BGPOIEN=X
D ^XBFMK
I BGPOIEN S DA=BGPOIEN,DIK="^BGPEOCB(" D ^DIK S DA=BGPOIEN,DIK="^BGPEOPB(" D ^DIK S DA=BGPOIEN,DIK="^BGPEOBB(" D ^DIK
;add entry
L +^BGPEOCB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ^BGP1ULF Q
L +^BGPEOPB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ^BGP1ULF Q
L +^BGPEOBB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ^BGP1ULF Q
D GETIEN^BGP1EOUT
I 'BGPIEN W !!,"error in file creation...call programmer." D EOJ^BGP1ULF Q
ELCY ;
S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90547.1,DIC="^BGPEOCB(",DIC(0)="L"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !,"error uploading file......" H 4 D EOJ^BGP1ULF Q
S BGPIEN=+Y
D ^XBFMK
S X=0 F S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X S V=^TMP("BGPUPL",$J,X,0) D
.Q:$P(V,"|")'="BGPEOCB"
.S V=$P(V,"|",2,9999)
.S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
.I N5]"" S ^BGPEOCB(BGPIEN,N,N2,N3,N4,N5)=D Q
.I N4]"" S ^BGPEOCB(BGPIEN,N,N2,N3,N4)=D Q
.I N3]"" S ^BGPEOCB(BGPIEN,N,N2,N3)=D Q
.I N2]"" S ^BGPEOCB(BGPIEN,N,N2)=D Q
.I N]"" S ^BGPEOCB(BGPIEN,N)=D
.Q
S DA=BGPIEN,DIK="^BGPEOCB(" D IX1^DIK
ELPY ;
S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90547.11,DIC="^BGPEOPB(",DIC(0)="L"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !,"error uploading file......" H 4 D EOJ^BGP1ULF Q
S BGPIEN=+Y
D ^XBFMK
S X=0 F S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X S V=^TMP("BGPUPL",$J,X,0) D
.Q:$P(V,"|")'="BGPEOPB"
.S V=$P(V,"|",2,9999)
.S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
.I N5]"" S ^BGPEOPB(BGPIEN,N,N2,N3,N4,N5)=D Q
.I N4]"" S ^BGPEOPB(BGPIEN,N,N2,N3,N4)=D Q
.I N3]"" S ^BGPEOPB(BGPIEN,N,N2,N3)=D Q
.I N2]"" S ^BGPEOPB(BGPIEN,N,N2)=D Q
.I N]"" S ^BGPEOPB(BGPIEN,N)=D
.Q
S DA=BGPIEN,DIK="^BGPEOPB(" D IX1^DIK
ELBY ;
S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90547.12,DIC="^BGPEOBB(",DIC(0)="L"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !,"error uploading file......" H 4 D EOJ^BGP1ULF Q
S BGPIEN=+Y
D ^XBFMK
S X=0 F S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X S V=^TMP("BGPUPL",$J,X,0) D
.Q:$P(V,"|")'="BGPEOBB"
.S V=$P(V,"|",2,9999)
.S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
.I N5]"" S ^BGPEOBB(BGPIEN,N,N2,N3,N4,N5)=D Q
.I N4]"" S ^BGPEOBB(BGPIEN,N,N2,N3,N4)=D Q
.I N3]"" S ^BGPEOBB(BGPIEN,N,N2,N3)=D Q
.I N2]"" S ^BGPEOBB(BGPIEN,N,N2)=D Q
.I N]"" S ^BGPEOBB(BGPIEN,N)=D
.Q
S DA=BGPIEN,DIK="^BGPEOBB(" D IX1^DIK
W !,"Data uploaded."
D EOJ^BGP1ULF
Q
;
BGP1ULF1 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 02 Jul 2010 9:38 AM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
PROCEO ;EP
+1 WRITE !,"Processing",!
+2 SET BGP0=$PIECE($GET(^TMP("BGPUPL",$JOB,1,0)),"|",9)
+3 SET BGPG=$PIECE($GET(^TMP("BGPUPL",$JOB,1,0)),"|")
+4 FOR X=1:1:14
SET Y="BGP"_X
SET @Y=$PIECE(BGP0,U,X)
+5 ;find existing entry and if exists, delete it
+6 SET (X,BGPOIEN)=0
FOR
SET X=$ORDER(^BGPEOCB(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 IF '$DATA(^BGPEOCB(X,0))
KILL ^BGPEOCB(X)
QUIT
+8 SET Y=^BGPEOCB(X,0)
+9 IF $PIECE(Y,U)'=BGP1
QUIT
+10 IF $PIECE(Y,U,2)'=BGP2
QUIT
+11 IF $PIECE(Y,U,3)'=BGP3
QUIT
+12 IF $PIECE(Y,U,4)'=BGP4
QUIT
+13 IF $PIECE(Y,U,5)'=BGP5
QUIT
+14 IF $PIECE(Y,U,6)'=BGP6
QUIT
+15 IF $PIECE(Y,U,8)'=BGP8
QUIT
+16 IF $PIECE(Y,U,9)'=BGP9
QUIT
+17 IF $PIECE(Y,U,10)'=BGP10
QUIT
+18 IF $PIECE(Y,U,11)'=BGP11
QUIT
+19 IF $PIECE(Y,U,12)'=BGP12
QUIT
+20 IF $PIECE(Y,U,14)'=BGP14
QUIT
+21 SET BGPOIEN=X
End DoDot:1
+22 DO ^XBFMK
+23 IF BGPOIEN
SET DA=BGPOIEN
SET DIK="^BGPEOCB("
DO ^DIK
SET DA=BGPOIEN
SET DIK="^BGPEOPB("
DO ^DIK
SET DA=BGPOIEN
SET DIK="^BGPEOBB("
DO ^DIK
+24 ;add entry
+25 LOCK +^BGPEOCB:10
IF '$TEST
WRITE !!,"unable to lock global. TRY LATER"
DO EOJ^BGP1ULF
QUIT
+26 LOCK +^BGPEOPB:10
IF '$TEST
WRITE !!,"unable to lock global. TRY LATER"
DO EOJ^BGP1ULF
QUIT
+27 LOCK +^BGPEOBB:10
IF '$TEST
WRITE !!,"unable to lock global. TRY LATER"
DO EOJ^BGP1ULF
QUIT
+28 DO GETIEN^BGP1EOUT
+29 IF 'BGPIEN
WRITE !!,"error in file creation...call programmer."
DO EOJ^BGP1ULF
QUIT
ELCY ;
+1 SET DINUM=BGPIEN
SET X=$PIECE(BGP0,U)
SET DLAYGO=90547.1
SET DIC="^BGPEOCB("
SET DIC(0)="L"
+2 KILL DD,D0,DO
+3 DO FILE^DICN
+4 IF Y=-1
WRITE !,"error uploading file......"
HANG 4
DO EOJ^BGP1ULF
QUIT
+5 SET BGPIEN=+Y
+6 DO ^XBFMK
+7 SET X=0
FOR
SET X=$ORDER(^TMP("BGPUPL",$JOB,X))
IF X'=+X
QUIT
SET V=^TMP("BGPUPL",$JOB,X,0)
Begin DoDot:1
+8 IF $PIECE(V,"|")'="BGPEOCB"
QUIT
+9 SET V=$PIECE(V,"|",2,9999)
+10 SET N=$PIECE(V,"|")
SET N2=$PIECE(V,"|",2)
SET N3=$PIECE(V,"|",3)
SET N4=$PIECE(V,"|",4)
SET N5=$PIECE(V,"|",5)
SET D=$PIECE(V,"|",8)
+11 IF N5]""
SET ^BGPEOCB(BGPIEN,N,N2,N3,N4,N5)=D
QUIT
+12 IF N4]""
SET ^BGPEOCB(BGPIEN,N,N2,N3,N4)=D
QUIT
+13 IF N3]""
SET ^BGPEOCB(BGPIEN,N,N2,N3)=D
QUIT
+14 IF N2]""
SET ^BGPEOCB(BGPIEN,N,N2)=D
QUIT
+15 IF N]""
SET ^BGPEOCB(BGPIEN,N)=D
+16 QUIT
End DoDot:1
+17 SET DA=BGPIEN
SET DIK="^BGPEOCB("
DO IX1^DIK
ELPY ;
+1 SET DINUM=BGPIEN
SET X=$PIECE(BGP0,U)
SET DLAYGO=90547.11
SET DIC="^BGPEOPB("
SET DIC(0)="L"
+2 KILL DD,D0,DO
+3 DO FILE^DICN
+4 IF Y=-1
WRITE !,"error uploading file......"
HANG 4
DO EOJ^BGP1ULF
QUIT
+5 SET BGPIEN=+Y
+6 DO ^XBFMK
+7 SET X=0
FOR
SET X=$ORDER(^TMP("BGPUPL",$JOB,X))
IF X'=+X
QUIT
SET V=^TMP("BGPUPL",$JOB,X,0)
Begin DoDot:1
+8 IF $PIECE(V,"|")'="BGPEOPB"
QUIT
+9 SET V=$PIECE(V,"|",2,9999)
+10 SET N=$PIECE(V,"|")
SET N2=$PIECE(V,"|",2)
SET N3=$PIECE(V,"|",3)
SET N4=$PIECE(V,"|",4)
SET N5=$PIECE(V,"|",5)
SET D=$PIECE(V,"|",8)
+11 IF N5]""
SET ^BGPEOPB(BGPIEN,N,N2,N3,N4,N5)=D
QUIT
+12 IF N4]""
SET ^BGPEOPB(BGPIEN,N,N2,N3,N4)=D
QUIT
+13 IF N3]""
SET ^BGPEOPB(BGPIEN,N,N2,N3)=D
QUIT
+14 IF N2]""
SET ^BGPEOPB(BGPIEN,N,N2)=D
QUIT
+15 IF N]""
SET ^BGPEOPB(BGPIEN,N)=D
+16 QUIT
End DoDot:1
+17 SET DA=BGPIEN
SET DIK="^BGPEOPB("
DO IX1^DIK
ELBY ;
+1 SET DINUM=BGPIEN
SET X=$PIECE(BGP0,U)
SET DLAYGO=90547.12
SET DIC="^BGPEOBB("
SET DIC(0)="L"
+2 KILL DD,D0,DO
+3 DO FILE^DICN
+4 IF Y=-1
WRITE !,"error uploading file......"
HANG 4
DO EOJ^BGP1ULF
QUIT
+5 SET BGPIEN=+Y
+6 DO ^XBFMK
+7 SET X=0
FOR
SET X=$ORDER(^TMP("BGPUPL",$JOB,X))
IF X'=+X
QUIT
SET V=^TMP("BGPUPL",$JOB,X,0)
Begin DoDot:1
+8 IF $PIECE(V,"|")'="BGPEOBB"
QUIT
+9 SET V=$PIECE(V,"|",2,9999)
+10 SET N=$PIECE(V,"|")
SET N2=$PIECE(V,"|",2)
SET N3=$PIECE(V,"|",3)
SET N4=$PIECE(V,"|",4)
SET N5=$PIECE(V,"|",5)
SET D=$PIECE(V,"|",8)
+11 IF N5]""
SET ^BGPEOBB(BGPIEN,N,N2,N3,N4,N5)=D
QUIT
+12 IF N4]""
SET ^BGPEOBB(BGPIEN,N,N2,N3,N4)=D
QUIT
+13 IF N3]""
SET ^BGPEOBB(BGPIEN,N,N2,N3)=D
QUIT
+14 IF N2]""
SET ^BGPEOBB(BGPIEN,N,N2)=D
QUIT
+15 IF N]""
SET ^BGPEOBB(BGPIEN,N)=D
+16 QUIT
End DoDot:1
+17 SET DA=BGPIEN
SET DIK="^BGPEOBB("
DO IX1^DIK
+18 WRITE !,"Data uploaded."
+19 DO EOJ^BGP1ULF
+20 QUIT
+21 ;
