| 1 | MCDBELM ;WISC/DCB-save and load util. ;8/15/96 09:52
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | Q
|
|---|
| 4 | RTNELM(FILE,REC,FIELDS,EXC,DATA,TYPE,USER,TEMP,ERROR) ;RTN the elements in an array
|
|---|
| 5 | N Y,X,BACK,FILES,FLDS,RECS,XFILE,XREC,XFLD,HOLD,FLD,TOTAL
|
|---|
| 6 | N COUNT,COUNT2,XTEMP,XTFILE,TMP,TMP1,TMP2 S ERROR=""
|
|---|
| 7 | S FILE=$$RTNFILE(FILE,FIELDS) Q:$E(FILE,1)=" " FILE
|
|---|
| 8 | F TOTAL=1:1:255 S XFILE=$P(FILE,U,TOTAL),XREC=$P(REC,U,TOTAL),XFLD=$P(FIELDS,U,TOTAL) Q:(XREC_XFLD)="" S TEMP(TOTAL)=XFILE_U_XREC_U_XFLD
|
|---|
| 9 | S TOTAL=TOTAL-1
|
|---|
| 10 | F COUNT=1:1:TOTAL Q:ERROR'="" D
|
|---|
| 11 | .S XTEMP=TEMP(COUNT) S:COUNT>1 BACK=TEMP(COUNT-1)
|
|---|
| 12 | .S XFILE=+$P(XTEMP,U),XREC=+$P(XTEMP,U,2),XFLD=$P(XTEMP,U,3)
|
|---|
| 13 | .I XFILE<1 S ERROR=" 2.1 - (Sub)File is less than 1 or null" Q
|
|---|
| 14 | .I XREC<1 S ERROR=" 2.2 - (Sub)Record is less than 1 or null" Q
|
|---|
| 15 | .I '$D(^DD(XFILE)) S ERROR=" 2.3 - (Sub)File is not define" Q
|
|---|
| 16 | .I COUNT>1 S HOLD=+$P($G(^DD(+$P(BACK,U,1),+$P(BACK,U,3),0)),U,2) I XFILE'=HOLD S ERROR=" 2.4 - Subfile missing in Data Dictionary" Q
|
|---|
| 17 | .F COUNT2=1:1:255 S FLD=$P(XFLD,";",COUNT2) Q:FLD=""!(ERROR'="") D
|
|---|
| 18 | ..I +FLD=0 S ERROR=" 2.5 - (Sub)Field is zero or null"
|
|---|
| 19 | ..S:'$D(^DD(XFILE,FLD)) ERROR=" 2.6 - (Sub)Field is not defined in DD"
|
|---|
| 20 | ..I COUNT=TOTAL S TEMP("FLD",FLD)=$P(DATA,"|",COUNT2),TEMP("TYP",FLD)=$P(TYPE,U,COUNT2),TEMP("FLDNAME",FLD)=$P(^DD(XFILE,FLD,0),U,1)
|
|---|
| 21 | ..S (TEMP("EXC",FLD),X)=$G(EXC(FLD))
|
|---|
| 22 | ..D:X ^DIM S:'$D(X) ERROR=" 2.7 Syntax error in the Execption Code"
|
|---|
| 23 | S TEMP("X")=$P(TEMP(TOTAL),U,3)
|
|---|
| 24 | S TEMP("XF")=$P(TEMP(TOTAL),U,1)
|
|---|
| 25 | S TEMP("USER")=+$G(USER)
|
|---|
| 26 | S TEMP("DIC")=$$RTNDIE(.TEMP)
|
|---|
| 27 | S BACK=$L(TEMP("DIC"))
|
|---|
| 28 | S HOLD=$E(TEMP("DIC"),1,BACK-1)
|
|---|
| 29 | S TEMP("GLO")=HOLD_$S($E(TEMP("DIC"),BACK)=",":")",1:"")
|
|---|
| 30 | S:$E(TEMP("DIC"),1)=" " ERROR=TEMP("DIC")
|
|---|
| 31 | Q
|
|---|
| 32 | RTNFILE(FILE,FIELDS) ;Get the Subfile -This is used og RTELM-
|
|---|
| 33 | N XCOUNT,XFILE,ERROR,XTMP,XFLD,XSFILE,XFLDN,XTFILE,XTMP2
|
|---|
| 34 | S (XSFILE,XTFILE)=+FILE,ERROR=""
|
|---|
| 35 | F XCOUNT=1:1:255 S XFLD=$P(FIELDS,U,XCOUNT),XTMP2=$P(FIELDS,U,XCOUNT+1) Q:XTMP2=""!(ERROR'="") D
|
|---|
| 36 | .S XTMP=$G(^DD(XTFILE,+XFLD,0)) I XTMP="" S ERORR=" Field not in DD" Q
|
|---|
| 37 | .S XTFILE=+$P(XTMP,U,2) I '$D(^DD(XTFILE)) S ERROR=" Undefine (Sub)file"
|
|---|
| 38 | .S XSFILE=XSFILE_U_XTFILE
|
|---|
| 39 | Q $S(ERROR="":XSFILE,1:ERROR)
|
|---|
| 40 | RTNDIE(TEMP) ;Return the DIE value
|
|---|
| 41 | N XFILE,XLOOP,XNODE,XBACK,ERROR S ERROR=""
|
|---|
| 42 | I '$D(TEMP) Q " 0.0 - Require array not define"
|
|---|
| 43 | S XFILE=$G(^DIC($P(+$G(TEMP(1)),U,1),0,"GL")),XLOOP=1
|
|---|
| 44 | Q:XFILE="" " 3.1 - Global location is not defined"
|
|---|
| 45 | F S XLOOP=+$O(TEMP(XLOOP)) Q:XLOOP=0!(ERROR'="") D
|
|---|
| 46 | .S XBACK=TEMP(XLOOP-1),XFILE=XFILE_$P(XBACK,U,2)_","
|
|---|
| 47 | .S XNODE=$G(^DD(+$P(XBACK,U,1),+$P(XBACK,U,3),0))
|
|---|
| 48 | .S XNODE=$P($P(XNODE,U,4),";",1)
|
|---|
| 49 | .I XNODE="" S ERROR=" 3.2 - The zero node of the DD is undefined" Q
|
|---|
| 50 | .I XNODE'=+XNODE S XNODE=""""_XNODE_"""" ; DAD 8-5-96
|
|---|
| 51 | .S XFILE=XFILE_XNODE_","
|
|---|
| 52 | S:ERROR="" ERROR=$$CHKFILE(XFILE)
|
|---|
| 53 | Q $S(ERROR="":XFILE,1:ERROR)
|
|---|
| 54 | RTNDR(TEMP,TYPE) ;Return The DR value
|
|---|
| 55 | N XTYPE,XERROR,XFLD,XDR,XHLD,XDAT
|
|---|
| 56 | S TYPE=+$G(TYPE)
|
|---|
| 57 | I '$D(TEMP) Q " 0.0 - Require array not define"
|
|---|
| 58 | S XTYPE="///",(XERROR,XFLD,XDR)=""
|
|---|
| 59 | F S XFLD=+$O(TEMP("FLD",XFLD)) Q:XFLD=0 D
|
|---|
| 60 | .I (TYPE=1),($G(TEMP("EXC",XHOLD))'=""),(ERROR'="") D
|
|---|
| 61 | ..S X=TEMP("FLD",FLD) X:X'="" TEMP("EXC",XHOLD)
|
|---|
| 62 | ..S:X'="" TEMP("FLD",FLD)=X
|
|---|
| 63 | .S XHLD=$G(TEMP("TYP",XFLD)),XHLD=$S(XHLD="":XTYPE,1:XHLD)
|
|---|
| 64 | .S XDAT=$G(TEMP("FLD",XFLD)),XDR=XDR_$S(XDR="":"",1:";")
|
|---|
| 65 | .S:TYPE=1 XDR=XDR_XFLD_$S(XDAT="":XTYPE,1:XHLD)_XDAT
|
|---|
| 66 | .S:TYPE=0 XDR=XDR_XFLD
|
|---|
| 67 | Q XDR
|
|---|
| 68 | RTNDA(TEMP,ARRAY,ERROR) ;Return The DA value
|
|---|
| 69 | N HOLD,TOTAL,COUNT S ERROR="",TOTAL=$$TOTAL(.TEMP)
|
|---|
| 70 | I '$D(TEMP) Q " 0.0 - Require array not define"
|
|---|
| 71 | F COUNT=TOTAL:-1:1 Q:ERROR'="" D
|
|---|
| 72 | .S ARRAY(TOTAL-COUNT)=+$P($G(TEMP(COUNT)),U,2)
|
|---|
| 73 | .S:ARRAY(TOTAL-COUNT)<1 ERROR=" 5.1 - Record is less than 1 or null"
|
|---|
| 74 | S ARRAY=ARRAY(0) K ARRAY(0)
|
|---|
| 75 | Q
|
|---|
| 76 | STR(XTEMP) ;GET THE DATA VALUE (used by RTNELM)
|
|---|
| 77 | N TEMP,LOOP,HOLD
|
|---|
| 78 | S TEMP=$P(XTEMP,"/",2,255) F LOOP=1:1:4 Q:$E(TEMP,LOOP)'="/"
|
|---|
| 79 | S HOLD=$E(TEMP,LOOP,$L(TEMP))
|
|---|
| 80 | Q $S(HOLD="@":"",1:HOLD)
|
|---|
| 81 | TOTAL(ARRAY) ;Find the total count in an array used by calls)
|
|---|
| 82 | N COUNT,TOTAL S (COUNT,TOTAL)=0
|
|---|
| 83 | F S COUNT=+$O(TEMP(COUNT)) S:COUNT'=0 TOTAL=COUNT Q:COUNT=0
|
|---|
| 84 | Q TOTAL
|
|---|
| 85 | CHKFILE(FILE) ;This validates if global reference is a fileMan file & exists
|
|---|
| 86 | N X S ERROR=""
|
|---|
| 87 | S X="S:'$D("_FILE_"0)) ERROR="" 6.1 (sub)file does not exist"""
|
|---|
| 88 | D ^DIM
|
|---|
| 89 | I '$D(X)!($E(FILE,1)'["^")!(($E(FILE,$L(FILE))'[",")&($E(FILE,$L(FILE))'["(")) S ERROR=" 7.1 Bad Global name for FileMan"
|
|---|
| 90 | Q ERROR
|
|---|
