INTSTR ;DGH; 29 Apr 97 16:39;Required field/segment validation
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q ;no top entry
;
EN(INEXPND,INREQLST) ;Entry point with user interaction to select a message
;INPUT:
; INEXPND = 1 for expanded display, 0 for not
; INREQLST = (OPT) array of UIF entries
;If array of messages to validate is not supplied, prompt.
;;Enhancement needed for this tag
;;1) %ZIS call
N DIC,INLST,INUIF,SELCT,INMSG
I '$D(INREQLST) D
.W "Select uif entry"
.S DIC="^INTHU(",DIC(0)="AEQM" D ^DIC W !
.Q:Y<1
.S SELCT=1,INREQLST(1)=+Y
;If there is still nothing in array, quit
I '$D(INREQLST) S INMSG="Nothing selected" D IO(INMSG) Q
;Otherwise, loop through array
S INLST="" F S INLST=$O(INREQLST(INLST)) Q:'INLST D
.S INUIF=INREQLST(INLST)
.;kill activity log multiple
.K ^INTHU(INUIF,1)
.S INMSG="UIF Transaction "_$P(^INTHU(INUIF,0),U,5) D IO(INMSG)
.D MAIN(INUIF,INEXPND)
;If selections were made inside this routine, kill them
I $G(SELCT) K INREQLST
Q
;
MAIN(INUIF,INEXPND) ;Main program loop
;INPUT
; INUIF = Entry in UIF to validate
; INEXPND = 1 for expanded and for not (reverse of INEXPAND
; used in calling routine)
;KEY VARIABLES
; UIFMES(UCNT) = message array from the UIF file (may be sparse array)
; DEFMES = message array as the message is defined
; USID = segment id for UIF segment
; MSID = segment id for defined message segment
N LVL,UIFMES,INOUT,OTT,TT1,DMESS,INMSG,DEFMES,INCDEC,INTT,LINE,MSH,MATCH,ORD,OUT,SEGID,VALSTR,VAR,INERR,DEST,TYPE,LVL,UCNT,INDELIM,LCT,EXPAND,IEN,I,J,X,Y,DEBUG,INSUBDEL
;If needed, DEBUG will have to be set using a break point
I $G(DEBUG) D
.S INMSG="" F I=1:1:79 S INMSG=INMSG_"+"
.D IO(INMSG)
S INERR=0 K LVL,UIFMES,DEFMES,LCT
S INERR=$$UIF^INTSTR1(INUIF,.UIFMES,.INDELIM,.INSUBDEL)
I INERR S INMSG="Unable to validate required fields" D IO(INMSG) Q
I '$D(^INTHU(INUIF,3)) S INMSG="Message contains no segments",INERR=1 D IO(INMSG) Q
I $G(DEBUG) S INMSG="Validating message "_$P(^INTHU(INUIF,0),U,5) D IO(INMSG)
I $G(DEBUG)>1 D
.D IO("UIFMES array:")
.S QX=$Q(UIFMES) Q:'$L(QX) S INMSG=QX_"="_$G(@(QX)) D IO(INMSG)
.F S QX=$Q(@(QX)) Q:'$L(QX) S INMSG=QX_"="_$G(@(QX)) D IO(INMSG)
;Find the message type for this message
S INOUT=$P(^INTHU(INUIF,0),U,10)
I INOUT="I" D Q:INERR
.;If incoming, get Transaction Type from Destination data
.S TYPE=$$TYPE^INHOTM(INUIF)
.I 'DEST S INMSG="Can not validate. Transaction has no destination",INERR=1 D IO(INMSG) Q
.I 'TYPE S INMSG="Can not validate. Destination has no method of processing",INERR=1 D IO(INMSG) Q
.I TYPE'=1 S INMSG="Can not validate. This destination is not currently supported",INERR=1 D IO(INMSG) Q
.S OTT=+$P(^INRHD(DEST,0),U,2) I 'OTT S INMSG="Can not validate. Missing transaction type or entry for destination "_$P(^INRHD(DEST,0),U),INERR=1 D IO(INMSG) Q
;If outbound, get originating TT from 11th piece
I INOUT="O" D Q:INERR
.S OTT=$P(^INTHU(INUIF,0),U,11)
.Q:OTT
.S INMSG="Can not validate. Originating Transaction Type not found",INERR=1 D IO(INMSG)
I '$D(^INRHT(OTT)) S INMSG="Can not validate. No entry in Transaction Type File for this transaction type",INERR=1 D IO(INMSG) Q
S INMSG="Validating Transaction Type: "_$P(^INRHT(OTT,0),U) D IO(INMSG)
;Determine if a message uses this originating transaction type.
D FNDMSG(OTT,.DMESS)
;If DMESS is found, compare actual message with this. If it is not
;found, it may be a replicated transacton--so check replication file.
;If found there, re-define OTT to be the "base" transaction type.
I 'DMESS,$D(^INRHR("B",OTT)) D
.S IEN=$O(^INRHR("B",OTT,"")),OTT=$P(^INRHR(IEN,0),U,2)
.S INMSG="Validating Base Transaction Type: "_$P(^INRHT(OTT,0),U) D IO(INMSG)
.;Now determine if a message uses the "base" transaction type.
.D FNDMSG(OTT,.DMESS)
I 'DMESS S INMSG="Can not validate. No message defined for transaction type" D IO(INMSG) Q
;Run the verification
S INMSG="Validating message: "_$P(^INTHL7M(DMESS,0),U) D IO(INMSG)
;;Enhancement: Allow user to select message type instead of doing lookup
;W "Select message type"
;S DIC="^INTHL7M(",DIC(0)="AEQ" D ^DIC Q:Y<1
;also set DIC to default to the type found above.
D MSG^INTSTR1(DMESS,.DEFMES)
I '$D(DEFMES) S INMSG="Can not validate. No structure is defined for this message" D IO(INMSG) Q
I $G(DEBUG)>1 D
.D IO("DEFMES array:")
.S QX="DEFMES"
.F S QX=$Q(@(QX)) Q:'$L(QX) S INMSG=QX_"="_$G(@(QX)) D IO(INMSG)
S LVL(1)=$O(DEFMES("")),UCNT=$O(UIFMES("")),INERR=0
;S INCDEC=1 D LOOP^INTSTR2(INUIF,.LVL,.UCNT,.INCDEC,.INERR)
S INCDEC=1 D LOOP^INTSTR2(INUIF,.LVL,.UIFMES,.UCNT,.INCDEC,.DEFMES,.INERR)
;
;As final check, loop through UIFMES array to see if all
;segments have been validated.
I INEXPND D IO("---- Required Field summary -------------------------")
S UCNT="" F S UCNT=$O(UIFMES(UCNT)) Q:'UCNT D
.S STATUS=$P(UIFMES(UCNT),U,2)
.;In expanded mode, display validation status of all segments.
.I INEXPND,STATUS D
..S INMSG="Segment "_$P(UIFMES(UCNT),U)_": Required fields "_$S(STATUS=1:"present",1:"missing")
..D IO(INMSG)
.Q:$P(UIFMES(UCNT),U,2)
.;Whether expanded or not, display status of segments not validated.
.S INERR=2,INMSG="Warning. Segment "_$P(UIFMES(UCNT),U)_" could not be validated" D IO(INMSG)
;Display final message
S INMSG=$S('INERR:"All required fields are present",INERR=2:"Message structure is incorrect",1:"Message contains errors") D IO(INMSG)
Q
;
FNDMSG(OTT,DMESS) ;find message that contains the ttype
;INPUT:
; OTT = Originating Transaction Type
;OUTPUT:
; DMESS = (PBR) the ien of the message (Script Generator
; Message File entry) containing OTT.
; DMESS=0 if no message contains OTT.
N IEN,TT1,INTT
S (IEN,DMESS)=0 F S IEN=$O(^INTHL7M(IEN)) Q:'IEN!DMESS D
.Q:'$D(^INTHL7M(IEN,2))
.S TT1=0 F S TT1=$O(^INTHL7M(IEN,2,TT1)) Q:'TT1!DMESS D
..S INTT=$G(^INTHL7M(IEN,2,TT1,0))
..I INTT=OTT S DMESS=IEN Q
Q
;
IO(INMSG,INDRCT) ;print messages
;If called as part of Unit Test Utility, DISPLAY^INTSUT1 is used.
;;Future development: i
;INPUT:
; INMSG=message to print
; INDRCT (OPT) = 1 if called as a stand alone function
I '$G(INDRCT) D DISPLAY^INTSUT1(INMSG,0) Q
;;Future development: Build in writes to IO. A call to %ZIS needed
;;at top.
I $G(INDRCT) W INMSG,! Q
Q
;
TEST(INEXPND,INSTEP) ;Run a test of nn messages in INTHU
;INPUT:
; INEXPND=1 for expanded mode, 0 for not
; INSTEP = 1 to pause (step) between messages
N N,INREQLST,UIF
W !,"Enter number of messages from INTHU to validate " R N:3600
Q:'+N
W !,"This runs a test validation on the last "_N_" messages in INTHU",!
W "Press any key to start",! R *x:3600
S U="^"
K INREQLST
S UIF="A" F I=1:1:N S UIF=$O(^INTHU(UIF),-1) Q:'UIF D
.;S INREQLST(I)=UIF
.S INMSG="UIF Transaction "_$P(^INTHU(UIF,0),U,5) D IO(INMSG)
.D MAIN(UIF,INEXPND)
.I $G(INSTEP) D IO("Press any key to continue") R *X:3600
Q
;
INTSTR ;DGH; 29 Apr 97 16:39;Required field/segment validation
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;no top entry
QUIT
+5 ;
EN(INEXPND,INREQLST) ;Entry point with user interaction to select a message
+1 ;INPUT:
+2 ; INEXPND = 1 for expanded display, 0 for not
+3 ; INREQLST = (OPT) array of UIF entries
+4 ;If array of messages to validate is not supplied, prompt.
+5 ;;Enhancement needed for this tag
+6 ;;1) %ZIS call
+7 NEW DIC,INLST,INUIF,SELCT,INMSG
+8 IF '$DATA(INREQLST)
Begin DoDot:1
+9 WRITE "Select uif entry"
+10 SET DIC="^INTHU("
SET DIC(0)="AEQM"
DO ^DIC
WRITE !
+11 IF Y<1
QUIT
+12 SET SELCT=1
SET INREQLST(1)=+Y
End DoDot:1
+13 ;If there is still nothing in array, quit
+14 IF '$DATA(INREQLST)
SET INMSG="Nothing selected"
DO IO(INMSG)
QUIT
+15 ;Otherwise, loop through array
+16 SET INLST=""
FOR
SET INLST=$ORDER(INREQLST(INLST))
IF 'INLST
QUIT
Begin DoDot:1
+17 SET INUIF=INREQLST(INLST)
+18 ;kill activity log multiple
+19 KILL ^INTHU(INUIF,1)
+20 SET INMSG="UIF Transaction "_$PIECE(^INTHU(INUIF,0),U,5)
DO IO(INMSG)
+21 DO MAIN(INUIF,INEXPND)
End DoDot:1
+22 ;If selections were made inside this routine, kill them
+23 IF $GET(SELCT)
KILL INREQLST
+24 QUIT
+25 ;
MAIN(INUIF,INEXPND) ;Main program loop
+1 ;INPUT
+2 ; INUIF = Entry in UIF to validate
+3 ; INEXPND = 1 for expanded and for not (reverse of INEXPAND
+4 ; used in calling routine)
+5 ;KEY VARIABLES
+6 ; UIFMES(UCNT) = message array from the UIF file (may be sparse array)
+7 ; DEFMES = message array as the message is defined
+8 ; USID = segment id for UIF segment
+9 ; MSID = segment id for defined message segment
+10 NEW LVL,UIFMES,INOUT,OTT,TT1,DMESS,INMSG,DEFMES,INCDEC,INTT,LINE,MSH,MATCH,ORD,OUT,SEGID,VALSTR,VAR,INERR,DEST,TYPE,LVL,UCNT,INDELIM,LCT,EXPAND,IEN,I,J,X,Y,DEBUG,INSUBDEL
+11 ;If needed, DEBUG will have to be set using a break point
+12 IF $GET(DEBUG)
Begin DoDot:1
+13 SET INMSG=""
FOR I=1:1:79
SET INMSG=INMSG_"+"
+14 DO IO(INMSG)
End DoDot:1
+15 SET INERR=0
KILL LVL,UIFMES,DEFMES,LCT
+16 SET INERR=$$UIF^INTSTR1(INUIF,.UIFMES,.INDELIM,.INSUBDEL)
+17 IF INERR
SET INMSG="Unable to validate required fields"
DO IO(INMSG)
QUIT
+18 IF '$DATA(^INTHU(INUIF,3))
SET INMSG="Message contains no segments"
SET INERR=1
DO IO(INMSG)
QUIT
+19 IF $GET(DEBUG)
SET INMSG="Validating message "_$PIECE(^INTHU(INUIF,0),U,5)
DO IO(INMSG)
+20 IF $GET(DEBUG)>1
Begin DoDot:1
+21 DO IO("UIFMES array:")
+22 SET QX=$QUERY(UIFMES)
IF '$LENGTH(QX)
QUIT
SET INMSG=QX_"="_$GET(@(QX))
DO IO(INMSG)
+23 FOR
SET QX=$QUERY(@(QX))
IF '$LENGTH(QX)
QUIT
SET INMSG=QX_"="_$GET(@(QX))
DO IO(INMSG)
End DoDot:1
+24 ;Find the message type for this message
+25 SET INOUT=$PIECE(^INTHU(INUIF,0),U,10)
+26 IF INOUT="I"
Begin DoDot:1
+27 ;If incoming, get Transaction Type from Destination data
+28 SET TYPE=$$TYPE^INHOTM(INUIF)
+29 IF 'DEST
SET INMSG="Can not validate. Transaction has no destination"
SET INERR=1
DO IO(INMSG)
QUIT
+30 IF 'TYPE
SET INMSG="Can not validate. Destination has no method of processing"
SET INERR=1
DO IO(INMSG)
QUIT
+31 IF TYPE'=1
SET INMSG="Can not validate. This destination is not currently supported"
SET INERR=1
DO IO(INMSG)
QUIT
+32 SET OTT=+$PIECE(^INRHD(DEST,0),U,2)
IF 'OTT
SET INMSG="Can not validate. Missing transaction type or entry for destination "_$PIECE(^INRHD(DEST,0),U)
SET INERR=1
DO IO(INMSG)
QUIT
End DoDot:1
IF INERR
QUIT
+33 ;If outbound, get originating TT from 11th piece
+34 IF INOUT="O"
Begin DoDot:1
+35 SET OTT=$PIECE(^INTHU(INUIF,0),U,11)
+36 IF OTT
QUIT
+37 SET INMSG="Can not validate. Originating Transaction Type not found"
SET INERR=1
DO IO(INMSG)
End DoDot:1
IF INERR
QUIT
+38 IF '$DATA(^INRHT(OTT))
SET INMSG="Can not validate. No entry in Transaction Type File for this transaction type"
SET INERR=1
DO IO(INMSG)
QUIT
+39 SET INMSG="Validating Transaction Type: "_$PIECE(^INRHT(OTT,0),U)
DO IO(INMSG)
+40 ;Determine if a message uses this originating transaction type.
+41 DO FNDMSG(OTT,.DMESS)
+42 ;If DMESS is found, compare actual message with this. If it is not
+43 ;found, it may be a replicated transacton--so check replication file.
+44 ;If found there, re-define OTT to be the "base" transaction type.
+45 IF 'DMESS
IF $DATA(^INRHR("B",OTT))
Begin DoDot:1
+46 SET IEN=$ORDER(^INRHR("B",OTT,""))
SET OTT=$PIECE(^INRHR(IEN,0),U,2)
+47 SET INMSG="Validating Base Transaction Type: "_$PIECE(^INRHT(OTT,0),U)
DO IO(INMSG)
+48 ;Now determine if a message uses the "base" transaction type.
+49 DO FNDMSG(OTT,.DMESS)
End DoDot:1
+50 IF 'DMESS
SET INMSG="Can not validate. No message defined for transaction type"
DO IO(INMSG)
QUIT
+51 ;Run the verification
+52 SET INMSG="Validating message: "_$PIECE(^INTHL7M(DMESS,0),U)
DO IO(INMSG)
+53 ;;Enhancement: Allow user to select message type instead of doing lookup
+54 ;W "Select message type"
+55 ;S DIC="^INTHL7M(",DIC(0)="AEQ" D ^DIC Q:Y<1
+56 ;also set DIC to default to the type found above.
+57 DO MSG^INTSTR1(DMESS,.DEFMES)
+58 IF '$DATA(DEFMES)
SET INMSG="Can not validate. No structure is defined for this message"
DO IO(INMSG)
QUIT
+59 IF $GET(DEBUG)>1
Begin DoDot:1
+60 DO IO("DEFMES array:")
+61 SET QX="DEFMES"
+62 FOR
SET QX=$QUERY(@(QX))
IF '$LENGTH(QX)
QUIT
SET INMSG=QX_"="_$GET(@(QX))
DO IO(INMSG)
End DoDot:1
+63 SET LVL(1)=$ORDER(DEFMES(""))
SET UCNT=$ORDER(UIFMES(""))
SET INERR=0
+64 ;S INCDEC=1 D LOOP^INTSTR2(INUIF,.LVL,.UCNT,.INCDEC,.INERR)
+65 SET INCDEC=1
DO LOOP^INTSTR2(INUIF,.LVL,.UIFMES,.UCNT,.INCDEC,.DEFMES,.INERR)
+66 ;
+67 ;As final check, loop through UIFMES array to see if all
+68 ;segments have been validated.
+69 IF INEXPND
DO IO("---- Required Field summary -------------------------")
+70 SET UCNT=""
FOR
SET UCNT=$ORDER(UIFMES(UCNT))
IF 'UCNT
QUIT
Begin DoDot:1
+71 SET STATUS=$PIECE(UIFMES(UCNT),U,2)
+72 ;In expanded mode, display validation status of all segments.
+73 IF INEXPND
IF STATUS
Begin DoDot:2
+74 SET INMSG="Segment "_$PIECE(UIFMES(UCNT),U)_": Required fields "_$SELECT(STATUS=1:"present",1:"missing")
+75 DO IO(INMSG)
End DoDot:2
+76 IF $PIECE(UIFMES(UCNT),U,2)
QUIT
+77 ;Whether expanded or not, display status of segments not validated.
+78 SET INERR=2
SET INMSG="Warning. Segment "_$PIECE(UIFMES(UCNT),U)_" could not be validated"
DO IO(INMSG)
End DoDot:1
+79 ;Display final message
+80 SET INMSG=$SELECT('INERR:"All required fields are present",INERR=2:"Message structure is incorrect",1:"Message contains errors")
DO IO(INMSG)
+81 QUIT
+82 ;
FNDMSG(OTT,DMESS) ;find message that contains the ttype
+1 ;INPUT:
+2 ; OTT = Originating Transaction Type
+3 ;OUTPUT:
+4 ; DMESS = (PBR) the ien of the message (Script Generator
+5 ; Message File entry) containing OTT.
+6 ; DMESS=0 if no message contains OTT.
+7 NEW IEN,TT1,INTT
+8 SET (IEN,DMESS)=0
FOR
SET IEN=$ORDER(^INTHL7M(IEN))
IF 'IEN!DMESS
QUIT
Begin DoDot:1
+9 IF '$DATA(^INTHL7M(IEN,2))
QUIT
+10 SET TT1=0
FOR
SET TT1=$ORDER(^INTHL7M(IEN,2,TT1))
IF 'TT1!DMESS
QUIT
Begin DoDot:2
+11 SET INTT=$GET(^INTHL7M(IEN,2,TT1,0))
+12 IF INTT=OTT
SET DMESS=IEN
QUIT
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
IO(INMSG,INDRCT) ;print messages
+1 ;If called as part of Unit Test Utility, DISPLAY^INTSUT1 is used.
+2 ;;Future development: i
+3 ;INPUT:
+4 ; INMSG=message to print
+5 ; INDRCT (OPT) = 1 if called as a stand alone function
+6 IF '$GET(INDRCT)
DO DISPLAY^INTSUT1(INMSG,0)
QUIT
+7 ;;Future development: Build in writes to IO. A call to %ZIS needed
+8 ;;at top.
+9 IF $GET(INDRCT)
WRITE INMSG,!
QUIT
+10 QUIT
+11 ;
TEST(INEXPND,INSTEP) ;Run a test of nn messages in INTHU
+1 ;INPUT:
+2 ; INEXPND=1 for expanded mode, 0 for not
+3 ; INSTEP = 1 to pause (step) between messages
+4 NEW N,INREQLST,UIF
+5 WRITE !,"Enter number of messages from INTHU to validate "
READ N:3600
+6 IF '+N
QUIT
+7 WRITE !,"This runs a test validation on the last "_N_" messages in INTHU",!
+8 WRITE "Press any key to start",!
READ *x:3600
+9 SET U="^"
+10 KILL INREQLST
+11 SET UIF="A"
FOR I=1:1:N
SET UIF=$ORDER(^INTHU(UIF),-1)
IF 'UIF
QUIT
Begin DoDot:1
+12 ;S INREQLST(I)=UIF
+13 SET INMSG="UIF Transaction "_$PIECE(^INTHU(UIF,0),U,5)
DO IO(INMSG)
+14 DO MAIN(UIF,INEXPND)
+15 IF $GET(INSTEP)
DO IO("Press any key to continue")
READ *X:3600
End DoDot:1
+16 QUIT
+17 ;
