- BGP2ULF1 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 02 Jul 2010 9:38 AM ;
- ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- ;
- ;
- 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^BGP2ULF Q
- L +^BGPEOPB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ^BGP2ULF Q
- L +^BGPEOBB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ^BGP2ULF Q
- D GETIEN^BGP2EOUT
- I 'BGPIEN W !!,"error in file creation...call programmer." D EOJ^BGP2ULF Q
- ELCY ;
- S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90549.1,DIC="^BGPEOCB(",DIC(0)="L"
- K DD,D0,DO
- D FILE^DICN
- I Y=-1 W !,"error uploading file......" H 4 D EOJ^BGP2ULF 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=90549.11,DIC="^BGPEOPB(",DIC(0)="L"
- K DD,D0,DO
- D FILE^DICN
- I Y=-1 W !,"error uploading file......" H 4 D EOJ^BGP2ULF 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=90549.12,DIC="^BGPEOBB(",DIC(0)="L"
- K DD,D0,DO
- D FILE^DICN
- I Y=-1 W !,"error uploading file......" H 4 D EOJ^BGP2ULF 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^BGP2ULF
- Q
- ;
- BGP2ULF1 ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 02 Jul 2010 9:38 AM ;
- +1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
- +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^BGP2ULF
- QUIT
- +26 LOCK +^BGPEOPB:10
- IF '$TEST
- WRITE !!,"unable to lock global. TRY LATER"
- DO EOJ^BGP2ULF
- QUIT
- +27 LOCK +^BGPEOBB:10
- IF '$TEST
- WRITE !!,"unable to lock global. TRY LATER"
- DO EOJ^BGP2ULF
- QUIT
- +28 DO GETIEN^BGP2EOUT
- +29 IF 'BGPIEN
- WRITE !!,"error in file creation...call programmer."
- DO EOJ^BGP2ULF
- QUIT
- ELCY ;
- +1 SET DINUM=BGPIEN
- SET X=$PIECE(BGP0,U)
- SET DLAYGO=90549.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^BGP2ULF
- 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=90549.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^BGP2ULF
- 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=90549.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^BGP2ULF
- 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^BGP2ULF
- +20 QUIT
- +21 ;
