Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXPR.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXPR.m (modified) (1 diff)

WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXPR.m

@@ -1 @@
-PXRMEXPR        ; SLC/PKR/PJH - Routines to create packed reminder definitions. ;12/12/2006
-        ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
-        ;===============================================================
-ADDFILE(FLIST,ROOT,FILENAME)    ;Add a file to the list of finding files.
-        N DIC,DO,FILENUM
-        S DIC="^"_ROOT
-        K DO
-        D DO^DIC1
-        S FILENUM=+DO(2)
-        S FILENAME=$P(DO,U,1)
-        S FLIST(FILENAME)=FILENUM
-        Q
-        ;
-        ;===============================================================
-ADDFIND(FLIST,FILENAME,IEN)     ;Add a finding to the list of findings.
-        S FLIST(FILENAME,"F",IEN)=""
-        ;Make sure categories are included for any health factors and they
-        ;come first in the list of health factors.
-        I FILENAME="HEALTH FACTORS" D
-        . N CAT
-        . S CAT=$P(^AUTTHF(IEN,0),U,3)
-        . S FLIST(FILENAME,"C",CAT)=""
-        Q
-        ;
-        ;===============================================================
-BLDSPON(RIEN,FINDLIST,SPONLIST) ;Build the sponsor list.
-        N DIEN,IEN,IND,IND0
-        ;Start with the definition.
-        D GETSPON(811.9,RIEN,.SPONLIST)
-        ;If there is a dialog add it.
-        ;S DIEN=+$P($G(^PXD(811.9,RIEN,51)),U,1)
-        ;I DIEN>0 D GETSPON(801.41,DIEN,.SPONLIST)
-        ;Go through the finding list to find additional sponsors.
-        S IND=""
-        F  S IND=$O(FINDLIST(IND)) Q:IND=""  D
-        . S FILENUM=FINDLIST(IND)
-        . I (FILENUM'<800)&(FILENUM'>811.9) D
-        .. S IND0=""
-        .. F  S IND0=$O(FINDLIST(IND,IND0)) Q:IND0=""  D
-        ... S IEN=""
-        ... F  S IEN=+$O(FINDLIST(IND,IND0,IEN)) Q:IEN=0  D
-        .... D GETSPON(FILENUM,IEN,.SPONLIST)
-        ;Add any associated sponsors to the begining of the list.
-        S IND=""
-        F  S IND=$O(SPONLIST("S",IND)) Q:IND=""  D
-        . S IND0=0
-        . F  S IND0=+$O(^PXRMD(811.6,IND,2,IND0)) Q:IND0=0  D
-        .. S IEN=+^PXRMD(811.6,IND,2,IND0,0)
-        .. S SPONLIST("A",IEN)=""
-        Q
-        ;
-        ;===============================================================
-BLDTEXT(TMPIND) ;Combine the source information and the user's input into the
-        ;"TEXT" array.
-        N IC,IND
-        S (IC,IND)=0
-        F  S IC=$O(^TMP(TMPIND,$J,"SRC",IC)) Q:+IC=0  D
-        . S IND=IND+1
-        . S ^TMP(TMPIND,$J,"TEXT",1,IND)=^TMP(TMPIND,$J,"SRC",IC)
-        ;
-        S IC=0
-        F  S IC=$O(^TMP(TMPIND,$J,"TXT",1,IC)) Q:+IC=0  D
-        . S IND=IND+1
-        . S ^TMP(TMPIND,$J,"TEXT",1,IND)=^TMP(TMPIND,$J,"TXT",1,IC,0)
-        Q
-        ;
-        ;===============================================================
-GETDFIND(RIEN,FLIST)    ;Build the list of definition findings.
-        ;FLIST has the format FLIST(FILENAME)=file number, and for each
-        ;finding from the file FLIST(FILENAME,"F",IEN)="". For Health Factors
-        ;category entries are FLIST(FILENAME,"C",IEN)="".
-        N FILENAME,IEN,ROOT
-        S ROOT=""
-        F  S ROOT=$O(^PXD(811.9,RIEN,20,"E",ROOT)) Q:ROOT=""  D
-        . D ADDFILE(.FLIST,ROOT,.FILENAME)
-        . S IEN=0
-        . F  S IEN=$O(^PXD(811.9,RIEN,20,"E",ROOT,IEN)) Q:+IEN=0  D
-        .. D ADDFIND(.FLIST,FILENAME,IEN)
-        Q
-        ;
-        ;===============================================================
-GETSPON(FILENUM,IEN,SPONLIST)   ;Add sponsors to the sponsor list.
-        N ENTRY,ROOT,SPONSOR
-        S ROOT=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
-        S ENTRY=ROOT_IEN_",100)"
-        S ENTRY=$G(@ENTRY)
-        S SPONSOR=$P(ENTRY,U,2)
-        I SPONSOR'="" S SPONLIST("S",SPONSOR)=""
-        Q
-        ;
-        ;===============================================================
-GETTFIND(FLIST) ;If there are any terms in the list of findings go through
-        ;them and add the mapped findings to the list of findings.
-        I '$D(FLIST("REMINDER TERM")) Q
-        N FILENAME,ROOT,TIEN
-        S TIEN=0
-        F  S TIEN=$O(FLIST("REMINDER TERM","F",TIEN)) Q:+TIEN=0  D
-        . S ROOT=""
-        . F  S ROOT=$O(^PXRMD(811.5,TIEN,20,"E",ROOT)) Q:ROOT=""  D
-        .. D ADDFILE(.FLIST,ROOT,.FILENAME)
-        .. S IEN=0
-        .. F  S IEN=$O(^PXRMD(811.5,TIEN,20,"E",ROOT,IEN)) Q:+IEN=0  D
-        ... D ADDFIND(.FLIST,FILENAME,IEN)
-        Q
-        ;
-        ;===============================================================
-GETTEXT(RIEN,TMPIND,INDEX)      ;Let the user input some text.
-        N DIC,DWLW,DWPK
-        ;If this is the description text, load the reminder description as
-        ;the default.
-        S RIEN=+RIEN
-        I RIEN>0 M ^TMP(TMPIND,$J,INDEX,1)=^PXD(811.9,RIEN,1)
-        S DIC="^TMP(TMPIND,$J,"""_INDEX_""",1,"
-        S DWLW=72
-        S DWPK=1
-        D EN^DIWE
-        Q
-        ;
-        ;===============================================================
-PACK(RTP,TMPIND)        ;Create the packed reminder, store it in
-        ;^TMP(TMPIND,$J). TMPIND should be namespaced and set by the caller.
-        ;Save the source information
-        I +RTP'>0 Q
-        K ^TMP(TMPIND,$J),^TMP("PXRMEXCS",$J)
-        D PUTSRC(RTP,TMPIND)
-        ;
-        ;Have the user input text that describes the reminder.
-        W !,"Enter a description of the reminder you are packing." H 3
-        D GETTEXT(RTP,TMPIND,"DESC")
-        ;
-        ;Have the user input keywords for indexing the reminder.
-        W !,"Enter keywords or phrases to help index the reminder you are packing."
-        W !,"Separate the keywords or phrases on each line with commas." H 3
-        D GETTEXT(0,TMPIND,"KEYWORD")
-        ;
-        ;Combine the source and input text into the "TEXT" array.
-        D BLDTEXT(TMPIND)
-        ;
-        W !,"Packing the reminder ... "
-        ;Build lists of the various reminder components.
-        N CF,IEN,IND0,FINDLIST,FILELIST,FILENAME,FILENUM,DLGLIST
-        N NUMF,NUMR,OBJLIST,RIEN,ROUTINE,RTNLIST
-        N SERROR,SPONLIST,TEMLIST
-        S RIEN=$P(RTP,U,1)
-        ;
-        ;Get the list of definition findings and start the sponsor list.
-        D GETDFIND(RIEN,.FINDLIST)
-        ;
-        ;Add term findings to the list.
-        D GETTFIND(.FINDLIST)
-        ;
-        ;If a dialog exists for this reminder add it and its findings to the
-        ;list. Also collect any embedded TIU objects or templates
-        D DIALOG^PXRMEXDG(RIEN,.DLGLIST,.FINDLIST,.OBJLIST,.TEMLIST,.SPONLIST)
-        ;
-        ;If there were education topics make sure subtopics are included.
-        D SUB^PXRMEXED(.FINDLIST)
-        ;
-        ;The finding list is complete, search the definition, dialog and
-        ;all the findings for sponsors.
-        D BLDSPON(RIEN,.FINDLIST,.SPONLIST)
-        ;
-        ;Put sponsors first on the file list.
-        S NUMF=0
-        S IND0=0
-        F  S IND0=$O(SPONLIST(IND0)) Q:IND0=""  D
-        . S IEN=0
-        . F  S IEN=$O(SPONLIST(IND0,IEN)) Q:IEN=""  D
-        .. S NUMF=NUMF+1
-        .. S FILELIST(NUMF)="REMINDER SPONSOR"_U_811.6_U_IEN
-        ;
-        ;Look for any computed findings and put the associated routines
-        ;on the routine list.
-        S (IEN,NUMR)=0
-        F  S IEN=$O(FINDLIST("REMINDER COMPUTED FINDINGS","F",IEN)) Q:IEN=""  D
-        . S ROUTINE=$P(^PXRMD(811.4,IEN,0),U,2)
-        . S NUMR=NUMR+1
-        . S RTNLIST(NUMR)=ROUTINE
-        ;
-        ;Go through the finding list and create the file list in the same
-        ;order as the finding list.
-        S FILENAME=""
-        F  S FILENAME=$O(FINDLIST(FILENAME)) Q:FILENAME=""  D
-        . S FILENUM=FINDLIST(FILENAME)
-        . S IND0=""
-        . F  S IND0=$O(FINDLIST(FILENAME,IND0)) Q:IND0=""  D
-        .. S IEN=0
-        .. F  S IEN=$O(FINDLIST(FILENAME,IND0,IEN)) Q:IEN=""  D
-        ... S NUMF=NUMF+1
-        ... S FILELIST(NUMF)=FILENAME_U_FILENUM_U_IEN
-        ;
-        ;Add TIU templates to the file list.
-        S IND0=0
-        F  S IND0=$O(TEMLIST(IND0)) Q:IND0=""  D
-        . S IEN=$$EXISTS^PXRMEXIU(8927.1,TEMLIST(IND0))
-        . S NUMF=NUMF+1
-        . S FILELIST(NUMF)="TIU TEMPLATE FIELD"_U_8927.1_U_IEN
-        ;
-        ;Put the reminder at next to last.
-        S NUMF=NUMF+1
-        S FILELIST(NUMF)="REMINDER DEFINITION"_U_811.9_U_RIEN
-        ;
-        ;Put dialogs last on the file list.
-        S FILENUM=$G(DLGLIST("DIALOG"))
-        S IND0=""
-        F  S IND0=$O(DLGLIST("DIALOG",IND0)) Q:IND0=""  D
-        . S IEN=""
-        . F  S IEN=$O(DLGLIST("DIALOG",IND0,IEN)) Q:IEN=""  D
-        .. S NUMF=NUMF+1
-        .. S FILELIST(NUMF)="REMINDER DIALOG"_U_FILENUM_U_IEN
-        ;
-        S SERROR=0
-        ;Put any routines into the ^TMP array.
-        D GRTN^PXRMEXPU(.RTNLIST,NUMR,TMPIND,.SERROR)
-        ;Put the GETS^DIQ extracts of the findings, dialogs, and
-        ;reminder definition into the ^TMP array.
-        D GDIQF^PXRMEXPU(.FILELIST,NUMF,TMPIND,.SERROR)
-        ;
-        ;If there were any errors saving the data kill the ^TMP array.
-        I SERROR K ^TMP(TMPIND,$J)
-        Q
-        ;
-        ;===============================================================
-PUTSRC(RTP,TMPIND)      ;Save the source information
-        N LOC
-        S LOC=$$SITE^VASITE
-        S ^TMP(TMPIND,$J,"SRC","REMINDER")=$P(RTP,U,2)
-        S ^TMP(TMPIND,$J,"SRC","USER")=$$GET1^DIQ(200,DUZ,.01)
-        S ^TMP(TMPIND,$J,"SRC","SITE")=$P(LOC,U,2)
-        S ^TMP(TMPIND,$J,"SRC","DATE")=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
-        Q
-        ;
+PXRMEXPR ; SLC/PKR/PJH - Routines to create packed reminder definitions. ;02/25/2004
+ ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+ ;===============================================================
+ADDFILE(FLIST,ROOT,FILENAME) ;Add a file to the list of finding files.
+ N DIC,DO,FILENUM
+ S DIC="^"_ROOT
+ K DO
+ D DO^DIC1
+ S FILENUM=+DO(2)
+ S FILENAME=$P(DO,U,1)
+ S FLIST(FILENAME)=FILENUM
+ Q
+ ;
+ ;===============================================================
+ADDFIND(FLIST,FILENAME,IEN) ;Add a finding to the list of findings.
+ S FLIST(FILENAME,"F",IEN)=""
+ ;Make sure categories are included for any health factors and they
+ ;come first in the list of health factors.
+ I FILENAME="HEALTH FACTORS" D
+ . N CAT
+ . S CAT=$P(^AUTTHF(IEN,0),U,3)
+ . S FLIST(FILENAME,"C",CAT)=""
+ Q
+ ;
+ ;===============================================================
+BLDSPON(RIEN,FINDLIST,SPONLIST) ;Build the sponsor list.
+ N DIEN,IEN,IND,IND0
+ ;Start with the definition.
+ D GETSPON(811.9,RIEN,.SPONLIST)
+ ;If there is a dialog add it.
+ S DIEN=+$P($G(^PXD(811.9,RIEN,51)),U,1)
+ I DIEN>0 D GETSPON(801.41,DIEN,.SPONLIST)
+ ;Go through the finding list to find additional sponsors.
+ S IND=""
+ F  S IND=$O(FINDLIST(IND)) Q:IND=""  D
+ . S FILENUM=FINDLIST(IND)
+ . I (FILENUM'<800)&(FILENUM'>811.9) D
+ .. S IND0=""
+ .. F  S IND0=$O(FINDLIST(IND,IND0)) Q:IND0=""  D
+ ... S IEN=""
+ ... F  S IEN=+$O(FINDLIST(IND,IND0,IEN)) Q:IEN=0  D
+ .... D GETSPON(FILENUM,IEN,.SPONLIST)
+ ;Add any associated sponsors to the begining of the list.
+ S IND=""
+ F  S IND=$O(SPONLIST("S",IND)) Q:IND=""  D
+ . S IND0=0
+ . F  S IND0=+$O(^PXRMD(811.6,IND,2,IND0)) Q:IND0=0  D
+ .. S IEN=+^PXRMD(811.6,IND,2,IND0,0)
+ .. S SPONLIST("A",IEN)=""
+ Q
+ ;
+ ;===============================================================
+BLDTEXT(TMPIND) ;Combine the source information and the user's input into the
+ ;"TEXT" array.
+ N IC,IND
+ S (IC,IND)=0
+ F  S IC=$O(^TMP(TMPIND,$J,"SRC",IC)) Q:+IC=0  D
+ . S IND=IND+1
+ . S ^TMP(TMPIND,$J,"TEXT",1,IND)=^TMP(TMPIND,$J,"SRC",IC)
+ ;
+ S IC=0
+ F  S IC=$O(^TMP(TMPIND,$J,"TXT",1,IC)) Q:+IC=0  D
+ . S IND=IND+1
+ . S ^TMP(TMPIND,$J,"TEXT",1,IND)=^TMP(TMPIND,$J,"TXT",1,IC,0)
+ Q
+ ;
+ ;===============================================================
+GETDFIND(RIEN,FLIST) ;Build the list of definition findings.
+ ;FLIST has the format FLIST(FILENAME)=file number, and for each
+ ;finding from the file FLIST(FILENAME,"F",IEN)="". For Health Factors
+ ;category entries are FLIST(FILENAME,"C",IEN)="".
+ N FILENAME,IEN,ROOT
+ S ROOT=""
+ F  S ROOT=$O(^PXD(811.9,RIEN,20,"E",ROOT)) Q:ROOT=""  D
+ . D ADDFILE(.FLIST,ROOT,.FILENAME)
+ . S IEN=0
+ . F  S IEN=$O(^PXD(811.9,RIEN,20,"E",ROOT,IEN)) Q:+IEN=0  D
+ .. D ADDFIND(.FLIST,FILENAME,IEN)
+ Q
+ ;
+ ;===============================================================
+GETSPON(FILENUM,IEN,SPONLIST) ;Add sponsors to the sponsor list.
+ N ENTRY,ROOT,SPONSOR
+ S ROOT=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
+ S ENTRY=ROOT_IEN_",100)"
+ S ENTRY=$G(@ENTRY)
+ S SPONSOR=$P(ENTRY,U,2)
+ I SPONSOR'="" S SPONLIST("S",SPONSOR)=""
+ Q
+ ;
+ ;===============================================================
+GETTFIND(FLIST) ;If there are any terms in the list of findings go through
+ ;them and add the mapped findings to the list of findings.
+ I '$D(FLIST("REMINDER TERM")) Q
+ N FILENAME,ROOT,TIEN
+ S TIEN=0
+ F  S TIEN=$O(FLIST("REMINDER TERM","F",TIEN)) Q:+TIEN=0  D
+ . S ROOT=""
+ . F  S ROOT=$O(^PXRMD(811.5,TIEN,20,"E",ROOT)) Q:ROOT=""  D
+ .. D ADDFILE(.FLIST,ROOT,.FILENAME)
+ .. S IEN=0
+ .. F  S IEN=$O(^PXRMD(811.5,TIEN,20,"E",ROOT,IEN)) Q:+IEN=0  D
+ ... D ADDFIND(.FLIST,FILENAME,IEN)
+ Q
+ ;
+ ;===============================================================
+GETTEXT(RIEN,TMPIND,INDEX) ;Let the user input some text.
+ N DIC,DWLW,DWPK
+ ;If this is the description text, load the reminder description as
+ ;the default.
+ S RIEN=+RIEN
+ I RIEN>0 M ^TMP(TMPIND,$J,INDEX,1)=^PXD(811.9,RIEN,1)
+ S DIC="^TMP(TMPIND,$J,"""_INDEX_""",1,"
+ S DWLW=72
+ S DWPK=1
+ D EN^DIWE
+ Q
+ ;
+ ;===============================================================
+PACK(RTP,TMPIND) ;Create the packed reminder, store it in
+ ;^TMP(TMPIND,$J). TMPIND should be namespaced and set by the caller.
+ ;Save the source information
+ I +RTP'>0 Q
+ K ^TMP(TMPIND,$J)
+ D PUTSRC(RTP,TMPIND)
+ ;
+ ;Have the user input text that describes the reminder.
+ W !,"Enter a description of the reminder you are packing." H 3
+ D GETTEXT(RTP,TMPIND,"DESC")
+ ;
+ ;Have the user input keywords for indexing the reminder.
+ W !,"Enter keywords or phrases to help index the reminder you are packing."
+ W !,"Separate the keywords or phrases on each line with commas." H 3
+ D GETTEXT(0,TMPIND,"KEYWORD")
+ ;
+ ;Combine the source and input text into the "TEXT" array.
+ D BLDTEXT(TMPIND)
+ ;
+ W !,"Packing the reminder ... "
+ ;Build lists of the various reminder components.
+ N CF,IEN,IND0,FINDLIST,FILELIST,FILENAME,FILENUM,DLGLIST
+ N NUMF,NUMR,OBJLIST,RIEN,ROUTINE,RTNLIST
+ N SERROR,SPONLIST,TEMLIST
+ S RIEN=$P(RTP,U,1)
+ ;
+ ;Get the list of definition findings and start the sponsor list.
+ D GETDFIND(RIEN,.FINDLIST)
+ ;
+ ;Add term findings to the list.
+ D GETTFIND(.FINDLIST)
+ ;
+ ;If a dialog exists for this reminder add it and its findings to the
+ ;list. Also collect any embedded TIU objects or templates
+ D DIALOG^PXRMEXDG(RIEN,.DLGLIST,.FINDLIST,.OBJLIST,.TEMLIST)
+ ;
+ ;If there were education topics make sure subtopics are included.
+ D SUB^PXRMEXED(.FINDLIST)
+ ;
+ ;The finding list is complete, search the definition, dialog and
+ ;all the findings for sponsors.
+ D BLDSPON(RIEN,.FINDLIST,.SPONLIST)
+ ;
+ ;Put sponsors first on the file list.
+ S NUMF=0
+ S IND0=0
+ F  S IND0=$O(SPONLIST(IND0)) Q:IND0=""  D
+ . S IEN=0
+ . F  S IEN=$O(SPONLIST(IND0,IEN)) Q:IEN=""  D
+ .. S NUMF=NUMF+1
+ .. S FILELIST(NUMF)="REMINDER SPONSOR"_U_811.6_U_IEN
+ ;
+ ;Look for any computed findings and put the associated routines
+ ;on the routine list.
+ S (IEN,NUMR)=0
+ F  S IEN=$O(FINDLIST("REMINDER COMPUTED FINDINGS","F",IEN)) Q:IEN=""  D
+ . S ROUTINE=$P(^PXRMD(811.4,IEN,0),U,2)
+ . S NUMR=NUMR+1
+ . S RTNLIST(NUMR)=ROUTINE
+ ;
+ ;Go through the finding list and create the file list in the same
+ ;order as the finding list.
+ S FILENAME=""
+ F  S FILENAME=$O(FINDLIST(FILENAME)) Q:FILENAME=""  D
+ . S FILENUM=FINDLIST(FILENAME)
+ . S IND0=""
+ . F  S IND0=$O(FINDLIST(FILENAME,IND0)) Q:IND0=""  D
+ .. S IEN=0
+ .. F  S IEN=$O(FINDLIST(FILENAME,IND0,IEN)) Q:IEN=""  D
+ ... S NUMF=NUMF+1
+ ... S FILELIST(NUMF)=FILENAME_U_FILENUM_U_IEN
+ ;
+ ;Add TIU templates to the file list.
+ S IND0=0
+ F  S IND0=$O(TEMLIST(IND0)) Q:IND0=""  D
+ . S IEN=$$EXISTS^PXRMEXIU(8927.1,TEMLIST(IND0))
+ . S NUMF=NUMF+1
+ . S FILELIST(NUMF)="TIU TEMPLATE FIELD"_U_8927.1_U_IEN
+ ;
+ ;Put the reminder at next to last.
+ S NUMF=NUMF+1
+ S FILELIST(NUMF)="REMINDER DEFINITION"_U_811.9_U_RIEN
+ ;
+ ;Put dialogs last on the file list.
+ S FILENUM=$G(DLGLIST("DIALOG"))
+ S IND0=""
+ F  S IND0=$O(DLGLIST("DIALOG",IND0)) Q:IND0=""  D
+ . S IEN=""
+ . F  S IEN=$O(DLGLIST("DIALOG",IND0,IEN)) Q:IEN=""  D
+ .. S NUMF=NUMF+1
+ .. S FILELIST(NUMF)="REMINDER DIALOG"_U_FILENUM_U_IEN
+ ;
+ S SERROR=0
+ ;Put any routines into the ^TMP array.
+ D GRTN^PXRMEXPU(.RTNLIST,NUMR,TMPIND,.SERROR)
+ ;Put the GETS^DIQ extracts of the findings, dialogs, and
+ ;reminder definition into the ^TMP array.
+ D GDIQF^PXRMEXPU(.FILELIST,NUMF,TMPIND,.SERROR)
+ ;
+ ;If there were any errors saving the data kill the ^TMP array.
+ I SERROR K ^TMP(TMPIND,$J)
+ Q
+ ;
+ ;===============================================================
+PUTSRC(RTP,TMPIND) ;Save the source information
+ N LOC
+ S LOC=$$SITE^VASITE
+ S ^TMP(TMPIND,$J,"SRC","REMINDER")=$P(RTP,U,2)
+ ;S ^TMP(TMPIND,$J,"SRC","USER")=$P(^VA(200,DUZ,0),U,1)
+ S ^TMP(TMPIND,$J,"SRC","USER")=$$GET1^DIQ(200,DUZ,.01)
+ S ^TMP(TMPIND,$J,"SRC","SITE")=$P(LOC,U,2)
+ S ^TMP(TMPIND,$J,"SRC","DATE")=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+ Q
+ ;