CIMGAGPU ; CMI/TUCSON/LAB - NO DESCRIPTION PROVIDED ;
;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
;
;
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 files resides",!,"and then enter the filename of the GPRA data.",!
FILE ;upload global
DIR ;
K DIR
S CIMDIR=""
S DIR(0)="F^3:30",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 CIMDIR=Y
S CIMFILE=""
S DIR(0)="F^2:30",DIR("A")="Enter filename w /ext (i.e. G101201.5)" K DA D ^DIR K DIR
G:$D(DIRUT) DIR
S CIMFILE=Y
W !,"Directory=",CIMDIR," ","File=",CIMFILE
READF ;read file
NEW Y,X,I,CIMC
S CIMC=1
S Y=$$OPEN^%ZISH(CIMDIR,CIMFILE,"R")
I Y W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",CIMDIR,CIMFILE,"'." G XIT
KILL ^TMP("CIMGPRA",$J)
F I=1:1 U IO R X:DTIME S X=$$STRIP(X) S ^TMP("CIMGPRA",$J,CIMC,0)=X,CIMC=CIMC+1 Q:$$STATUS^%ZISH=-1
D ^%ZISC
W !!,"All done reading file",!
PROC ;
W !,"Processing",!
S CIM0=$P($G(^TMP("CIMGPRA",$J,1,0)),"|",8)
I $L(CIM0,U)'=6 W "error in data" H 3 G XIT
;find existing entry and if exists, delete it
S (X,CIMOIEN)=0 F S X=$O(^CIMAGP(X)) Q:X'=+X S Y=^CIMAGP(X,0) I Y=CIM0 S CIMOIEN=X
D ^XBFMK
I CIMOIEN S DA=CIMOIEN,DIK="^CIMAGP(" D ^DIK
;add entry
S X=$P(CIM0,U),DLAYGO=19255.01,DIC="^CIMAGP(",DIC(0)="L"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !,"error uploading file......" H 4 G XIT
S CIMIEN=+Y
D ^XBFMK
;S X=0 F S X=$O(^TMP("CIMGPRA",$J,X)) Q:X'=+X S V=^TMP("CIMGPRA",$J,X,0) S N=$P(V,"|"),D=$P(V,"|",2) I N]"" S ^CIMAGP(CIMIEN,N)=D
S X=0 F S X=$O(^TMP("CIMGPRA",$J,X)) Q:X'=+X S V=^TMP("CIMGPRA",$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 ^CIMAGP(CIMIEN,N,N2,N3,N4,N5)=D Q
.I N4]"" S ^CIMAGP(CIMIEN,N,N2,N3,N4)=D Q
.I N3]"" S ^CIMAGP(CIMIEN,N,N2,N3)=D Q
.I N2]"" S ^CIMAGP(CIMIEN,N,N2)=D Q
.I N]"" S ^CIMAGP(CIMIEN,N)=D
.Q
S DA=CIMIEN,DIK="^CIMAGP(" D IX1^DIK
W !,"Data uploaded."
D XIT
Q
XIT ;
K IOPAR
D HOME^%ZIS
D EN^XBVK("CIM")
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,%,CIMJ,CIMX,CIMTEXT,CIMLINE,CIM
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
;
;
BANNER ;EP
V ; GET VERSION
S CIM("VERSION")="1.0 January, 2000"
I $G(CIMTEXT)="" S CIMTEXT="TEXT",CIMLINE=3 G PRINT
S CIMTEXT="TEXT"_CIMTEXT
F CIMJ=1:1 S CIMX=$T(@CIMTEXT+CIMJ),CIMX=$P(CIMX,";;",2) Q:CIMX="QUIT"!(CIMX="") S CIMLINE=CIMJ
PRINT W:$D(IOF) @IOF
F CIMJ=1:1:CIMLINE S CIMX=$T(@CIMTEXT+CIMJ),CIMX=$P(CIMX,";;",2) W !?80-$L(CIMX)\2,CIMX K CIMX
W !?80-(8+$L(CIM("VERSION")))/2,"Version ",CIM("VERSION")
SITE G XIT:'$D(DUZ(2)) G:'DUZ(2) XIT S CIM("SITE")=$P(^DIC(4,DUZ(2),0),"^") W !!?80-$L(CIM("SITE"))\2,CIM("SITE")
TEXT ;
;;***************************************************
;;** Aberdeen Area GPRA Data Reporting System **
;;***************************************************
;;QUIT
CIMGAGPU ; CMI/TUCSON/LAB - NO DESCRIPTION PROVIDED ;
+1 ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
+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 files resides",!,"and then enter the filename of the GPRA data.",!
FILE ;upload global
DIR ;
+1 KILL DIR
+2 SET CIMDIR=""
+3 SET DIR(0)="F^3:30"
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 CIMDIR=Y
+6 SET CIMFILE=""
+7 SET DIR(0)="F^2:30"
SET DIR("A")="Enter filename w /ext (i.e. G101201.5)"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO DIR
+9 SET CIMFILE=Y
+10 WRITE !,"Directory=",CIMDIR," ","File=",CIMFILE
READF ;read file
+1 NEW Y,X,I,CIMC
+2 SET CIMC=1
+3 SET Y=$$OPEN^%ZISH(CIMDIR,CIMFILE,"R")
+4 IF Y
WRITE !,*7,"CANNOT OPEN (OR ACCESS) FILE '",CIMDIR,CIMFILE,"'."
GOTO XIT
+5 KILL ^TMP("CIMGPRA",$JOB)
+6 FOR I=1:1
USE IO
READ X:DTIME
SET X=$$STRIP(X)
SET ^TMP("CIMGPRA",$JOB,CIMC,0)=X
SET CIMC=CIMC+1
IF $$STATUS^%ZISH=-1
QUIT
+7 DO ^%ZISC
+8 WRITE !!,"All done reading file",!
PROC ;
+1 WRITE !,"Processing",!
+2 SET CIM0=$PIECE($GET(^TMP("CIMGPRA",$JOB,1,0)),"|",8)
+3 IF $LENGTH(CIM0,U)'=6
WRITE "error in data"
HANG 3
GOTO XIT
+4 ;find existing entry and if exists, delete it
+5 SET (X,CIMOIEN)=0
FOR
SET X=$ORDER(^CIMAGP(X))
IF X'=+X
QUIT
SET Y=^CIMAGP(X,0)
IF Y=CIM0
SET CIMOIEN=X
+6 DO ^XBFMK
+7 IF CIMOIEN
SET DA=CIMOIEN
SET DIK="^CIMAGP("
DO ^DIK
+8 ;add entry
+9 SET X=$PIECE(CIM0,U)
SET DLAYGO=19255.01
SET DIC="^CIMAGP("
SET DIC(0)="L"
+10 KILL DD,D0,DO
+11 DO FILE^DICN
+12 IF Y=-1
WRITE !,"error uploading file......"
HANG 4
GOTO XIT
+13 SET CIMIEN=+Y
+14 DO ^XBFMK
+15 ;S X=0 F S X=$O(^TMP("CIMGPRA",$J,X)) Q:X'=+X S V=^TMP("CIMGPRA",$J,X,0) S N=$P(V,"|"),D=$P(V,"|",2) I N]"" S ^CIMAGP(CIMIEN,N)=D
+16 SET X=0
FOR
SET X=$ORDER(^TMP("CIMGPRA",$JOB,X))
IF X'=+X
QUIT
SET V=^TMP("CIMGPRA",$JOB,X,0)
Begin DoDot:1
+17 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)
+18 IF N5]""
SET ^CIMAGP(CIMIEN,N,N2,N3,N4,N5)=D
QUIT
+19 IF N4]""
SET ^CIMAGP(CIMIEN,N,N2,N3,N4)=D
QUIT
+20 IF N3]""
SET ^CIMAGP(CIMIEN,N,N2,N3)=D
QUIT
+21 IF N2]""
SET ^CIMAGP(CIMIEN,N,N2)=D
QUIT
+22 IF N]""
SET ^CIMAGP(CIMIEN,N)=D
+23 QUIT
End DoDot:1
+24 SET DA=CIMIEN
SET DIK="^CIMAGP("
DO IX1^DIK
+25 WRITE !,"Data uploaded."
+26 DO XIT
+27 QUIT
XIT ;
+1 KILL IOPAR
+2 DO HOME^%ZIS
+3 DO EN^XBVK("CIM")
+4 KILL X,X1,X2,X3,X4,X5,X6
+5 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
+6 KILL N,N1,N2,N3,N4,N5,N6
+7 KILL DIC,DA,X,Y,%Y,%,CIMJ,CIMX,CIMTEXT,CIMLINE,CIM
+8 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 ;
BANNER ;EP
V ; GET VERSION
+1 SET CIM("VERSION")="1.0 January, 2000"
+2 IF $GET(CIMTEXT)=""
SET CIMTEXT="TEXT"
SET CIMLINE=3
GOTO PRINT
+3 SET CIMTEXT="TEXT"_CIMTEXT
+4 FOR CIMJ=1:1
SET CIMX=$TEXT(@CIMTEXT+CIMJ)
SET CIMX=$PIECE(CIMX,";;",2)
IF CIMX="QUIT"!(CIMX="")
QUIT
SET CIMLINE=CIMJ
PRINT IF $DATA(IOF)
WRITE @IOF
+1 FOR CIMJ=1:1:CIMLINE
SET CIMX=$TEXT(@CIMTEXT+CIMJ)
SET CIMX=$PIECE(CIMX,";;",2)
WRITE !?80-$LENGTH(CIMX)\2,CIMX
KILL CIMX
+2 WRITE !?80-(8+$LENGTH(CIM("VERSION")))/2,"Version ",CIM("VERSION")
SITE IF '$DATA(DUZ(2))
GOTO XIT
IF 'DUZ(2)
GOTO XIT
SET CIM("SITE")=$PIECE(^DIC(4,DUZ(2),0),"^")
WRITE !!?80-$LENGTH(CIM("SITE"))\2,CIM("SITE")
TEXT ;
+1 ;;***************************************************
+2 ;;** Aberdeen Area GPRA Data Reporting System **
+3 ;;***************************************************
+4 ;;QUIT
