- PXKWSRCH ;SLC/PKR - Keyword search routines. ;02/24/2016
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
- ;
- ;=====================================
- CASESEN() ;Ask the user if the search is case sensitive.
- N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
- S DIR(0)="YA"
- S DIR("A")="Should the search be case-sensitive? "
- S DIR("B")="N"
- D ^DIR
- I $D(DIRUT) S Y="^"
- Q Y
- ;
- ;=====================================
- DISPLAY(CASESEN,NKW,KEYWORD) ;Display the search results.
- N ENAME,FIELD,FILENUM,FLABEL,FNUM,GNAME,GNAMELST,IEN,IENS,IND
- N LABEL,LN,NIEN,NL,NM,TEMP,TEXT
- S NL=0
- S NL=NL+1,TEXT(NL)="The search was for the following keywords:"
- F IND=1:1:NKW S NL=NL+1,TEXT(NL)=" "_KEYWORD(IND)
- S FILENUM=""
- F S FILENUM=$O(^TMP($J,"KWS",FILENUM)) Q:FILENUM="" D
- . S GNAME=$$GET1^DID(FILENUM,"","","NAME")
- . S GNAMELST(GNAME,FILENUM)=""
- S GNAME=""
- F S GNAME=$O(GNAMELST(GNAME)) Q:GNAME="" D
- . I NL>1 S NL=NL+1,TEXT(NL)=""
- . S NL=NL+1,TEXT(NL)="File: "_GNAME
- . S FILENUM=$O(GNAMELST(GNAME,FILENUM))
- . S IEN="",NIEN=0
- . F S IEN=$O(^TMP($J,"KWS",FILENUM,IEN)) Q:IEN="" D
- .. S ENAME=$$GET1^DIQ(FILENUM,IEN,.01)
- .. S NIEN=NIEN+1
- .. I NIEN>1 S NL=NL+1,TEXT(NL)=""
- .. S NM=^TMP($J,"KWS",FILENUM,IEN)
- .. S NL=NL+1,TEXT(NL)=" Entry "_ENAME_" (IEN="_IEN_") contains "_NM_" match"_$S(NM>1:"es.",1:".")
- .. S FNUM=""
- .. F S FNUM=$O(^TMP($J,"KWSIEN",FILENUM,IEN,FNUM)) Q:FNUM="" D
- ... S IENS=""
- ... F S IENS=$O(^TMP($J,"KWSIEN",FILENUM,IEN,FNUM,IENS)) Q:IENS="" D
- .... S FIELD=""
- .... F S FIELD=$O(^TMP($J,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD)) Q:FIELD="" D
- ..... I '$D(FLABEL(FNUM,FIELD)) S FLABEL(FNUM,FIELD)=$$FLABEL(FNUM,FIELD)
- ..... S NL=NL+1,TEXT(NL)=" Found in field "_FLABEL(FNUM,FIELD)_" the text is:"
- ..... S TEMP=$G(^TMP($J,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD))
- ..... I TEMP'="" S NL=NL+1,TEXT(NL)=" "_$$HLITE(TEMP,CASESEN)
- ..... S LN=0
- ..... F S LN=$O(^TMP($J,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD,LN)) Q:LN="" D
- ...... S TEMP=$G(^TMP($J,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD,LN))
- ...... I TEMP'="" S NL=NL+1,TEXT(NL)=" "_$$HLITE(TEMP,CASESEN)
- I NL=(NKW+1) S NL=NL+1,TEXT(NL)="No matches were found."
- D BROWSE^DDBR("TEXT","ANR","Text/Keyword Search")
- K ^TMP($J,"KWS"),^TMP($J,"KWSIEN")
- Q
- ;
- ;=====================================
- FLABEL(FNUM,FIELD) ;Return the label for a field.
- N DATA
- D FIELD^DID(FNUM,FIELD,"N","LABEL","DATA")
- Q DATA("LABEL")
- ;
- ;=====================================
- GETFLIST(NSFILE,SFILE) ;Get the list of files to search.
- N DIR,DIRUT,DIROUT,DTOUT,DUOUT,FLIST,IND,LNUM,NFILES,X,Y
- S FLIST(1)="1. ^Education Topics^9999999.09^AUTTEDT"
- S FLIST(2)="2. ^Exam^9999999.15^AUTTEXAM"
- S FLIST(3)="3. ^Health Factors^9999999.64^AUTTHF"
- S FLIST(4)="4. ^Immunizations^9999999.14^AUTTIMM"
- S FLIST(5)="5. ^Skin Test^9999999.28^AUTTSK"
- S DIR(0)="LA^1:5"
- S DIR("A")="Select the files to search: "
- F IND=1:1:5 S DIR("A",IND)=$P(FLIST(IND),U,1)_$P(FLIST(IND),U,2)
- D EN^DDIOL("Select from the following list of files:")
- D ^DIR
- I Y["^"!$G(DIROUT) S NSFILE=0 Q
- S NSFILE=$L(Y,",")-1
- F IND=1:1:NSFILE D
- . S LNUM=$P(Y,",",IND)
- . S SFILE(IND)=$P(FLIST(LNUM),U,2,4)
- Q
- ;
- ;=====================================
- GETKWS(CASESEN,NKW,KEYWORD) ;Have the user input the key words.
- N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
- S NKW=0
- D EN^DDIOL("Input the keywords, one per line. Enter NULL or '^' to exit.")
- S DIR(0)="FAOU^2:45"
- S DIR("A")="Input a keyword: "
- S DONE=0
- F Q:DONE D
- . D ^DIR
- . I (Y="^")!(Y="")!$G(DIROUT) S DONE=1 Q
- . S NKW=NKW+1
- . S KEYWORD(NKW)=$S(CASESEN:Y,1:$$UP^XLFSTR(Y))
- Q
- ;
- ;=====================================
- GSEARCH ;Entry point for general selection of global to search.
- N CASESEN,DIC,FILENUM,FNAME,GBL,IEN,KEYWORD,NKW,X,Y
- ;Prompt the user for the file that want to search.
- S DIC=1,DIC(0)="AEMNV"
- S DIC("A")="Select a file to search: "
- D ^DIC
- I Y=-1 Q
- S FILENUM=$P(Y,U,1)
- S FNAME=$P(Y,U,2)
- S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
- S GBL=$$CREF^DILF(GBL)
- ;Prompt for case-sensitive.
- S CASESEN=$$CASESEN
- I CASESEN["^" Q
- ;Get the list of keywords.
- D GETKWS(CASESEN,.NKW,.KEYWORD)
- I NKW=0 Q
- K ^TMP($J,"KWS"),^TMP($J,"KWSIEN")
- D EN^DDIOL("Searching "_FNAME_" ...")
- S IEN=0
- F S IEN=+$O(@GBL@(IEN)) Q:IEN=0 D SRCHTEXT(FILENUM,IEN,CASESEN,NKW,.KEYWORD)
- D DISPLAY(CASESEN,NKW,.KEYWORD)
- Q
- ;
- ;=====================================
- HLITE(TEXT,CASESEN) ;Mark the keyword so it will be highlighted in the Browser.
- N FIND,KEYWORD,HTEXT,LKW,MKEY,MTEXT,START,STOP,TAG,TAGBEG,TAGEND,TTEXT
- S TTEXT=$P(TEXT,U,1)
- S MTEXT=$S(CASESEN:TTEXT,1:$$UP^XLFSTR(TTEXT))
- S KEYWORD=$P(TEXT,U,2)
- S MKEY=$S(CASESEN:KEYWORD,1:$$UP^XLFSTR(KEYWORD))
- S LKW=$L(KEYWORD)
- S FIND=1,HTEXT="",START=1
- F Q:FIND=0 D
- . S FIND=$F(MTEXT,MKEY,FIND)
- . I FIND=0 Q
- . S TAGBEG=FIND-LKW
- . S TAGEND=FIND-1
- . S STOP=TAGEND-LKW
- . S TAG="$.%^"_$E(TTEXT,TAGBEG,TAGEND)_"$.%"
- . S HTEXT=HTEXT_$E(TTEXT,START,STOP)_TAG
- . S START=FIND
- S HTEXT=HTEXT_$E(TTEXT,START,$L(TTEXT))
- Q HTEXT
- ;
- ;=====================================
- SEARCH ;Perform the keyword search.
- N CASESEN,FILENUM,FNAME,IEN,IND,KEYWORD,NKW,NSFILE,SFILE
- D EN^DDIOL("Search PCE files for keywords.")
- ;Get the list of files to search.
- D GETFLIST(.NSFILE,.SFILE)
- I NSFILE=0 Q
- ;Prompt for case-sensitive.
- S CASESEN=$$CASESEN
- I CASESEN["^" Q
- ;Get the list of keywords.
- D GETKWS(CASESEN,.NKW,.KEYWORD)
- I NKW=0 Q
- K ^TMP($J,"KWS"),^TMP($J,"KWSIEN")
- F IND=1:1:NSFILE D
- . S FNAME=$P(SFILE(IND),U,1)
- . S FILENUM=$P(SFILE(IND),U,2)
- . S GBL="^"_$P(SFILE(IND),U,3)
- . D EN^DDIOL("Searching "_FNAME_" ...")
- . S IEN=0
- . F S IEN=+$O(@GBL@(IEN)) Q:IEN=0 D SRCHTEXT(FILENUM,IEN,CASESEN,NKW,.KEYWORD)
- D DISPLAY(CASESEN,NKW,.KEYWORD)
- Q
- ;
- ;=====================================
- SRCHTEXT(FILENUM,IEN,CASESEN,NKW,KEYWORD) ;Search the text of an entry.
- N DIQOUT,IENS,IND,FIELD,FNUM,LABEL,LN,MSG,MTEMP,NM,TEMP
- D GETS^DIQ(FILENUM,IEN,"**","N","DIQOUT","MSG")
- S FNUM="",NM=0
- F S FNUM=$O(DIQOUT(FNUM)) Q:FNUM="" D
- . S IENS=""
- . F S IENS=$O(DIQOUT(FNUM,IENS)) Q:IENS="" D
- .. S FIELD=""
- .. F S FIELD=$O(DIQOUT(FNUM,IENS,FIELD)) Q:FIELD="" D
- ... S TEMP=DIQOUT(FNUM,IENS,FIELD)
- ... S MTEMP=$S(CASESEN:TEMP,1:$$UP^XLFSTR(TEMP))
- ... F IND=1:1:NKW I MTEMP[KEYWORD(IND) D
- .... S ^TMP($J,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD)=TEMP_U_KEYWORD(IND)
- .... S NM=NM+1
- ... S LN=""
- ... F S LN=$O(DIQOUT(FNUM,IENS,FIELD,LN)) Q:LN="" D
- .... ;S TEMP=DIQOUT(FNUM,IENS,FIELD)
- .... S TEMP=DIQOUT(FNUM,IENS,FIELD,LN)
- .... S MTEMP=$S(CASESEN:TEMP,1:$$UP^XLFSTR(TEMP))
- .... F IND=1:1:NKW I MTEMP[KEYWORD(IND) D
- ..... S ^TMP($J,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD,LN)=TEMP_U_KEYWORD(IND)
- ..... S NM=NM+1
- I NM>0 S ^TMP($J,"KWS",FILENUM,IEN)=NM
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKWSRCH 6886 printed Jan 18, 2025@03:30:34 Page 2
- PXKWSRCH ;SLC/PKR - Keyword search routines. ;02/24/2016
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
- +2 ;
- +3 ;=====================================
- CASESEN() ;Ask the user if the search is case sensitive.
- +1 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="YA"
- +3 SET DIR("A")="Should the search be case-sensitive? "
- +4 SET DIR("B")="N"
- +5 DO ^DIR
- +6 IF $DATA(DIRUT)
- SET Y="^"
- +7 QUIT Y
- +8 ;
- +9 ;=====================================
- DISPLAY(CASESEN,NKW,KEYWORD) ;Display the search results.
- +1 NEW ENAME,FIELD,FILENUM,FLABEL,FNUM,GNAME,GNAMELST,IEN,IENS,IND
- +2 NEW LABEL,LN,NIEN,NL,NM,TEMP,TEXT
- +3 SET NL=0
- +4 SET NL=NL+1
- SET TEXT(NL)="The search was for the following keywords:"
- +5 FOR IND=1:1:NKW
- SET NL=NL+1
- SET TEXT(NL)=" "_KEYWORD(IND)
- +6 SET FILENUM=""
- +7 FOR
- SET FILENUM=$ORDER(^TMP($JOB,"KWS",FILENUM))
- if FILENUM=""
- QUIT
- Begin DoDot:1
- +8 SET GNAME=$$GET1^DID(FILENUM,"","","NAME")
- +9 SET GNAMELST(GNAME,FILENUM)=""
- End DoDot:1
- +10 SET GNAME=""
- +11 FOR
- SET GNAME=$ORDER(GNAMELST(GNAME))
- if GNAME=""
- QUIT
- Begin DoDot:1
- +12 IF NL>1
- SET NL=NL+1
- SET TEXT(NL)=""
- +13 SET NL=NL+1
- SET TEXT(NL)="File: "_GNAME
- +14 SET FILENUM=$ORDER(GNAMELST(GNAME,FILENUM))
- +15 SET IEN=""
- SET NIEN=0
- +16 FOR
- SET IEN=$ORDER(^TMP($JOB,"KWS",FILENUM,IEN))
- if IEN=""
- QUIT
- Begin DoDot:2
- +17 SET ENAME=$$GET1^DIQ(FILENUM,IEN,.01)
- +18 SET NIEN=NIEN+1
- +19 IF NIEN>1
- SET NL=NL+1
- SET TEXT(NL)=""
- +20 SET NM=^TMP($JOB,"KWS",FILENUM,IEN)
- +21 SET NL=NL+1
- SET TEXT(NL)=" Entry "_ENAME_" (IEN="_IEN_") contains "_NM_" match"_$SELECT(NM>1:"es.",1:".")
- +22 SET FNUM=""
- +23 FOR
- SET FNUM=$ORDER(^TMP($JOB,"KWSIEN",FILENUM,IEN,FNUM))
- if FNUM=""
- QUIT
- Begin DoDot:3
- +24 SET IENS=""
- +25 FOR
- SET IENS=$ORDER(^TMP($JOB,"KWSIEN",FILENUM,IEN,FNUM,IENS))
- if IENS=""
- QUIT
- Begin DoDot:4
- +26 SET FIELD=""
- +27 FOR
- SET FIELD=$ORDER(^TMP($JOB,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD))
- if FIELD=""
- QUIT
- Begin DoDot:5
- +28 IF '$DATA(FLABEL(FNUM,FIELD))
- SET FLABEL(FNUM,FIELD)=$$FLABEL(FNUM,FIELD)
- +29 SET NL=NL+1
- SET TEXT(NL)=" Found in field "_FLABEL(FNUM,FIELD)_" the text is:"
- +30 SET TEMP=$GET(^TMP($JOB,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD))
- +31 IF TEMP'=""
- SET NL=NL+1
- SET TEXT(NL)=" "_$$HLITE(TEMP,CASESEN)
- +32 SET LN=0
- +33 FOR
- SET LN=$ORDER(^TMP($JOB,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD,LN))
- if LN=""
- QUIT
- Begin DoDot:6
- +34 SET TEMP=$GET(^TMP($JOB,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD,LN))
- +35 IF TEMP'=""
- SET NL=NL+1
- SET TEXT(NL)=" "_$$HLITE(TEMP,CASESEN)
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +36 IF NL=(NKW+1)
- SET NL=NL+1
- SET TEXT(NL)="No matches were found."
- +37 DO BROWSE^DDBR("TEXT","ANR","Text/Keyword Search")
- +38 KILL ^TMP($JOB,"KWS"),^TMP($JOB,"KWSIEN")
- +39 QUIT
- +40 ;
- +41 ;=====================================
- FLABEL(FNUM,FIELD) ;Return the label for a field.
- +1 NEW DATA
- +2 DO FIELD^DID(FNUM,FIELD,"N","LABEL","DATA")
- +3 QUIT DATA("LABEL")
- +4 ;
- +5 ;=====================================
- GETFLIST(NSFILE,SFILE) ;Get the list of files to search.
- +1 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,FLIST,IND,LNUM,NFILES,X,Y
- +2 SET FLIST(1)="1. ^Education Topics^9999999.09^AUTTEDT"
- +3 SET FLIST(2)="2. ^Exam^9999999.15^AUTTEXAM"
- +4 SET FLIST(3)="3. ^Health Factors^9999999.64^AUTTHF"
- +5 SET FLIST(4)="4. ^Immunizations^9999999.14^AUTTIMM"
- +6 SET FLIST(5)="5. ^Skin Test^9999999.28^AUTTSK"
- +7 SET DIR(0)="LA^1:5"
- +8 SET DIR("A")="Select the files to search: "
- +9 FOR IND=1:1:5
- SET DIR("A",IND)=$PIECE(FLIST(IND),U,1)_$PIECE(FLIST(IND),U,2)
- +10 DO EN^DDIOL("Select from the following list of files:")
- +11 DO ^DIR
- +12 IF Y["^"!$GET(DIROUT)
- SET NSFILE=0
- QUIT
- +13 SET NSFILE=$LENGTH(Y,",")-1
- +14 FOR IND=1:1:NSFILE
- Begin DoDot:1
- +15 SET LNUM=$PIECE(Y,",",IND)
- +16 SET SFILE(IND)=$PIECE(FLIST(LNUM),U,2,4)
- End DoDot:1
- +17 QUIT
- +18 ;
- +19 ;=====================================
- GETKWS(CASESEN,NKW,KEYWORD) ;Have the user input the key words.
- +1 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
- +2 SET NKW=0
- +3 DO EN^DDIOL("Input the keywords, one per line. Enter NULL or '^' to exit.")
- +4 SET DIR(0)="FAOU^2:45"
- +5 SET DIR("A")="Input a keyword: "
- +6 SET DONE=0
- +7 FOR
- if DONE
- QUIT
- Begin DoDot:1
- +8 DO ^DIR
- +9 IF (Y="^")!(Y="")!$GET(DIROUT)
- SET DONE=1
- QUIT
- +10 SET NKW=NKW+1
- +11 SET KEYWORD(NKW)=$SELECT(CASESEN:Y,1:$$UP^XLFSTR(Y))
- End DoDot:1
- +12 QUIT
- +13 ;
- +14 ;=====================================
- GSEARCH ;Entry point for general selection of global to search.
- +1 NEW CASESEN,DIC,FILENUM,FNAME,GBL,IEN,KEYWORD,NKW,X,Y
- +2 ;Prompt the user for the file that want to search.
- +3 SET DIC=1
- SET DIC(0)="AEMNV"
- +4 SET DIC("A")="Select a file to search: "
- +5 DO ^DIC
- +6 IF Y=-1
- QUIT
- +7 SET FILENUM=$PIECE(Y,U,1)
- +8 SET FNAME=$PIECE(Y,U,2)
- +9 SET GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
- +10 SET GBL=$$CREF^DILF(GBL)
- +11 ;Prompt for case-sensitive.
- +12 SET CASESEN=$$CASESEN
- +13 IF CASESEN["^"
- QUIT
- +14 ;Get the list of keywords.
- +15 DO GETKWS(CASESEN,.NKW,.KEYWORD)
- +16 IF NKW=0
- QUIT
- +17 KILL ^TMP($JOB,"KWS"),^TMP($JOB,"KWSIEN")
- +18 DO EN^DDIOL("Searching "_FNAME_" ...")
- +19 SET IEN=0
- +20 FOR
- SET IEN=+$ORDER(@GBL@(IEN))
- if IEN=0
- QUIT
- DO SRCHTEXT(FILENUM,IEN,CASESEN,NKW,.KEYWORD)
- +21 DO DISPLAY(CASESEN,NKW,.KEYWORD)
- +22 QUIT
- +23 ;
- +24 ;=====================================
- HLITE(TEXT,CASESEN) ;Mark the keyword so it will be highlighted in the Browser.
- +1 NEW FIND,KEYWORD,HTEXT,LKW,MKEY,MTEXT,START,STOP,TAG,TAGBEG,TAGEND,TTEXT
- +2 SET TTEXT=$PIECE(TEXT,U,1)
- +3 SET MTEXT=$SELECT(CASESEN:TTEXT,1:$$UP^XLFSTR(TTEXT))
- +4 SET KEYWORD=$PIECE(TEXT,U,2)
- +5 SET MKEY=$SELECT(CASESEN:KEYWORD,1:$$UP^XLFSTR(KEYWORD))
- +6 SET LKW=$LENGTH(KEYWORD)
- +7 SET FIND=1
- SET HTEXT=""
- SET START=1
- +8 FOR
- if FIND=0
- QUIT
- Begin DoDot:1
- +9 SET FIND=$FIND(MTEXT,MKEY,FIND)
- +10 IF FIND=0
- QUIT
- +11 SET TAGBEG=FIND-LKW
- +12 SET TAGEND=FIND-1
- +13 SET STOP=TAGEND-LKW
- +14 SET TAG="$.%^"_$EXTRACT(TTEXT,TAGBEG,TAGEND)_"$.%"
- +15 SET HTEXT=HTEXT_$EXTRACT(TTEXT,START,STOP)_TAG
- +16 SET START=FIND
- End DoDot:1
- +17 SET HTEXT=HTEXT_$EXTRACT(TTEXT,START,$LENGTH(TTEXT))
- +18 QUIT HTEXT
- +19 ;
- +20 ;=====================================
- SEARCH ;Perform the keyword search.
- +1 NEW CASESEN,FILENUM,FNAME,IEN,IND,KEYWORD,NKW,NSFILE,SFILE
- +2 DO EN^DDIOL("Search PCE files for keywords.")
- +3 ;Get the list of files to search.
- +4 DO GETFLIST(.NSFILE,.SFILE)
- +5 IF NSFILE=0
- QUIT
- +6 ;Prompt for case-sensitive.
- +7 SET CASESEN=$$CASESEN
- +8 IF CASESEN["^"
- QUIT
- +9 ;Get the list of keywords.
- +10 DO GETKWS(CASESEN,.NKW,.KEYWORD)
- +11 IF NKW=0
- QUIT
- +12 KILL ^TMP($JOB,"KWS"),^TMP($JOB,"KWSIEN")
- +13 FOR IND=1:1:NSFILE
- Begin DoDot:1
- +14 SET FNAME=$PIECE(SFILE(IND),U,1)
- +15 SET FILENUM=$PIECE(SFILE(IND),U,2)
- +16 SET GBL="^"_$PIECE(SFILE(IND),U,3)
- +17 DO EN^DDIOL("Searching "_FNAME_" ...")
- +18 SET IEN=0
- +19 FOR
- SET IEN=+$ORDER(@GBL@(IEN))
- if IEN=0
- QUIT
- DO SRCHTEXT(FILENUM,IEN,CASESEN,NKW,.KEYWORD)
- End DoDot:1
- +20 DO DISPLAY(CASESEN,NKW,.KEYWORD)
- +21 QUIT
- +22 ;
- +23 ;=====================================
- SRCHTEXT(FILENUM,IEN,CASESEN,NKW,KEYWORD) ;Search the text of an entry.
- +1 NEW DIQOUT,IENS,IND,FIELD,FNUM,LABEL,LN,MSG,MTEMP,NM,TEMP
- +2 DO GETS^DIQ(FILENUM,IEN,"**","N","DIQOUT","MSG")
- +3 SET FNUM=""
- SET NM=0
- +4 FOR
- SET FNUM=$ORDER(DIQOUT(FNUM))
- if FNUM=""
- QUIT
- Begin DoDot:1
- +5 SET IENS=""
- +6 FOR
- SET IENS=$ORDER(DIQOUT(FNUM,IENS))
- if IENS=""
- QUIT
- Begin DoDot:2
- +7 SET FIELD=""
- +8 FOR
- SET FIELD=$ORDER(DIQOUT(FNUM,IENS,FIELD))
- if FIELD=""
- QUIT
- Begin DoDot:3
- +9 SET TEMP=DIQOUT(FNUM,IENS,FIELD)
- +10 SET MTEMP=$SELECT(CASESEN:TEMP,1:$$UP^XLFSTR(TEMP))
- +11 FOR IND=1:1:NKW
- IF MTEMP[KEYWORD(IND)
- Begin DoDot:4
- +12 SET ^TMP($JOB,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD)=TEMP_U_KEYWORD(IND)
- +13 SET NM=NM+1
- End DoDot:4
- +14 SET LN=""
- +15 FOR
- SET LN=$ORDER(DIQOUT(FNUM,IENS,FIELD,LN))
- if LN=""
- QUIT
- Begin DoDot:4
- +16 ;S TEMP=DIQOUT(FNUM,IENS,FIELD)
- +17 SET TEMP=DIQOUT(FNUM,IENS,FIELD,LN)
- +18 SET MTEMP=$SELECT(CASESEN:TEMP,1:$$UP^XLFSTR(TEMP))
- +19 FOR IND=1:1:NKW
- IF MTEMP[KEYWORD(IND)
- Begin DoDot:5
- +20 SET ^TMP($JOB,"KWSIEN",FILENUM,IEN,FNUM,IENS,FIELD,LN)=TEMP_U_KEYWORD(IND)
- +21 SET NM=NM+1
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 IF NM>0
- SET ^TMP($JOB,"KWS",FILENUM,IEN)=NM
- +23 QUIT
- +24 ;