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

CIMGAGPU.m

Go to the documentation of this file. 
  1. CIMGAGPU ; CMI/TUCSON/LAB - NO DESCRIPTION PROVIDED ;  
  1.  ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  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.",!
  1. FILE ;upload global
  1. DIR ;
  1.  K DIR
  1.  S CIMDIR=""
  1.  S DIR(0)="F^3:30",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 XIT
  1.  S CIMDIR=Y
  1.  S CIMFILE=""
  1.  S DIR(0)="F^2:30",DIR("A")="Enter filename w /ext (i.e. G101201.5)" K DA D ^DIR K DIR
  1.  G:$D(DIRUT) DIR
  1.  S CIMFILE=Y
  1.  W !,"Directory=",CIMDIR,"  ","File=",CIMFILE
  1. READF ;read file
  1.  NEW Y,X,I,CIMC
  1.  S CIMC=1
  1.  S Y=$$OPEN^%ZISH(CIMDIR,CIMFILE,"R")
  1.  I Y W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",CIMDIR,CIMFILE,"'." G XIT
  1.  KILL ^TMP("CIMGPRA",$J)
  1.  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
  1.  D ^%ZISC
  1.  W !!,"All done reading file",!
  1. PROC ;
  1.  W !,"Processing",!
  1.  S CIM0=$P($G(^TMP("CIMGPRA",$J,1,0)),"|",8)
  1.  I $L(CIM0,U)'=6 W "error in data" H 3 G XIT
  1.  ;find existing entry and if exists, delete it
  1.  S (X,CIMOIEN)=0 F  S X=$O(^CIMAGP(X)) Q:X'=+X  S Y=^CIMAGP(X,0) I Y=CIM0 S CIMOIEN=X
  1.  D ^XBFMK
  1.  I CIMOIEN S DA=CIMOIEN,DIK="^CIMAGP(" D ^DIK
  1.  ;add entry
  1.  S X=$P(CIM0,U),DLAYGO=19255.01,DIC="^CIMAGP(",DIC(0)="L"
  1.  K DD,D0,DO
  1.  D FILE^DICN
  1.  I Y=-1 W !,"error uploading file......" H 4 G XIT
  1.  S CIMIEN=+Y
  1.  D ^XBFMK
  1.  ;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
  1.  S X=0 F  S X=$O(^TMP("CIMGPRA",$J,X)) Q:X'=+X  S V=^TMP("CIMGPRA",$J,X,0) D
  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 ^CIMAGP(CIMIEN,N,N2,N3,N4,N5)=D Q
  1.  .I N4]"" S ^CIMAGP(CIMIEN,N,N2,N3,N4)=D Q
  1.  .I N3]"" S ^CIMAGP(CIMIEN,N,N2,N3)=D Q
  1.  .I N2]"" S ^CIMAGP(CIMIEN,N,N2)=D Q
  1.  .I N]"" S ^CIMAGP(CIMIEN,N)=D
  1.  .Q
  1.  S DA=CIMIEN,DIK="^CIMAGP(" D IX1^DIK
  1.  W !,"Data uploaded."
  1.  D XIT
  1.  Q
  1. XIT ;
  1.  K IOPAR
  1.  D HOME^%ZIS
  1.  D EN^XBVK("CIM")
  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,%,CIMJ,CIMX,CIMTEXT,CIMLINE,CIM
  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.  ;
  1. V ; GET VERSION
  1.  S CIM("VERSION")="1.0  January, 2000"
  1.  I $G(CIMTEXT)="" S CIMTEXT="TEXT",CIMLINE=3 G PRINT
  1.  S CIMTEXT="TEXT"_CIMTEXT
  1.  F CIMJ=1:1 S CIMX=$T(@CIMTEXT+CIMJ),CIMX=$P(CIMX,";;",2) Q:CIMX="QUIT"!(CIMX="")  S CIMLINE=CIMJ
  1. PRINT W:$D(IOF) @IOF
  1.  F CIMJ=1:1:CIMLINE S CIMX=$T(@CIMTEXT+CIMJ),CIMX=$P(CIMX,";;",2) W !?80-$L(CIMX)\2,CIMX K CIMX
  1.  W !?80-(8+$L(CIM("VERSION")))/2,"Version ",CIM("VERSION")
  1. 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")
  1. TEXT ;
  1.  ;;***************************************************
  1.  ;;**   Aberdeen Area GPRA Data Reporting System    **
  1.  ;;***************************************************
  1.  ;;QUIT