| [613] | 1 | MCDBSAVE ;WISC/DCB-save and load util. ;7/18/96 14:08
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | Q
|
|---|
| 4 | ;{See MCDBELM for Field values}
|
|---|
| 5 | SAVE(FILE,REC,FIELDS,EXC,DATA,TYPE,USER,ERROR) ;SAVE some fields
|
|---|
| 6 | N TEMP,RECS,FLDS,FILES
|
|---|
| 7 | S ERROR=""
|
|---|
| 8 | D RTNELM^MCDBELM(FILE,REC,FIELDS,.EXC,DATA,TYPE,USER,.TEMP,.ERROR)
|
|---|
| 9 | D:ERROR="" SETREC(.TEMP,.ERROR)
|
|---|
| 10 | S:ERROR="" ERROR=$$CHECK(.TEMP)
|
|---|
| 11 | Q
|
|---|
| 12 | SETREC(TEMP,ERROR) ;Save the record
|
|---|
| 13 | N DIE,DR,DA,DIC,DTOUT,Y,DIROUT,DUOUT,DTOUT,DIRUT,DIROUT
|
|---|
| 14 | S ERROR=""
|
|---|
| 15 | I '$D(TEMP) S ERROR=" 0.0 - Require array not define" Q
|
|---|
| 16 | S DR=$$RTNDR^MCDBELM(.TEMP,1) I DR="" S ERROR=" Nothing to save" Q
|
|---|
| 17 | S DIE=TEMP("DIC") I $E(DIE,1)=" " S ERROR=DIE Q
|
|---|
| 18 | D RTNDA^MCDBELM(.TEMP,.DA,.ERROR) Q:ERROR'=""
|
|---|
| 19 | D ^DIE
|
|---|
| 20 | I '$D(DA) S ERROR=" inf - Record was deleted" Q
|
|---|
| 21 | I $D(DTOUT) S ERROR=" inf - User timeout" Q
|
|---|
| 22 | I $D(Y)'=0&(TEMP("USER")=2) S ERROR=" inf - User Up-arrow out" Q
|
|---|
| 23 | Q
|
|---|
| 24 | CHECK(TEMP) ;Checks the field values
|
|---|
| 25 | N ERROR,XTOTAL,DIC,DR,DA,DIQ,XPLACE,XHOLD
|
|---|
| 26 | N XFILE,XFLD,XSTR,XINT,XEXT S ERROR=""
|
|---|
| 27 | Q:TEMP("USER")'=0 ""
|
|---|
| 28 | S DR="",XTOTAL=$$TOTAL^MCDBELM(.TEMP),DIC=TEMP("DIC") Q:$E(DIC,1)=" " DIE
|
|---|
| 29 | S DR=$$RTNDR^MCDBELM(.TEMP) Q:ERROR'=""
|
|---|
| 30 | D RTNDA^MCDBELM(.TEMP,.DA,.ERROR) Q:ERROR'=""
|
|---|
| 31 | S DIQ(0)="IE",DIQ="HOLD("
|
|---|
| 32 | D EN^DIQ1
|
|---|
| 33 | S XFILE=$P(TEMP(XTOTAL),U,1),XPLACE=DIQ_XFILE_","_DA_",",XHOLD=""
|
|---|
| 34 | F S XHOLD=+$O(TEMP("FLD",XHOLD)) Q:XHOLD=0!(ERROR'="") D
|
|---|
| 35 | .S XFLD=XHOLD,XSTR=TEMP("FLD",XHOLD)
|
|---|
| 36 | .S XSTR=$S(XSTR="@":"",1:XSTR)
|
|---|
| 37 | .S XINT=$G(@(XPLACE_XHOLD_",""I"")")),XEXT=$G(@(XPLACE_XHOLD_",""E"")"))
|
|---|
| 38 | .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
|
|---|
| 39 | Q ERROR
|
|---|
| 40 | LOAD(FILE,REC,FIELDS,EXC,TYPE,TEMP,ERROR) ;LOAD some fields
|
|---|
| 41 | D RTNELM^MCDBELM(FILE,REC,FIELDS,.EXC,"",TYPE,1,.TEMP,.ERROR)
|
|---|
| 42 | D:ERROR="" GETDATA(.TEMP,.ERROR)
|
|---|
| 43 | Q
|
|---|
| 44 | GETDATA(TEMP,ERROR) ;RETRIEVE THE DATA THAT WAS SAVED
|
|---|
| 45 | N X,XTOTAL,DIC,DR,DA,DIQ,XPLACE,XHOLD
|
|---|
| 46 | N XFILE,XFLD,XSTR,XINT,XEXT,XTYP S ERROR=""
|
|---|
| 47 | I '$D(TEMP) S ERROR=" 0.0 - Require array not define" Q
|
|---|
| 48 | S DR="",XTOTAL=$$TOTAL^MCDBELM(.TEMP),DIC=TEMP("DIC")
|
|---|
| 49 | I $E(DIC,1)=" " S ERROR=DIE Q
|
|---|
| 50 | S DR=$$RTNDR^MCDBELM(.TEMP) Q:ERROR'=""
|
|---|
| 51 | D RTNDA^MCDBELM(.TEMP,.DA,.ERROR) Q:ERROR'=""
|
|---|
| 52 | S DIQ(0)="IE",DIQ="XHOLD("
|
|---|
| 53 | D EN^DIQ1
|
|---|
| 54 | S XFILE=$P(TEMP(XTOTAL),U,1),XPLACE=DIQ_XFILE_","_DA_",",XHOLD=""
|
|---|
| 55 | F S XHOLD=+$O(TEMP("TYP",XHOLD)) Q:XHOLD=0!(ERROR'="") D
|
|---|
| 56 | .S XTYP=TEMP("TYP",XHOLD) S XTYP=$TR(XTYP,"ei","EI")
|
|---|
| 57 | .S XINT=$G(@(XPLACE_XHOLD_",""I"")")),XEXT=$G(@(XPLACE_XHOLD_",""E"")"))
|
|---|
| 58 | .I $G(TEMP("EXC",XHOLD))'="" S X=XINT X TEMP("EXC",XHOLD) S:$G(X)'=XINT (XEXT,XINT)=X
|
|---|
| 59 | .S TEMP("FLD",XHOLD)=$S(XTYP="I":XINT,XTYP="E":XEXT,XINT=XEXT:XINT,1:XINT_U_XEXT)
|
|---|
| 60 | Q
|
|---|
