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