Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP1ULF

BGP1ULF.m

Go to the documentation of this file. 
  1. BGP1ULF ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 27 May 2011 4:26 PM ;
  1.  ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !,"This option is used to upload a SU's 2011 CRS data.",!,"You must specify the directory in which the CRS 2011 data file resides",!,"and then enter the filename of the data.",!
  1. FILE ;
  1.  D HOME^%ZIS
  1. DIR ;
  1.  K DIR
  1.  S BGPDIR=""
  1.  S DIR(0)="FO^3:50",DIR("A")="Enter directory path (i.e. /usr/spool/uucppublic/)" K DA D ^DIR K DIR
  1.  I $D(DIRUT) W !!,"Directory not entered!!  Bye." G EOJ
  1.  I Y="" W !!,"Directory not entered!! Bye." G EOJ
  1.  S BGPDIR=Y
  1. FILENAME ;
  1.  W !!
  1.  S BGPFILE=""
  1.  S DIR(0)="FO^2:30",DIR("A")="Enter filename w /ext (i.e. BG11101201.5)" K DA D ^DIR K DIR
  1.  G:$D(DIRUT) DIR
  1.  I Y="" G DIR
  1.  I $E($$UP^XLFSTR(Y),1,4)'="BG11" W !!,"Filename must begin with BG11" G FILENAME
  1.  S BGPFILE=Y
  1.  W !,"Directory=",BGPDIR,"  ","File=",BGPFILE
  1.  D READF
  1.  G FILENAME
  1. READF ;EP read file
  1.  NEW Y,X,I,BGPC
  1.  S BGPC=1
  1.  S Y=$$OPEN^%ZISH(BGPDIR,BGPFILE,"R")
  1.  I Y W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",BGPDIR,BGPFILE,"'." G EOJ
  1.  KILL ^TMP("BGPUPL",$J)
  1.  F I=1:1 U IO R X:DTIME S X=$$STRIP(X) Q:X=""  S ^TMP("BGPUPL",$J,BGPC,0)=X,BGPC=BGPC+1 Q:$$STATUS^%ZISH=-1
  1.  D ^%ZISC
  1.  W !!,"All done reading file",!
  1. PROC ;
  1.  I $P(BGPFILE,".",2)["HE" D PROCHE Q
  1.  I $P(BGPFILE,".",2)["EL" D PROCEL Q
  1.  I $P(BGPFILE,".",2)["PED" D PROCPED Q
  1.  I $P(BGPFILE,".",2)["EO" D PROCEO^BGP1ULF1 Q
  1.  ;I $P(BGPFILE,".",2)["ON" D PROCON Q
  1.  W !,"Processing",!
  1.  S BGP0=$P($G(^TMP("BGPUPL",$J,1,0)),"|",9)
  1.  S BGPG=$P($G(^TMP("BGPUPL",$J,1,0)),"|")
  1.  F X=1:1:14 S Y="BGP"_X,@Y=$P(BGP0,U,X)
  1.  ;find existing entry and if exists, delete it
  1.  S (X,BGPOIEN)=0 F  S X=$O(^BGPGPDCB(X)) Q:X'=+X  D
  1.  .I '$D(^BGPGPDCB(X,0)) K ^BGPGPDCB(X) Q
  1.  .S Y=^BGPGPDCB(X,0)
  1.  .Q:$P(Y,U)'=BGP1
  1.  .Q:$P(Y,U,2)'=BGP2
  1.  .Q:$P(Y,U,3)'=BGP3
  1.  .Q:$P(Y,U,4)'=BGP4
  1.  .Q:$P(Y,U,5)'=BGP5
  1.  .Q:$P(Y,U,6)'=BGP6
  1.  .Q:$P(Y,U,8)'=BGP8
  1.  .Q:$P(Y,U,9)'=BGP9
  1.  .Q:$P(Y,U,10)'=BGP10
  1.  .Q:$P(Y,U,11)'=BGP11
  1.  .Q:$P(Y,U,12)'=BGP12
  1.  .Q:$P(Y,U,14)'=BGP14
  1.  .S BGPOIEN=X
  1.  D ^XBFMK
  1.  I BGPOIEN S DA=BGPOIEN,DIK="^BGPGPDCB(" D ^DIK S DA=BGPOIEN,DIK="^BGPGPDPB(" D ^DIK S DA=BGPOIEN,DIK="^BGPGPDBB(" D ^DIK
  1.  ;add entry
  1.  L +^BGPGPDCB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  L +^BGPGPDPB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  L +^BGPGPDBB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  D GETIEN^BGP1UTL
  1.  I 'BGPIEN W !!,"error in file creation...call programmer." D EOJ Q
  1. CY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90545.03,DIC="^BGPGPDCB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPGPDCB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPGPDCB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPGPDCB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPGPDCB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPGPDCB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPGPDCB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPGPDCB(" D IX1^DIK
  1. PY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90545.04,DIC="^BGPGPDPB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPGPDPB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPGPDPB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPGPDPB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPGPDPB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPGPDPB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPGPDPB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPGPDPB(" D IX1^DIK
  1. BY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90545.05,DIC="^BGPGPDBB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPGPDBB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPGPDBB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPGPDBB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPGPDBB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPGPDBB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPGPDBB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPGPDBB(" D IX1^DIK
  1.  W !,"Data uploaded."
  1.  D EOJ
  1.  Q
  1. EOJ ;EP
  1.  L -^BGPGPDCB
  1.  L -^BGPGPDPB
  1.  L -^BGPGPDBB
  1.  L -^BGPHEDCB
  1.  L -^BGPHEDPB
  1.  L -^BGPHEDBB
  1.  L -^BGPELDCB
  1.  L -^BGPELDPB
  1.  L -^BGPELDBB
  1.  L -^BGPPEDCB
  1.  L -^BGPPEDPB
  1.  L -^BGPPEDBB
  1.  L -^BGPEOCB
  1.  L -^BGPEOPB
  1.  L -^BGPEOBB
  1.  D EOP^BGP1DH
  1.  K IOPAR
  1.  D HOME^%ZIS
  1.  K X,X1,X2,X3,X4,X5,X6
  1.  K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
  1.  K N,N1,N2,N3,N4,N5,N6
  1.  K DIC,DA,X,Y,%Y,%,BGPJ,BGPX,BGPTEXT,BGPLINE,BGP
  1.  Q
  1. STRIP(Z) ;REMOVE CONTROLL CHARACTERS
  1.  NEW I
  1.  F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_""_$E(Z,I+1,999)
  1.  Q Z
  1.  ;
  1. PROCHE ;
  1.  W !,"Processing",!
  1.  S BGP0=$P($G(^TMP("BGPUPL",$J,1,0)),"|",9)
  1.  S BGPG=$P($G(^TMP("BGPUPL",$J,1,0)),"|")
  1.  F X=1:1:14 S Y="BGP"_X,@Y=$P(BGP0,U,X)
  1.  ;find existing entry and if exists, delete it
  1.  S (X,BGPOIEN)=0 F  S X=$O(^BGPHEDCB(X)) Q:X'=+X  D
  1.  .I '$D(^BGPHEDCB(X,0)) K ^BGPHEDCB(X) Q
  1.  .S Y=^BGPHEDCB(X,0)
  1.  .Q:$P(Y,U)'=BGP1
  1.  .Q:$P(Y,U,2)'=BGP2
  1.  .Q:$P(Y,U,3)'=BGP3
  1.  .Q:$P(Y,U,4)'=BGP4
  1.  .Q:$P(Y,U,5)'=BGP5
  1.  .Q:$P(Y,U,6)'=BGP6
  1.  .Q:$P(Y,U,8)'=BGP8
  1.  .Q:$P(Y,U,9)'=BGP9
  1.  .Q:$P(Y,U,10)'=BGP10
  1.  .Q:$P(Y,U,11)'=BGP11
  1.  .Q:$P(Y,U,12)'=BGP12
  1.  .Q:$P(Y,U,14)'=BGP14
  1.  .S BGPOIEN=X
  1.  D ^XBFMK
  1.  I BGPOIEN S DA=BGPOIEN,DIK="^BGPHEDCB(" D ^DIK S DA=BGPOIEN,DIK="^BGPHEDPB(" D ^DIK S DA=BGPOIEN,DIK="^BGPHEDBB(" D ^DIK
  1.  ;add entry
  1.  L +^BGPHEDCB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  L +^BGPHEDPB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  L +^BGPHEDBB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  D GETIEN^BGP1HUTL
  1.  I 'BGPIEN W !!,"error in file creation...call programmer." D EOJ Q
  1. HECY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90546.03,DIC="^BGPHEDCB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPHEDCB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPHEDCB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPHEDCB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPHEDCB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPHEDCB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPHEDCB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPHEDCB(" D IX1^DIK
  1. HEPY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90546.04,DIC="^BGPHEDPB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPHEDPB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPHEDPB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPHEDPB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPHEDPB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPHEDPB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPHEDPB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPHEDPB(" D IX1^DIK
  1. HEBY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90546.05,DIC="^BGPHEDBB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPHEDBB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPHEDBB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPHEDBB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPHEDBB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPHEDBB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPHEDBB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPHEDBB(" D IX1^DIK
  1.  W !,"Data uploaded."
  1.  D EOJ
  1.  Q
  1.  ;
  1. PROCEL ;
  1.  W !,"Processing",!
  1.  S BGP0=$P($G(^TMP("BGPUPL",$J,1,0)),"|",9)
  1.  S BGPG=$P($G(^TMP("BGPUPL",$J,1,0)),"|")
  1.  F X=1:1:14 S Y="BGP"_X,@Y=$P(BGP0,U,X)
  1.  ;find existing entry and if exists, delete it
  1.  S (X,BGPOIEN)=0 F  S X=$O(^BGPELDCB(X)) Q:X'=+X  D
  1.  .I '$D(^BGPELDCB(X,0)) K ^BGPELDCB(X) Q
  1.  .S Y=^BGPELDCB(X,0)
  1.  .Q:$P(Y,U)'=BGP1
  1.  .Q:$P(Y,U,2)'=BGP2
  1.  .Q:$P(Y,U,3)'=BGP3
  1.  .Q:$P(Y,U,4)'=BGP4
  1.  .Q:$P(Y,U,5)'=BGP5
  1.  .Q:$P(Y,U,6)'=BGP6
  1.  .Q:$P(Y,U,8)'=BGP8
  1.  .Q:$P(Y,U,9)'=BGP9
  1.  .Q:$P(Y,U,10)'=BGP10
  1.  .Q:$P(Y,U,11)'=BGP11
  1.  .Q:$P(Y,U,12)'=BGP12
  1.  .Q:$P(Y,U,14)'=BGP14
  1.  .S BGPOIEN=X
  1.  D ^XBFMK
  1.  I BGPOIEN S DA=BGPOIEN,DIK="^BGPELDCB(" D ^DIK S DA=BGPOIEN,DIK="^BGPELDPB(" D ^DIK S DA=BGPOIEN,DIK="^BGPELDBB(" D ^DIK
  1.  ;add entry
  1.  L +^BGPELDCB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  L +^BGPELDPB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  L +^BGPELDBB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  D GETIEN^BGP1EUTL
  1.  I 'BGPIEN W !!,"error in file creation...call programmer." D EOJ Q
  1. ELCY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90546.03,DIC="^BGPELDCB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPELDCB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPELDCB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPELDCB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPELDCB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPELDCB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPELDCB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPELDCB(" D IX1^DIK
  1. ELPY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90546.04,DIC="^BGPELDPB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPELDPB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPELDPB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPELDPB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPELDPB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPELDPB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPELDPB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPELDPB(" D IX1^DIK
  1. ELBY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90546.05,DIC="^BGPELDBB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPELDBB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPELDBB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPELDBB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPELDBB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPELDBB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPELDBB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPELDBB(" D IX1^DIK
  1.  W !,"Data uploaded."
  1.  D EOJ
  1.  Q
  1.  ;
  1. PROCPED ;
  1.  W !,"Processing",!
  1.  S BGP0=$P($G(^TMP("BGPUPL",$J,1,0)),"|",9)
  1.  S BGPG=$P($G(^TMP("BGPUPL",$J,1,0)),"|")
  1.  F X=1:1:14 S Y="BGP"_X,@Y=$P(BGP0,U,X)
  1.  ;find existing entry and if exists, delete it
  1.  S (X,BGPOIEN)=0 F  S X=$O(^BGPPEDCB(X)) Q:X'=+X  D
  1.  .I '$D(^BGPPEDCB(X,0)) K ^BGPPEDCB(X) Q
  1.  .S Y=^BGPPEDCB(X,0)
  1.  .Q:$P(Y,U)'=BGP1
  1.  .Q:$P(Y,U,2)'=BGP2
  1.  .Q:$P(Y,U,3)'=BGP3
  1.  .Q:$P(Y,U,4)'=BGP4
  1.  .Q:$P(Y,U,5)'=BGP5
  1.  .Q:$P(Y,U,6)'=BGP6
  1.  .Q:$P(Y,U,7)'=BGP7
  1.  .Q:$P(Y,U,8)'=BGP8
  1.  .Q:$P(Y,U,9)'=BGP9
  1.  .Q:$P(Y,U,10)'=BGP10
  1.  .Q:$P(Y,U,11)'=BGP11
  1.  .Q:$P(Y,U,12)'=BGP12
  1.  .S BGPOIEN=X
  1.  D ^XBFMK
  1.  I BGPOIEN S DA=BGPOIEN,DIK="^BGPPEDCB(" D ^DIK S DA=BGPOIEN,DIK="^BGPPEDPB(" D ^DIK S DA=BGPOIEN,DIK="^BGPPEDBB(" D ^DIK
  1.  ;add entry
  1.  L +^BGPPEDCB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  L +^BGPPEDPB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  L +^BGPPEDBB:10 I '$T W !!,"unable to lock global. TRY LATER" D EOJ Q
  1.  D GETIEN^BGP1PUTL
  1.  I 'BGPIEN W !!,"error in file creation...call programmer." D EOJ Q
  1. PEDCY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90545.12,DIC="^BGPPEDCB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPPEDCB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPPEDCB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPPEDCB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPPEDCB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPPEDCB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPPEDCB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPPEDCB(" D IX1^DIK
  1. PEDPY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90545.13,DIC="^BGPPEDPB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPPEDPB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPPEDPB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPPEDPB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPPEDPB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPPEDPB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPPEDPB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPPEDPB(" D IX1^DIK
  1. PEDBY ;
  1.  S DINUM=BGPIEN,X=$P(BGP0,U),DLAYGO=90545.14,DIC="^BGPPEDBB(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G EOJ
  1.  S BGPIEN=+Y
  1.  D ^XBFMK
  1.  S X=0 F  S X=$O(^TMP("BGPUPL",$J,X)) Q:X'=+X  S V=^TMP("BGPUPL",$J,X,0) D
  1.  .Q:$P(V,"|")'="BGPPEDBB"
  1.  .S V=$P(V,"|",2,9999)
  1.  .S N=$P(V,"|"),N2=$P(V,"|",2),N3=$P(V,"|",3),N4=$P(V,"|",4),N5=$P(V,"|",5),D=$P(V,"|",8)
  1.  .I N5]"" S ^BGPPEDBB(BGPIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^BGPPEDBB(BGPIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^BGPPEDBB(BGPIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^BGPPEDBB(BGPIEN,N,N2)=D Q
  1.  .I N]"" S ^BGPPEDBB(BGPIEN,N)=D
  1.  .Q
  1.  S DA=BGPIEN,DIK="^BGPPEDBB(" D IX1^DIK
  1.  W !,"Data uploaded."
  1.  D EOJ
  1.  Q