Routine: INHMS2

INHMS2 ;JSH,DJL; 25 Sep 97 13:01;Interface - Message Search

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

LIST(INQUIT,IND,INSRCH,DWLRF,INRVSRCH,INL,INSRCHCT) ; Build the msg. array

 ; MODULE NAME: LIST ( Build the list of matching messages )

 ; DESCRIPTION:

 ; loop through the messages from date-start to date-end and

 ; give the user a progress indicator

 ; PARAMETERS:

 ;    INQUIT = 0 = The program completed properly

 ;             1 = No matching messages were found

 ;    IND = The starting time/date of the search set from information

 ;          in INSRCH and determined by INRVSRCH flag

 ;    INSRCH = Array for holding search criteria information

 ;    DWLRF = Settings for the Display Processor

 ;    INRVSRCH = Flag set user indicating direction of the search

 ;          -1 = (default)a reverse listing order. Newest to Oldest

 ;           0 = a forward search listing order. Oldest to Newest

 ;    INL = Array used to load with message items matching the criteria

 ;    INSRCHCT = The combined count of message items searched

 ; CODE BEGINS

 N INM,INFNDCT,INBLKCT,INNOMORE,INDSPSZ,DWLR

 S INDSPSZ=1000 ; max. num. of msg. for disp. progress

 S INFNDCT=$P(@DWLRF,U,2),INBLKCT=INFNDCT+19 ; INBLKCT=num. of msg./win.

 S:'IND IND=$O(^INTHU("B",IND),INRVSRCH)

 F  Q:$S('IND:1,(INRVSRCH>-1)&(IND>INSRCH("INEND")):1,(INRVSRCH=-1)&(IND<INSRCH("INSTART")):1,1:0)!(INFNDCT>(INBLKCT))  D  S IND=$O(^INTHU("B",IND),INRVSRCH)

 .  S INM="" F  S INM=$O(^INTHU("B",IND,INM),INRVSRCH) Q:'INM  D

 ..    D MSGTEST(INM,.DWLRF,.INSRCH,.INSRCHCT,.INFNDCT) I '(INSRCHCT#20) D MS^DWD("SEARCHING...  (APPROXIMATE) MESSAGES SEARCHED: "_INSRCHCT_"   MESSSAGES FOUND: "_INFNDCT)

 D MS^DWD("SEARCHING...  (APPROXIMATE) MESSAGES SEARCHED: "_INSRCHCT_"   MESSSAGES FOUND: "_INFNDCT)

 I '$O(@DWLRF@(0)) D MS^DWD("No Messages Found.") S INQUIT=$$CR^UTSRD,INQUIT=1 Q

 ; check for completion of search to terminate 'more' functionality

 S INNOMORE=0 S:$S('IND:1,(INRVSRCH>-1)&(IND>INSRCH("INEND")):1,(INRVSRCH=-1)&(IND<INSRCH("INSTART")):1,1:0) INNOMORE=1,$P(@DWLRF,U,2)=0

 S:'INNOMORE $P(@DWLRF,U,2)=INFNDCT

 S INQUIT=0

MSGTEST(INMIEN,INLIST,INSRCH,INSRCHCT,INFNDCT) ; Add matching msg. to array

 ; MODULE NAME: MSGTEST ( Interface Message Match Criteria Test )

 ; DESCRIPTION: Tests the message for matches to values passed in third

 ;              parameter array nodes and addes the IEN to the second

 ;              parameter array. Updates counters accordingly.

 ; RETURN = none

 ; PARAMETERS:

 ;    INMIEN= IEN into ^INTHU

 ;    INLIST = The NAME of the array to add items found

 ;    INSRCH = The array of items to find

 ;    INSRCHCT = The count of messages searched

 ;    INFNDCT = The count of messages found

 ; CODE BEGINS

 N INTEMPX,INMAXSZ

 S INMAXSZ=1100,INTEMPX=$G(^INTHU(INMIEN,0)),INSRCHCT=INSRCHCT+1

 I INSRCH("INDEST")]"",$P(INTEMPX,U,2)'=INSRCH("INDEST") Q

 I INSRCH("INSTAT")]"",$P(INTEMPX,U,3)'=INSRCH("INSTAT") Q

 I INSRCH("INID")]"",$P(INTEMPX,U,5)'=INSRCH("INID") Q

 I INSRCH("INSOURCE")]"",$E($P(INTEMPX,U,8),1,$L(INSRCH("INSOURCE")))'=INSRCH("INSOURCE") Q

 I INSRCH("INDIR")]"",$P(INTEMPX,U,10)'=INSRCH("INDIR") Q

 I INSRCH("INORIG")]"",$P(INTEMPX,U,11)'=INSRCH("INORIG") Q

 I INSRCH("INPAT")]"" Q:'$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))

 I $D(INSRCH("INTEXT"))>9 Q:'$$INMSRCH^INHMS1(.INSRCH,INMIEN,INSRCH("INTYPE"))

 ; move the found-items array to ^UTILITY if it's getting too large

 ; kill the new ^UTILITY space incase it already exists prior to merg

 I INFNDCT>INMAXSZ,(INLIST'[U) N INTEMPY S INTEMPY=INLIST,INLIST="^UTILITY(""INL"","_$J_"_"_DUZ_"_"_$P($H,",",2)_")" K @INLIST M @INLIST=@INTEMPY K @INTEMPY,INTEMPY

 S @INLIST@(INSRCHCT)=$$INMSGSTR(INMIEN,"",""),@INLIST@(INSRCHCT,0)=INMIEN,INFNDCT=INFNDCT+1

 I $G(INSRCH("INEXPAND")) S @INLIST@(INSRCHCT+.1)=$$INMSGSTR(INMIEN,"",$G(INSRCH("INEXPAND")))

INMSGSTR(INMSGIEN,INLABEL,INEXPAND) ; Build a string from msg. elements

 ; MODULE NAME: INMSGSTR ( Interface Message Listing String Builder )

 ; DESCRIPTION: Construct a string containing selected fields from

 ;              the message. Used to construct the string which is

 ;              displayed in the List Processor indicating messages

 ;              found to match the search criteria. Or consruct a

 ;              label used to identify the field to be listed.

 ; RETURN = The composite message string or

 ;          a string indicating error status

 ; PARAMETERS:

 ;    INMSGIEN= IEN into ^INTHU

 ;    INLABEL= Flag to return a string to be used as the title

 ;             containing the field labels used below.

 ;             0/null= no label requested

 ;             1= return the only the label

 ;    INEXPAND= Flag (1/0) to build expanded listing

 ; CODE BEGINS

 N INTEMP,INTDATE,INMSGID,INDEST,INMSGSTR,INMSGTXT,INDSTNUM,INPATNAM

 S INLABEL=$G(INLABEL),INEXPAND=$G(INEXPAND)

 ; build and return a title string if the flag is set

 I INLABEL,'INEXPAND S $E(INMSGSTR,3,17)="Date/Time",$E(INMSGSTR,23,40)="Message ID",$E(INMSGSTR,55,79)="Destination" Q INMSGSTR

 I INLABEL,INEXPAND S $E(INMSGSTR,3,17)="Date/Time",$E(INMSGSTR,23,37)="Message ID",$E(INMSGSTR,55,67)="Destination",$E(INMSGSTR,87,100)="Patient",$E(INMSGSTR,109,140)="Transaction Type" Q INMSGSTR

 S INMSGTXT=$G(^INTHU(INMSGIEN,0))

 Q:'$L(INMSGTXT) "No Message Information Found"

 S INTDATE=$TR($$CDATASC^%ZTFDT($P(INMSGTXT,U),1,2),":")

 S INMSGID=$P(INMSGTXT,U,5)

 S INDSTNUM=+$P(INMSGTXT,U,2),INDEST="" S:INDSTNUM INDEST=$P($G(^INRHD(INDSTNUM,0)),U)

 I 'INEXPAND S $E(INMSGSTR,1,17)=$E(INTDATE,1,19),$E(INMSGSTR,21,52)=$E(INMSGID,1,30),$E(INMSGSTR,53,79)=$E(INDEST,1,25) Q INMSGSTR

 I INEXPAND D  Q INMSGSTR

 .S INTEMP=$$INMSPAT^INHMS1(INMSGIEN,"",.INPATNAM)

 .S INORGTT=+$P(INMSGTXT,U,11),INOTT="" S:INORGTT INOTT=$P($G(^INRHT(INORGTT,0)),U)

 .S $E(INMSGSTR,5,25)=$E(INPATNAM,1,20),$E(INMSGSTR,27,75)=$E(INOTT,1,45)

 Q ""

POST(INNAME) ; Disply/Print messages

 ; MODULE NAME: POST ( Post-action logic on List Processor field )

 ; DESCRIPTION: Display/print messages using INH MESSAGE DISPLAY

 ;              template

 ; RETURN = none

 ; PARAMETERS:

 ;    INNAME= A NAME of an Array of IEN's into ^INTHU of messages

 ;            selected for displaying/printing

 ; CODE BEGINS

 N I,DIC,DR,DHD,DW,DWCP,INIO,DIE,DA

 I $O(@INNAME@(0)) D

 . D CLEAR^DW

 . S %ZIS="N" D ^%ZIS Q:POP  S INIO=IO,IOP=ION_";"_IOST_";"_IOM_";"_IOSL

 . S I=0 F  S I=$O(@INNAME@(I)) Q:'I  S DA(@INNAME@(I))=""

 . S DR="INH MESSAGE DISPLAY",DIC=4001,DHD="@" D PRTLIST^DWPR

 . S:INIO=IO X=$$CR^UTSRD

ERR(INMSG,INFSCRN,INCONT) ; Error/Information handler

 ; MODULE NAME: ERR ( Interface Message Error/Information Processor )

 ; DESCRIPTION:  ERR is a multi-functional message display utility for

 ;               handling user notification of errors and other messages

 ; RETURN = none

 ; PARAMETERS:

 ;     INMSG = a string to be displayed

 ;     INFSCRN =  flag to disable/enable the poping of a window

 ;                0=disable(default)

 ;                1=enable

 ;     INCONT = flag to disable/enable continuation prompting

 ;              0=disable(default)

 ;              1=enable

 ; CODE BEGINS

 N INTEMP

 S INMSG=$G(INMSG)

 D:$G(INFSCRN) MESS^DWD(5,10)

 ; org W !,INMSG

 W INMSG

 S:$G(INCONT) INTEMP=$$CR^UTSRD

INHMS2    ;JSH,DJL; 25 Sep 97 13:01;Interface - Message Search

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

LIST(INQUIT,IND,INSRCH,DWLRF,INRVSRCH,INL,INSRCHCT) ; Build the msg. array

 +1       ; MODULE NAME: LIST ( Build the list of matching messages )

 +2       ; DESCRIPTION:

 +3       ; loop through the messages from date-start to date-end and

 +4       ; give the user a progress indicator

 +5       ; PARAMETERS:

 +6       ;    INQUIT = 0 = The program completed properly

 +7       ;             1 = No matching messages were found

 +8       ;    IND = The starting time/date of the search set from information

 +9       ;          in INSRCH and determined by INRVSRCH flag

 +10      ;    INSRCH = Array for holding search criteria information

 +11      ;    DWLRF = Settings for the Display Processor

 +12      ;    INRVSRCH = Flag set user indicating direction of the search

 +13      ;          -1 = (default)a reverse listing order. Newest to Oldest

 +14      ;           0 = a forward search listing order. Oldest to Newest

 +15      ;    INL = Array used to load with message items matching the criteria

 +16      ;    INSRCHCT = The combined count of message items searched

 +17      ; CODE BEGINS

 +18       NEW INM,INFNDCT,INBLKCT,INNOMORE,INDSPSZ,DWLR

 +19      ; max. num. of msg. for disp. progress

           SET INDSPSZ=1000

 +20      ; INBLKCT=num. of msg./win.

           SET INFNDCT=$PIECE(@DWLRF,U,2)

           SET INBLKCT=INFNDCT+19

 +21       IF 'IND

               SET IND=$ORDER(^INTHU("B",IND),INRVSRCH)

 +22       FOR

               IF $SELECT('IND

                   QUIT

               Begin DoDot:1

 +23               SET INM=""

FOR

                       SET INM=$ORDER(^INTHU("B",IND,INM),INRVSRCH)

                       IF 'INM

                           QUIT

                       Begin DoDot:2

 +24                       DO MSGTEST(INM,.DWLRF,.INSRCH,.INSRCHCT,.INFNDCT)

                           IF '(INSRCHCT#20)

                               DO MS^DWD("SEARCHING...  (APPROXIMATE) MESSAGES SEARCHED: "_INSRCHCT_"   MESSSAGES FOUND: "_INFNDCT)

                       End DoDot:2

               End DoDot:1

               SET IND=$ORDER(^INTHU("B",IND),INRVSRCH)

 +25       DO MS^DWD("SEARCHING...  (APPROXIMATE) MESSAGES SEARCHED: "_INSRCHCT_"   MESSSAGES FOUND: "_INFNDCT)

 +26       IF '$ORDER(@DWLRF@(0))

               DO MS^DWD("No Messages Found.")

               SET INQUIT=$$CR^UTSRD

               SET INQUIT=1

               QUIT

 +27      ; check for completion of search to terminate 'more' functionality

 +28       SET INNOMORE=0

           IF $SELECT('IND

               SET INNOMORE=1

               SET $PIECE(@DWLRF,U,2)=0

 +29       IF 'INNOMORE

               SET $PIECE(@DWLRF,U,2)=INFNDCT

 +30       SET INQUIT=0

 +31       QUIT

 +32      ;

MSGTEST(INMIEN,INLIST,INSRCH,INSRCHCT,INFNDCT) ; Add matching msg. to array

 +1       ; MODULE NAME: MSGTEST ( Interface Message Match Criteria Test )

 +2       ; DESCRIPTION: Tests the message for matches to values passed in third

 +3       ;              parameter array nodes and addes the IEN to the second

 +4       ;              parameter array. Updates counters accordingly.

 +5       ; RETURN = none

 +6       ; PARAMETERS:

 +7       ;    INMIEN= IEN into ^INTHU

 +8       ;    INLIST = The NAME of the array to add items found

 +9       ;    INSRCH = The array of items to find

 +10      ;    INSRCHCT = The count of messages searched

 +11      ;    INFNDCT = The count of messages found

 +12      ; CODE BEGINS

 +13       NEW INTEMPX,INMAXSZ

 +14       SET INMAXSZ=1100

           SET INTEMPX=$GET(^INTHU(INMIEN,0))

           SET INSRCHCT=INSRCHCT+1

 +15       IF INSRCH("INDEST")]""

               IF $PIECE(INTEMPX,U,2)'=INSRCH("INDEST")

                   QUIT

 +16       IF INSRCH("INSTAT")]""

               IF $PIECE(INTEMPX,U,3)'=INSRCH("INSTAT")

                   QUIT

 +17       IF INSRCH("INID")]""

               IF $PIECE(INTEMPX,U,5)'=INSRCH("INID")

                   QUIT

 +18       IF INSRCH("INSOURCE")]""

               IF $EXTRACT($PIECE(INTEMPX,U,8),1,$LENGTH(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")

                   QUIT

 +19       IF INSRCH("INDIR")]""

               IF $PIECE(INTEMPX,U,10)'=INSRCH("INDIR")

                   QUIT

 +20       IF INSRCH("INORIG")]""

               IF $PIECE(INTEMPX,U,11)'=INSRCH("INORIG")

                   QUIT

 +21       IF INSRCH("INPAT")]""

               IF '$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))

                   QUIT

 +22       IF $DATA(INSRCH("INTEXT"))>9

               IF '$$INMSRCH^INHMS1(.INSRCH,INMIEN,INSRCH("INTYPE"))

                   QUIT

 +23      ; move the found-items array to ^UTILITY if it's getting too large

 +24      ; kill the new ^UTILITY space incase it already exists prior to merg

 +25       IF INFNDCT>INMAXSZ

               IF (INLIST'[U)

                   NEW INTEMPY

                   SET INTEMPY=INLIST

                   SET INLIST="^UTILITY(""INL"","_$JOB_"_"_DUZ_"_"_$PIECE($HOROLOG,",",2)_")"

                   KILL @INLIST

                   MERGE @INLIST=@INTEMPY

                   KILL @INTEMPY,INTEMPY

 +26       SET @INLIST@(INSRCHCT)=$$INMSGSTR(INMIEN,"","")

           SET @INLIST@(INSRCHCT,0)=INMIEN

           SET INFNDCT=INFNDCT+1

 +27       IF $GET(INSRCH("INEXPAND"))

               SET @INLIST@(INSRCHCT+.1)=$$INMSGSTR(INMIEN,"",$GET(INSRCH("INEXPAND")))

 +28       QUIT

 +29      ;

INMSGSTR(INMSGIEN,INLABEL,INEXPAND) ; Build a string from msg. elements

 +1       ; MODULE NAME: INMSGSTR ( Interface Message Listing String Builder )

 +2       ; DESCRIPTION: Construct a string containing selected fields from

 +3       ;              the message. Used to construct the string which is

 +4       ;              displayed in the List Processor indicating messages

 +5       ;              found to match the search criteria. Or consruct a

 +6       ;              label used to identify the field to be listed.

 +7       ; RETURN = The composite message string or

 +8       ;          a string indicating error status

 +9       ; PARAMETERS:

 +10      ;    INMSGIEN= IEN into ^INTHU

 +11      ;    INLABEL= Flag to return a string to be used as the title

 +12      ;             containing the field labels used below.

 +13      ;             0/null= no label requested

 +14      ;             1= return the only the label

 +15      ;    INEXPAND= Flag (1/0) to build expanded listing

 +16      ; CODE BEGINS

 +17       NEW INTEMP,INTDATE,INMSGID,INDEST,INMSGSTR,INMSGTXT,INDSTNUM,INPATNAM

 +18       SET INLABEL=$GET(INLABEL)

           SET INEXPAND=$GET(INEXPAND)

 +19      ; build and return a title string if the flag is set

 +20       IF INLABEL

               IF 'INEXPAND

                   SET $EXTRACT(INMSGSTR,3,17)="Date/Time"

                   SET $EXTRACT(INMSGSTR,23,40)="Message ID"

                   SET $EXTRACT(INMSGSTR,55,79)="Destination"

                   QUIT INMSGSTR

 +21       IF INLABEL

               IF INEXPAND

                   SET $EXTRACT(INMSGSTR,3,17)="Date/Time"

                   SET $EXTRACT(INMSGSTR,23,37)="Message ID"

                   SET $EXTRACT(INMSGSTR,55,67)="Destination"

                   SET $EXTRACT(INMSGSTR,87,100)="Patient"

                   SET $EXTRACT(INMSGSTR,109,140)="Transaction Type"

                   QUIT INMSGSTR

 +22       SET INMSGTXT=$GET(^INTHU(INMSGIEN,0))

 +23       IF '$LENGTH(INMSGTXT)

               QUIT "No Message Information Found"

 +24       SET INTDATE=$TRANSLATE($$CDATASC^%ZTFDT($PIECE(INMSGTXT,U),1,2),":")

 +25       SET INMSGID=$PIECE(INMSGTXT,U,5)

 +26       SET INDSTNUM=+$PIECE(INMSGTXT,U,2)

           SET INDEST=""

           IF INDSTNUM

               SET INDEST=$PIECE($GET(^INRHD(INDSTNUM,0)),U)

 +27       IF 'INEXPAND

               SET $EXTRACT(INMSGSTR,1,17)=$EXTRACT(INTDATE,1,19)

               SET $EXTRACT(INMSGSTR,21,52)=$EXTRACT(INMSGID,1,30)

               SET $EXTRACT(INMSGSTR,53,79)=$EXTRACT(INDEST,1,25)

               QUIT INMSGSTR

 +28       IF INEXPAND

               Begin DoDot:1

 +29               SET INTEMP=$$INMSPAT^INHMS1(INMSGIEN,"",.INPATNAM)

 +30               SET INORGTT=+$PIECE(INMSGTXT,U,11)

                   SET INOTT=""

                   IF INORGTT

                       SET INOTT=$PIECE($GET(^INRHT(INORGTT,0)),U)

 +31               SET $EXTRACT(INMSGSTR,5,25)=$EXTRACT(INPATNAM,1,20)

                   SET $EXTRACT(INMSGSTR,27,75)=$EXTRACT(INOTT,1,45)

               End DoDot:1

               QUIT INMSGSTR

 +32       QUIT ""

 +33      ;

POST(INNAME) ; Disply/Print messages

 +1       ; MODULE NAME: POST ( Post-action logic on List Processor field )

 +2       ; DESCRIPTION: Display/print messages using INH MESSAGE DISPLAY

 +3       ;              template

 +4       ; RETURN = none

 +5       ; PARAMETERS:

 +6       ;    INNAME= A NAME of an Array of IEN's into ^INTHU of messages

 +7       ;            selected for displaying/printing

 +8       ; CODE BEGINS

 +9        NEW I,DIC,DR,DHD,DW,DWCP,INIO,DIE,DA

 +10       IF $ORDER(@INNAME@(0))

               Begin DoDot:1

 +11               DO CLEAR^DW

 +12               SET %ZIS="N"

                   DO ^%ZIS

                   IF POP

                       QUIT

                   SET INIO=IO

                   SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL

 +13               SET I=0

FOR

                       SET I=$ORDER(@INNAME@(I))

                       IF 'I

                           QUIT

                       SET DA(@INNAME@(I))=""

 +14               SET DR="INH MESSAGE DISPLAY"

                   SET DIC=4001

                   SET DHD="@"

                   DO PRTLIST^DWPR

 +15               IF INIO=IO

                       SET X=$$CR^UTSRD

               End DoDot:1

 +16       QUIT

 +17      ;

ERR(INMSG,INFSCRN,INCONT) ; Error/Information handler

 +1       ; MODULE NAME: ERR ( Interface Message Error/Information Processor )

 +2       ; DESCRIPTION:  ERR is a multi-functional message display utility for

 +3       ;               handling user notification of errors and other messages

 +4       ; RETURN = none

 +5       ; PARAMETERS:

 +6       ;     INMSG = a string to be displayed

 +7       ;     INFSCRN =  flag to disable/enable the poping of a window

 +8       ;                0=disable(default)

 +9       ;                1=enable

 +10      ;     INCONT = flag to disable/enable continuation prompting

 +11      ;              0=disable(default)

 +12      ;              1=enable

 +13      ; CODE BEGINS

 +14       NEW INTEMP

 +15       SET INMSG=$GET(INMSG)

 +16       IF $GET(INFSCRN)

               DO MESS^DWD(5,10)

 +17      ; org W !,INMSG

 +18       WRITE INMSG

 +19       IF $GET(INCONT)

               SET INTEMP=$$CR^UTSRD

 +20       QUIT

 +21      ;

INHMS2.m