PXRMSINQ ;SLC/PKR - Reminder simple inquiry routines ;03/14/2013
;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
;===================================
BROWSE(FILENUM,FLDLIST,IEN) ;Display the details of an entry using the
;FileMan Browser.
I '$$FIND1^DIC(FILENUM,"","AQU",IEN) Q
N BOP,NL,OUTPUT,TITLE,X
D GETTEXT(FILENUM,FLDLIST,IEN,.NL,.OUTPUT)
S BOP=$$BORP^PXRMUTIL("B")
I BOP="B" D
. S X="IORESET"
. D ENDR^%ZISS
. S TITLE=$$GET1^DID(FILENUM,"","","NAME")_" INQUIRY for IEN="_IEN
. D BROWSE^DDBR("OUTPUT","NR",TITLE)
. W IORESET
. D KILL^%ZISS
I BOP="P" D GPRINT^PXRMUTIL("OUTPUT")
Q
;
;===================================
CLBROWSE(FILENUM,FLDLIST,IEN) ;Display the details of an entry's Change
;Log using the FileMan Browser.
I '$$FIND1^DIC(FILENUM,"","AQU",IEN) Q
N BOP,NL,OUTPUT,TITLE,X
D GETEH(FILENUM,FLDLIST,IEN,.NL,.OUTPUT)
S BOP=$$BORP^PXRMUTIL("B")
I BOP="B" D
. S X="IORESET"
. D ENDR^%ZISS
. S TITLE=$$GET1^DID(FILENUM,"","","NAME")_" Change Log for IEN="_IEN
. D BROWSE^DDBR("OUTPUT","NR",TITLE)
. W IORESET
. D KILL^%ZISS
I BOP="P" D GPRINT^PXRMUTIL("OUTPUT")
Q
;
;===================================
GETEH(FILENUM,FLDLST,IEN,NL,OUTPUT) ;Get the edit history.
N IND,NLINES,TEXT
D GETTEXT(FILENUM,FLDLST,IEN,.NLINES,.TEXT)
I '$D(TEXT) S OUTPUT(1)="No edits have been made." Q
S NL=0
F IND=2:1:NLINES D
. I TEXT(IND)["Edit Date:" D Q
.. I NL>0 S NL=NL+1,OUTPUT(NL)=" "
.. S NL=NL+1,OUTPUT(NL)=TEXT(IND+1)_" on"_$P(TEXT(IND),"Edit Date:",2)
.. S IND=IND+1
. I TEXT(IND)["Edit Comments" Q
. S NL=NL+1,OUTPUT(NL)=TEXT(IND)
Q
;
;===================================
GETTEXT(FILENUM,FLDLIST,IEN,NL,OUTPUT) ;Get the requested contents of an entry.
;FILENUM - file number
;IEN - internal entry number
;OUTPUT - array where text is returned.
;FLDLIST - a semicolon separated list of fields to include in the
;output. A piece can be a single field number, a range of fields
;in the form FM:FN, or a multiple in the form FN*. Each piece will
;be preceeded by a blank line. Example: ".01;10;15*;100:102"
;This will get the .01, a blank line and field 10, a blank line
;followed by the contents of multiple 15, a blank line followed by
;the contents of fields 100 through 102.
;text in OUTPUT.
N DIQOUT,IENS,IND,INDENT,FIELD,FLABEL,FLDIND,FLDNUM,FNUM,JND
N MSG,MULT,NIN,NOUT,TEMP,TEXTIN,TEXTOUT,TITLE,WPF
S NL=0
F FLDIND=1:1:$L(FLDLIST,";") D
. S FLDNUM=$P(FLDLIST,";",FLDIND)
. K DIQOUT
. D GETS^DIQ(FILENUM,IEN,FLDNUM,"N","DIQOUT","MSG")
. I $D(DIQOUT)=0 Q
.;Preceed each group of fields with a blank line.
. I NL>0 S NL=NL+1,OUTPUT(NL)=" "
. S FNUM="",MULT=0
. F S FNUM=$O(DIQOUT(FNUM)) Q:FNUM="" D
.. I FNUM'=FILENUM D
... S MULT=1
...;DBIA #4768
... S TEXTIN=$$TITLE^XLFSTR($O(^DD(FNUM,0,"NM","")))
... D FORMATS^PXRMTEXT(1,80,TEXTIN,.NOUT,.TEXTOUT)
... F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
.. 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 FLABEL=$$GET1^DID(FNUM,FIELD,"","LABEL")
.... S FLABEL=$$TITLE^XLFSTR(FLABEL)
....;Check for a word-processing field.
.... S TEMP=DIQOUT(FNUM,IENS,FIELD)
.... S WPF=$S(TEMP["DIQOUT":1,1:0)
.... I WPF D Q
..... S NL=NL+1,OUTPUT(NL)=FLABEL_":"
..... S JND=0
.....;Do not format word-processing fields so the original is displayed.
..... F S JND=$O(DIQOUT(FNUM,IENS,FIELD,JND)) Q:JND="" S NL=NL+1,OUTPUT(NL)=DIQOUT(FNUM,IENS,FIELD,JND)
.... S TEXTIN=$$TITLE^XLFSTR(FLABEL)_": "_DIQOUT(FNUM,IENS,FIELD)
.... S INDENT=$S(MULT:2,1:1)
.... D FORMATS^PXRMTEXT(INDENT,80,TEXTIN,.NOUT,.TEXTOUT)
.... F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
Q
;
;===================================
LMBROWSE(FILENUM,FLDLIST,IEN) ;Display the details of an entry using the
;FileMan Browser. For use by a ListManager application.
I '$$FIND1^DIC(FILENUM,"","AQU",IEN) Q
N BOP,NL,OUTPUT,TITLE
D GETTEXT(FILENUM,FLDLIST,IEN,.NL,.OUTPUT)
D FULL^VALM1
S BOP=$$BORP^PXRMUTIL("B")
I BOP="B" D
. S TITLE=$$GET1^DID(FILENUM,"","","NAME")_" INQUIRY for IEN="_IEN
. D BROWSE^DDBR("OUTPUT","NR",TITLE)
I BOP="P" D
. D GPRINT^PXRMUTIL("OUTPUT")
. S VALMBCK="R"
Q
;
;===================================
LMCLBROW(FILENUM,FLDLIST,IEN) ;Display the details of an entry's edit history
;using the FileMan Browser. For use by a ListManager application.
I '$$FIND1^DIC(FILENUM,"","AQU",IEN) Q
N BOP,NL,OUTPUT,TITLE
D GETEH(FILENUM,FLDLIST,IEN,.NL,.OUTPUT)
D FULL^VALM1
S BOP=$$BORP^PXRMUTIL("B")
I BOP="B" D
. S TITLE=$$GET1^DID(FILENUM,"","","NAME")_" Change Log for IEN="_IEN
. D BROWSE^DDBR("OUTPUT","NR",TITLE)
I BOP="P" D
. D GPRINT^PXRMUTIL("OUTPUT")
. S VALMBCK="R"
Q
;
;===================================
TEST(FILENUM,IEN) ;Test driver.
N FLDLIST
I FILENUM=801 S FLDLIST=".01;10;15*;20*;30*;100:102"
I FILENUM=803 S FLDLIST=".01:15;30*;40*;45*;50*;100:102"
I FILENUM=803.2 S FLDLIST=".01:5;20:24;100:102"
I FILENUM=810.9 S FLDLIST=".01;1;40.7*;44*;100:102"
D BROWSE(FILENUM,FLDLIST,IEN)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSINQ 5201 printed Oct 16, 2024@17:49:59 Page 2
PXRMSINQ ;SLC/PKR - Reminder simple inquiry routines ;03/14/2013
+1 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404
+2 ;===================================
BROWSE(FILENUM,FLDLIST,IEN) ;Display the details of an entry using the
+1 ;FileMan Browser.
+2 IF '$$FIND1^DIC(FILENUM,"","AQU",IEN)
QUIT
+3 NEW BOP,NL,OUTPUT,TITLE,X
+4 DO GETTEXT(FILENUM,FLDLIST,IEN,.NL,.OUTPUT)
+5 SET BOP=$$BORP^PXRMUTIL("B")
+6 IF BOP="B"
Begin DoDot:1
+7 SET X="IORESET"
+8 DO ENDR^%ZISS
+9 SET TITLE=$$GET1^DID(FILENUM,"","","NAME")_" INQUIRY for IEN="_IEN
+10 DO BROWSE^DDBR("OUTPUT","NR",TITLE)
+11 WRITE IORESET
+12 DO KILL^%ZISS
End DoDot:1
+13 IF BOP="P"
DO GPRINT^PXRMUTIL("OUTPUT")
+14 QUIT
+15 ;
+16 ;===================================
CLBROWSE(FILENUM,FLDLIST,IEN) ;Display the details of an entry's Change
+1 ;Log using the FileMan Browser.
+2 IF '$$FIND1^DIC(FILENUM,"","AQU",IEN)
QUIT
+3 NEW BOP,NL,OUTPUT,TITLE,X
+4 DO GETEH(FILENUM,FLDLIST,IEN,.NL,.OUTPUT)
+5 SET BOP=$$BORP^PXRMUTIL("B")
+6 IF BOP="B"
Begin DoDot:1
+7 SET X="IORESET"
+8 DO ENDR^%ZISS
+9 SET TITLE=$$GET1^DID(FILENUM,"","","NAME")_" Change Log for IEN="_IEN
+10 DO BROWSE^DDBR("OUTPUT","NR",TITLE)
+11 WRITE IORESET
+12 DO KILL^%ZISS
End DoDot:1
+13 IF BOP="P"
DO GPRINT^PXRMUTIL("OUTPUT")
+14 QUIT
+15 ;
+16 ;===================================
GETEH(FILENUM,FLDLST,IEN,NL,OUTPUT) ;Get the edit history.
+1 NEW IND,NLINES,TEXT
+2 DO GETTEXT(FILENUM,FLDLST,IEN,.NLINES,.TEXT)
+3 IF '$DATA(TEXT)
SET OUTPUT(1)="No edits have been made."
QUIT
+4 SET NL=0
+5 FOR IND=2:1:NLINES
Begin DoDot:1
+6 IF TEXT(IND)["Edit Date:"
Begin DoDot:2
+7 IF NL>0
SET NL=NL+1
SET OUTPUT(NL)=" "
+8 SET NL=NL+1
SET OUTPUT(NL)=TEXT(IND+1)_" on"_$PIECE(TEXT(IND),"Edit Date:",2)
+9 SET IND=IND+1
End DoDot:2
QUIT
+10 IF TEXT(IND)["Edit Comments"
QUIT
+11 SET NL=NL+1
SET OUTPUT(NL)=TEXT(IND)
End DoDot:1
+12 QUIT
+13 ;
+14 ;===================================
GETTEXT(FILENUM,FLDLIST,IEN,NL,OUTPUT) ;Get the requested contents of an entry.
+1 ;FILENUM - file number
+2 ;IEN - internal entry number
+3 ;OUTPUT - array where text is returned.
+4 ;FLDLIST - a semicolon separated list of fields to include in the
+5 ;output. A piece can be a single field number, a range of fields
+6 ;in the form FM:FN, or a multiple in the form FN*. Each piece will
+7 ;be preceeded by a blank line. Example: ".01;10;15*;100:102"
+8 ;This will get the .01, a blank line and field 10, a blank line
+9 ;followed by the contents of multiple 15, a blank line followed by
+10 ;the contents of fields 100 through 102.
+11 ;text in OUTPUT.
+12 NEW DIQOUT,IENS,IND,INDENT,FIELD,FLABEL,FLDIND,FLDNUM,FNUM,JND
+13 NEW MSG,MULT,NIN,NOUT,TEMP,TEXTIN,TEXTOUT,TITLE,WPF
+14 SET NL=0
+15 FOR FLDIND=1:1:$LENGTH(FLDLIST,";")
Begin DoDot:1
+16 SET FLDNUM=$PIECE(FLDLIST,";",FLDIND)
+17 KILL DIQOUT
+18 DO GETS^DIQ(FILENUM,IEN,FLDNUM,"N","DIQOUT","MSG")
+19 IF $DATA(DIQOUT)=0
QUIT
+20 ;Preceed each group of fields with a blank line.
+21 IF NL>0
SET NL=NL+1
SET OUTPUT(NL)=" "
+22 SET FNUM=""
SET MULT=0
+23 FOR
SET FNUM=$ORDER(DIQOUT(FNUM))
if FNUM=""
QUIT
Begin DoDot:2
+24 IF FNUM'=FILENUM
Begin DoDot:3
+25 SET MULT=1
+26 ;DBIA #4768
+27 SET TEXTIN=$$TITLE^XLFSTR($ORDER(^DD(FNUM,0,"NM","")))
+28 DO FORMATS^PXRMTEXT(1,80,TEXTIN,.NOUT,.TEXTOUT)
+29 FOR IND=1:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=TEXTOUT(IND)
End DoDot:3
+30 SET IENS=""
+31 FOR
SET IENS=$ORDER(DIQOUT(FNUM,IENS))
if IENS=""
QUIT
Begin DoDot:3
+32 SET FIELD=""
+33 FOR
SET FIELD=$ORDER(DIQOUT(FNUM,IENS,FIELD))
if FIELD=""
QUIT
Begin DoDot:4
+34 SET FLABEL=$$GET1^DID(FNUM,FIELD,"","LABEL")
+35 SET FLABEL=$$TITLE^XLFSTR(FLABEL)
+36 ;Check for a word-processing field.
+37 SET TEMP=DIQOUT(FNUM,IENS,FIELD)
+38 SET WPF=$SELECT(TEMP["DIQOUT":1,1:0)
+39 IF WPF
Begin DoDot:5
+40 SET NL=NL+1
SET OUTPUT(NL)=FLABEL_":"
+41 SET JND=0
+42 ;Do not format word-processing fields so the original is displayed.
+43 FOR
SET JND=$ORDER(DIQOUT(FNUM,IENS,FIELD,JND))
if JND=""
QUIT
SET NL=NL+1
SET OUTPUT(NL)=DIQOUT(FNUM,IENS,FIELD,JND)
End DoDot:5
QUIT
+44 SET TEXTIN=$$TITLE^XLFSTR(FLABEL)_": "_DIQOUT(FNUM,IENS,FIELD)
+45 SET INDENT=$SELECT(MULT:2,1:1)
+46 DO FORMATS^PXRMTEXT(INDENT,80,TEXTIN,.NOUT,.TEXTOUT)
+47 FOR IND=1:1:NOUT
SET NL=NL+1
SET OUTPUT(NL)=TEXTOUT(IND)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
+50 ;===================================
LMBROWSE(FILENUM,FLDLIST,IEN) ;Display the details of an entry using the
+1 ;FileMan Browser. For use by a ListManager application.
+2 IF '$$FIND1^DIC(FILENUM,"","AQU",IEN)
QUIT
+3 NEW BOP,NL,OUTPUT,TITLE
+4 DO GETTEXT(FILENUM,FLDLIST,IEN,.NL,.OUTPUT)
+5 DO FULL^VALM1
+6 SET BOP=$$BORP^PXRMUTIL("B")
+7 IF BOP="B"
Begin DoDot:1
+8 SET TITLE=$$GET1^DID(FILENUM,"","","NAME")_" INQUIRY for IEN="_IEN
+9 DO BROWSE^DDBR("OUTPUT","NR",TITLE)
End DoDot:1
+10 IF BOP="P"
Begin DoDot:1
+11 DO GPRINT^PXRMUTIL("OUTPUT")
+12 SET VALMBCK="R"
End DoDot:1
+13 QUIT
+14 ;
+15 ;===================================
LMCLBROW(FILENUM,FLDLIST,IEN) ;Display the details of an entry's edit history
+1 ;using the FileMan Browser. For use by a ListManager application.
+2 IF '$$FIND1^DIC(FILENUM,"","AQU",IEN)
QUIT
+3 NEW BOP,NL,OUTPUT,TITLE
+4 DO GETEH(FILENUM,FLDLIST,IEN,.NL,.OUTPUT)
+5 DO FULL^VALM1
+6 SET BOP=$$BORP^PXRMUTIL("B")
+7 IF BOP="B"
Begin DoDot:1
+8 SET TITLE=$$GET1^DID(FILENUM,"","","NAME")_" Change Log for IEN="_IEN
+9 DO BROWSE^DDBR("OUTPUT","NR",TITLE)
End DoDot:1
+10 IF BOP="P"
Begin DoDot:1
+11 DO GPRINT^PXRMUTIL("OUTPUT")
+12 SET VALMBCK="R"
End DoDot:1
+13 QUIT
+14 ;
+15 ;===================================
TEST(FILENUM,IEN) ;Test driver.
+1 NEW FLDLIST
+2 IF FILENUM=801
SET FLDLIST=".01;10;15*;20*;30*;100:102"
+3 IF FILENUM=803
SET FLDLIST=".01:15;30*;40*;45*;50*;100:102"
+4 IF FILENUM=803.2
SET FLDLIST=".01:5;20:24;100:102"
+5 IF FILENUM=810.9
SET FLDLIST=".01;1;40.7*;44*;100:102"
+6 DO BROWSE(FILENUM,FLDLIST,IEN)
+7 QUIT
+8 ;
