Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXPU.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXPU.m
r628 r636 1 PXRMEXPU ; SLC/PKR - Utilities for packing and unpacking repository entries. ; 09/10/20072 ;;2.0;CLINICAL REMINDERS; **6**;Feb 04, 2005;Build 1231 PXRMEXPU ; SLC/PKR - Utilities for packing and unpacking repository entries. ;12/22/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 3 ;================================================== 4 4 BTTABLE(DIQOUT,IENROOT,TTABLE) ;Build the DIQOUT to FDA iens translation table. … … 13 13 . S TTABLE(FILENUM,IENS)="+"_IENS 14 14 E D Q 15 . W !,"BTTABLE^PXRMEXPU - DIQOUT problem ,do not have correct top level"15 . W !,"BTTABLE^PXRMEXPU - DIQOUT problem do not have correct top level" 16 16 ; 17 17 F S FILENUM=$O(DIQOUT(FILENUM)) Q:FILENUM="" D … … 43 43 ... I '$D(TYPE(FILENUM,FIELD)) S TYPE(FILENUM,FIELD)=$$GET1^DID(FILENUM,FIELD,"","TYPE") 44 44 ... S PTRTO=$S(TYPE(FILENUM,FIELD)="POINTER":$$GET1^DID(FILENUM,FIELD,"","POINTER"),1:"") 45 ... ;Remove pointers to file 200.46 ... I PTRTO="VA(200," S DIQOUT(FILENUM,IENS,FIELD)="" Q47 45 ...;If the field's type is COMPUTED then don't transport it. 48 46 ... I TYPE(FILENUM,FIELD)="COMPUTED" K DIQOUT(FILENUM,IENS,FIELD) Q … … 91 89 ;================================================== 92 90 GDIQF(LIST,NUM,TMPIND,SERROR) ;Save file entries into ^TMP(TMPIND,$J). 93 N CSUM,DIQOUT,IENROOT,IND,FIELD,FILENAME,IENS,MSG,PT01,TEMP91 N DIQOUT,IENROOT,IND,FIELD,FILENAME,IENS,MSG,PT01,TEMP 94 92 S ^TMP(TMPIND,$J,"NUMF")=NUM 95 93 F IND=1:1:NUM D … … 103 101 . I $$FOKTI^PXRMEXFI(FILENUM) S FIELD="**" 104 102 . E S FIELD=.01 105 . D GETS^DIQ(FILENUM,IEN,FIELD," N","DIQOUT","MSG")103 . D GETS^DIQ(FILENUM,IEN,FIELD,"","DIQOUT","MSG") 106 104 . I $D(MSG) D Q 107 105 .. S SERROR=1,IND=NUM … … 117 115 .;Convert the iens to the FDA adding form. 118 116 . D CONTOFDA(.DIQOUT,.IENROOT) 119 . S CSUM=$$DIQOUTCS^PXRMEXCS(.DIQOUT)120 . S ^TMP("PXRMEXCS",$J,IND,FILENAME)=CSUM121 117 .;Load the converted DIQOUT into TMP. 122 118 . M ^TMP(TMPIND,$J,IND,FILENAME)=DIQOUT … … 135 131 ;================================================== 136 132 GRTN(LIST,NUM,TMPIND,SERROR) ;Save routines into ^TMP(TMPIND,$J). 137 N DIF,IEN,IND, RA,TEMP,X,XCNP133 N DIF,IEN,IND,TEMP,X,XCNP 138 134 S ^TMP(TMPIND,$J,"NUMR")=NUM 139 135 S X="" … … 143 139 . X ^%ZOSF("TEST") 144 140 . I $T D 145 .. K RA 146 .. S DIF="RA(" 141 .. S DIF="^TMP(TMPIND,$J,""ROUTINE"","""_X_"""," 147 142 .. S XCNP=0 148 143 .. X ^%ZOSF("LOAD") 149 .. S ^TMP("PXRMEXCS",$J,"ROUTINE",X)=$$ROUTINE^PXRMEXCS(.RA)150 .. M ^TMP(TMPIND,$J,"ROUTINE",X)=RA151 144 . E D 152 145 .. S SERROR=1 … … 156 149 ; 157 150 ;================================================== 158 RMEH(FILENUM,DIQOUT ,NOSTUB) ;Clear the edit history from all reminder files.151 RMEH(FILENUM,DIQOUT) ;Clear the edit history from all reminder files. 159 152 ;Leave a stub so it can be filled in when the file is installed. 160 153 I (FILENUM<800)!(FILENUM>811.9) Q 161 N IEN S,SFN,TARGET154 N IEN,SFN,TARGET 162 155 ;Edit History is stored in node 110 for all files, get the 163 156 ;subfile number. … … 169 162 F S IENS=$O(DIQOUT(SFN,IENS)) Q:IENS="" K DIQOUT(SFN,IENS) 170 163 ;Create a stub for the install. 171 I $G(NOSTUB) Q172 164 S IENS="1,"_$O(DIQOUT(FILENUM,"")) 173 165 S DIQOUT(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
Note:
See TracChangeset
for help on using the changeset viewer.