Index: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXPR.m
===================================================================
--- WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXPR.m	(revision 613)
+++ WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXPR.m	(revision 623)
@@ -1,232 +1,233 @@
-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
+ ;
