61 lines
2.6 KiB
Mathematica
61 lines
2.6 KiB
Mathematica
MCDBSAVE ;WISC/DCB-save and load util. ;7/18/96 14:08
|
|
;;2.3;Medicine;;09/13/1996
|
|
Q
|
|
;{See MCDBELM for Field values}
|
|
SAVE(FILE,REC,FIELDS,EXC,DATA,TYPE,USER,ERROR) ;SAVE some fields
|
|
N TEMP,RECS,FLDS,FILES
|
|
S ERROR=""
|
|
D RTNELM^MCDBELM(FILE,REC,FIELDS,.EXC,DATA,TYPE,USER,.TEMP,.ERROR)
|
|
D:ERROR="" SETREC(.TEMP,.ERROR)
|
|
S:ERROR="" ERROR=$$CHECK(.TEMP)
|
|
Q
|
|
SETREC(TEMP,ERROR) ;Save the record
|
|
N DIE,DR,DA,DIC,DTOUT,Y,DIROUT,DUOUT,DTOUT,DIRUT,DIROUT
|
|
S ERROR=""
|
|
I '$D(TEMP) S ERROR=" 0.0 - Require array not define" Q
|
|
S DR=$$RTNDR^MCDBELM(.TEMP,1) I DR="" S ERROR=" Nothing to save" Q
|
|
S DIE=TEMP("DIC") I $E(DIE,1)=" " S ERROR=DIE Q
|
|
D RTNDA^MCDBELM(.TEMP,.DA,.ERROR) Q:ERROR'=""
|
|
D ^DIE
|
|
I '$D(DA) S ERROR=" inf - Record was deleted" Q
|
|
I $D(DTOUT) S ERROR=" inf - User timeout" Q
|
|
I $D(Y)'=0&(TEMP("USER")=2) S ERROR=" inf - User Up-arrow out" Q
|
|
Q
|
|
CHECK(TEMP) ;Checks the field values
|
|
N ERROR,XTOTAL,DIC,DR,DA,DIQ,XPLACE,XHOLD
|
|
N XFILE,XFLD,XSTR,XINT,XEXT S ERROR=""
|
|
Q:TEMP("USER")'=0 ""
|
|
S DR="",XTOTAL=$$TOTAL^MCDBELM(.TEMP),DIC=TEMP("DIC") Q:$E(DIC,1)=" " DIE
|
|
S DR=$$RTNDR^MCDBELM(.TEMP) Q:ERROR'=""
|
|
D RTNDA^MCDBELM(.TEMP,.DA,.ERROR) Q:ERROR'=""
|
|
S DIQ(0)="IE",DIQ="HOLD("
|
|
D EN^DIQ1
|
|
S XFILE=$P(TEMP(XTOTAL),U,1),XPLACE=DIQ_XFILE_","_DA_",",XHOLD=""
|
|
F S XHOLD=+$O(TEMP("FLD",XHOLD)) Q:XHOLD=0!(ERROR'="") D
|
|
.S XFLD=XHOLD,XSTR=TEMP("FLD",XHOLD)
|
|
.S XSTR=$S(XSTR="@":"",1:XSTR)
|
|
.S XINT=$G(@(XPLACE_XHOLD_",""I"")")),XEXT=$G(@(XPLACE_XHOLD_",""E"")"))
|
|
.I (XINT'=XSTR),(XEXT'=XSTR) S ERROR=" 6.1 - Data error for field "_XHOLD,ERROR(1)="USE: "_XSTR,ERROR(2)="EXT: "_XEXT,ERROR(3)="INT: "_XINT
|
|
Q ERROR
|
|
LOAD(FILE,REC,FIELDS,EXC,TYPE,TEMP,ERROR) ;LOAD some fields
|
|
D RTNELM^MCDBELM(FILE,REC,FIELDS,.EXC,"",TYPE,1,.TEMP,.ERROR)
|
|
D:ERROR="" GETDATA(.TEMP,.ERROR)
|
|
Q
|
|
GETDATA(TEMP,ERROR) ;RETRIEVE THE DATA THAT WAS SAVED
|
|
N X,XTOTAL,DIC,DR,DA,DIQ,XPLACE,XHOLD
|
|
N XFILE,XFLD,XSTR,XINT,XEXT,XTYP S ERROR=""
|
|
I '$D(TEMP) S ERROR=" 0.0 - Require array not define" Q
|
|
S DR="",XTOTAL=$$TOTAL^MCDBELM(.TEMP),DIC=TEMP("DIC")
|
|
I $E(DIC,1)=" " S ERROR=DIE Q
|
|
S DR=$$RTNDR^MCDBELM(.TEMP) Q:ERROR'=""
|
|
D RTNDA^MCDBELM(.TEMP,.DA,.ERROR) Q:ERROR'=""
|
|
S DIQ(0)="IE",DIQ="XHOLD("
|
|
D EN^DIQ1
|
|
S XFILE=$P(TEMP(XTOTAL),U,1),XPLACE=DIQ_XFILE_","_DA_",",XHOLD=""
|
|
F S XHOLD=+$O(TEMP("TYP",XHOLD)) Q:XHOLD=0!(ERROR'="") D
|
|
.S XTYP=TEMP("TYP",XHOLD) S XTYP=$TR(XTYP,"ei","EI")
|
|
.S XINT=$G(@(XPLACE_XHOLD_",""I"")")),XEXT=$G(@(XPLACE_XHOLD_",""E"")"))
|
|
.I $G(TEMP("EXC",XHOLD))'="" S X=XINT X TEMP("EXC",XHOLD) S:$G(X)'=XINT (XEXT,XINT)=X
|
|
.S TEMP("FLD",XHOLD)=$S(XTYP="I":XINT,XTYP="E":XEXT,XINT=XEXT:XINT,1:XINT_U_XEXT)
|
|
Q
|