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

MCDBSAVE.m

Go to the documentation of this file.
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