source: FOIAVistA/tag/r/MEDICINE-MC/MCDBSAVE.m@ 1185

Last change on this file since 1185 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1MCDBSAVE ;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}
5SAVE(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
12SETREC(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
24CHECK(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
40LOAD(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
44GETDATA(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
Note: See TracBrowser for help on using the repository browser.