- BGPDUP ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
- ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
- ;
- ;
- W:$D(IOF) @IOF
- W !,"This option is used to upload a SU's GPRA data.",!,"You must specify the directory in which the GPRA data file resides",!,"and then enter the filename of the GPRA data.",!
- FILE ;upload global
- DIR ;
- K DIR
- S BGPDIR=""
- S DIR(0)="F^3:50",DIR("A")="Enter directory path (i.e. /usr/spool/uucppublic/)" K DA D ^DIR K DIR
- I $D(DIRUT) W !!,"Directory not entered!! Bye." G XIT
- S BGPDIR=Y
- S BGPFILE=""
- S DIR(0)="F^2:30",DIR("A")="Enter filename w /ext (i.e. BG101201.5)" K DA D ^DIR K DIR
- G:$D(DIRUT) DIR
- S BGPFILE=Y
- W !,"Directory=",BGPDIR," ","File=",BGPFILE
- READF ;read file
- NEW Y,X,I,BGPC
- S BGPC=1
- S Y=$$OPEN^%ZISH(BGPDIR,BGPFILE,"R")
- I Y W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",BGPDIR,BGPFILE,"'." G XIT
- KILL ^TMP("BGPUPL",$J)
- 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
- D ^%ZISC
- W !!,"All done reading file",!
- PROC ;
- W !,"Processing",!
- S BGP0=$P($G(^TMP("BGPUPL",$J,1,0)),"|",8)
- ;I $L(BGP0,U)'=6 W "error in data" H 3 G XIT
- F X=1:1:9 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(^BGPD(X)) Q:X'=+X S Y=^BGPD(X,0) D
- .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
- .S BGPOIEN=X
- D ^XBFMK
- I BGPOIEN S DA=BGPOIEN,DIK="^BGPD(" D ^DIK
- ;add entry
- S X=$P(BGP0,U),DLAYGO=90240.01,DIC="^BGPD(",DIC(0)="L"
- K DD,D0,DO
- D FILE^DICN
- I Y=-1 W !,"error uploading file......" H 4 G XIT
- 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
- .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 ^BGPD(BGPIEN,N,N2,N3,N4,N5)=D Q
- .I N4]"" S ^BGPD(BGPIEN,N,N2,N3,N4)=D Q
- .I N3]"" S ^BGPD(BGPIEN,N,N2,N3)=D Q
- .I N2]"" S ^BGPD(BGPIEN,N,N2)=D Q
- .I N]"" S ^BGPD(BGPIEN,N)=D
- .Q
- S DA=BGPIEN,DIK="^BGPD(" D IX1^DIK
- W !,"Data uploaded."
- D XIT
- Q
- XIT ;
- D EOP^BGPDH
- K IOPAR
- D HOME^%ZIS
- D EN^XBVK("BGP")
- K X,X1,X2,X3,X4,X5,X6
- 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
- K N,N1,N2,N3,N4,N5,N6
- K DIC,DA,X,Y,%Y,%,BGPJ,BGPX,BGPTEXT,BGPLINE,BGP
- Q
- STRIP(Z) ;REMOVE CONTROLL CHARACTERS
- NEW I
- F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_""_$E(Z,I+1,999)
- Q Z
- ;
- ;
- BGPDUP ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
- +1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
- +2 ;
- +3 ;
- +4 IF $DATA(IOF)
- WRITE @IOF
- +5 WRITE !,"This option is used to upload a SU's GPRA data.",!,"You must specify the directory in which the GPRA data file resides",!,"and then enter the filename of the GPRA data.",!
- FILE ;upload global
- DIR ;
- +1 KILL DIR
- +2 SET BGPDIR=""
- +3 SET DIR(0)="F^3:50"
- SET DIR("A")="Enter directory path (i.e. /usr/spool/uucppublic/)"
- KILL DA
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)
- WRITE !!,"Directory not entered!! Bye."
- GOTO XIT
- +5 SET BGPDIR=Y
- +6 SET BGPFILE=""
- +7 SET DIR(0)="F^2:30"
- SET DIR("A")="Enter filename w /ext (i.e. BG101201.5)"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF $DATA(DIRUT)
- GOTO DIR
- +9 SET BGPFILE=Y
- +10 WRITE !,"Directory=",BGPDIR," ","File=",BGPFILE
- READF ;read file
- +1 NEW Y,X,I,BGPC
- +2 SET BGPC=1
- +3 SET Y=$$OPEN^%ZISH(BGPDIR,BGPFILE,"R")
- +4 IF Y
- WRITE !,*7,"CANNOT OPEN (OR ACCESS) FILE '",BGPDIR,BGPFILE,"'."
- GOTO XIT
- +5 KILL ^TMP("BGPUPL",$JOB)
- +6 FOR I=1:1
- USE IO
- READ X:DTIME
- SET X=$$STRIP(X)
- IF X=""
- QUIT
- SET ^TMP("BGPUPL",$JOB,BGPC,0)=X
- SET BGPC=BGPC+1
- IF $$STATUS^%ZISH=-1
- QUIT
- +7 DO ^%ZISC
- +8 WRITE !!,"All done reading file",!
- PROC ;
- +1 WRITE !,"Processing",!
- +2 SET BGP0=$PIECE($GET(^TMP("BGPUPL",$JOB,1,0)),"|",8)
- +3 ;I $L(BGP0,U)'=6 W "error in data" H 3 G XIT
- +4 FOR X=1:1:9
- 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(^BGPD(X))
- IF X'=+X
- QUIT
- SET Y=^BGPD(X,0)
- Begin DoDot:1
- +7 IF $PIECE(Y,U)'=BGP1
- QUIT
- +8 IF $PIECE(Y,U,2)'=BGP2
- QUIT
- +9 IF $PIECE(Y,U,3)'=BGP3
- QUIT
- +10 IF $PIECE(Y,U,4)'=BGP4
- QUIT
- +11 IF $PIECE(Y,U,5)'=BGP5
- QUIT
- +12 IF $PIECE(Y,U,6)'=BGP6
- QUIT
- +13 IF $PIECE(Y,U,8)'=BGP8
- QUIT
- +14 IF $PIECE(Y,U,9)'=+BGP9
- QUIT
- +15 SET BGPOIEN=X
- End DoDot:1
- +16 DO ^XBFMK
- +17 IF BGPOIEN
- SET DA=BGPOIEN
- SET DIK="^BGPD("
- DO ^DIK
- +18 ;add entry
- +19 SET X=$PIECE(BGP0,U)
- SET DLAYGO=90240.01
- SET DIC="^BGPD("
- SET DIC(0)="L"
- +20 KILL DD,D0,DO
- +21 DO FILE^DICN
- +22 IF Y=-1
- WRITE !,"error uploading file......"
- HANG 4
- GOTO XIT
- +23 SET BGPIEN=+Y
- +24 DO ^XBFMK
- +25 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
- +26 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)
- +27 IF N5]""
- SET ^BGPD(BGPIEN,N,N2,N3,N4,N5)=D
- QUIT
- +28 IF N4]""
- SET ^BGPD(BGPIEN,N,N2,N3,N4)=D
- QUIT
- +29 IF N3]""
- SET ^BGPD(BGPIEN,N,N2,N3)=D
- QUIT
- +30 IF N2]""
- SET ^BGPD(BGPIEN,N,N2)=D
- QUIT
- +31 IF N]""
- SET ^BGPD(BGPIEN,N)=D
- +32 QUIT
- End DoDot:1
- +33 SET DA=BGPIEN
- SET DIK="^BGPD("
- DO IX1^DIK
- +34 WRITE !,"Data uploaded."
- +35 DO XIT
- +36 QUIT
- XIT ;
- +1 DO EOP^BGPDH
- +2 KILL IOPAR
- +3 DO HOME^%ZIS
- +4 DO EN^XBVK("BGP")
- +5 KILL X,X1,X2,X3,X4,X5,X6
- +6 KILL 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
- +7 KILL N,N1,N2,N3,N4,N5,N6
- +8 KILL DIC,DA,X,Y,%Y,%,BGPJ,BGPX,BGPTEXT,BGPLINE,BGP
- +9 QUIT
- STRIP(Z) ;REMOVE CONTROLL CHARACTERS
- +1 NEW I
- +2 FOR I=1:1:$LENGTH(Z)
- IF (32>$ASCII($EXTRACT(Z,I)))
- SET Z=$EXTRACT(Z,1,I-1)_""_$EXTRACT(Z,I+1,999)
- +3 QUIT Z
- +4 ;
- +5 ;
