INHSYS02 ;SLT,JPD; 25 Sep 95 08:32;GIS configuration compilation utility
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
TTYPE(INY,%XIEN,INREPRT,%LEVEL) ;Check pointer pieces of 4000 file
;Input:
; INY-Data from node
; %XIEN-ien from 4000 file
; %LEVEL - Pointer level
N %IP6,%IP9,%IP2,%IP3,%IP17,%LEN,I,J
; -- set Parent, Acknowlege, Destination and Script pieces (all ptr's)
S %IP6=+$P(INY,U,6),%IP9=+$P(INY,U,9),%IP2=+$P(INY,U,2),%IP3=+$P(INY,U,3),%IP17=+$P(INY,U,17)
; - If parent TT pointer to file 4000 exists
I %IP6 D XTRK0^INHSYS01(%IP6,4000,"^INRHT(",INREPRT,%LEVEL) Q:INPOP
; - If Acknowledge TT pointer to file 4000 exists
I %IP9 D XTRK0^INHSYS01(%IP9,4000,"^INRHT(",INREPRT,%LEVEL) Q:INPOP
; - If Destination pointer to file 4005 exists
I %IP2 D XTRK0^INHSYS01(%IP2,4005,"^INRHD(",INREPRT,%LEVEL) Q:INPOP
; - If Background Process Control 4004 exists
I %IP17 D XTRK0^INHSYS01(%IP17,4004,"^INTHPC(",INREPRT,%LEVEL) Q:INPOP
; - If Script file pointer to file 4006 exists
I %IP3 D Q:INPOP
.;If TT is a parent, and points to script files and not replicate
.I '%IP6,'$D(^INRHR("AC",%XIEN)) W !!,"Note...Parent 4000 - ^INRHT("_%XIEN_" points to script file ^INRHS("_%IP3,!
.;interface script file 4006
.D XTRK0^INHSYS01(%IP3,4006,"^INRHS(",INREPRT,%LEVEL) Q:INPOP
.;Script generator Messages
.S INSGM=$$SGM(%XIEN,%IP3),%LEN=$L(INSGM,U)
.F I=1:1:%LEN D Q:INPOP
..S INIEN=$P(INSGM,U,I) Q:'INIEN
..;script generator message exists
..D XTRK0^INHSYS01(INIEN,4011,"^INTHL7M(",INREPRT,%LEVEL)
Q:INPOP F J="B","AC" S I="" F S I=$O(^INRHR("B",%XIEN,I)) Q:I="" D XTRK0^INHSYS01(I,4020,"^INRHR(",INREPRT,%LEVEL) Q:INPOP
;Get Destination files that point to 4000 file
Q:INPOP S I="" F S I=$O(^INRHD(I)) Q:I="" D Q:INPOP
.N INODE
.S INODE=$G(^INRHD(I,0)) Q:INODE=""
.I $P(INODE,U,2)=%XIEN D XTRK0^INHSYS01(I,4005,"^INRHD(",INREPRT,%LEVEL) Q:INPOP
.I $P(INODE,U,10)=%XIEN D XTRK0^INHSYS01(I,4005,"^INRHD(",INREPRT,%LEVEL)
;Get TTypes if parent
Q:INPOP S I="" F S I=$O(^INRHT("AC",%XIEN,I)) Q:I="" D XTRK0^INHSYS01(I,4000,"^INRHT(",INREPRT,%LEVEL) Q:INPOP
Q
SGM(%T,%SIEN) ;build list of Script Generator Message iens i.e. ien^ien^...
;input:
; %T - Transaction Type ien
; %SIEN - Script ien (only save one passed in)
;returns:
; INY - Script Generator Message ien list i.e. ien^ien^...^ien
;
N %IEN,INY,%FOUND
S INY="",(%FOUND,%IEN)=0
F S %IEN=$O(^INTHL7M(%IEN)) Q:'%IEN I $D(^INTHL7M(%IEN,2,"B",%T)) D
.;input script or output script pointer exist
.I $P(^INTHL7M(%IEN,"S"),U)'=%SIEN,$P(^("S"),U,2)'=%SIEN W !,"Note... Generated Script for Transaction Type ^INRHT("_%T_" doesn't agree with Script Generator Message ^INTHL7M("_%IEN
.S INY=INY_$S(INY]"":U,1:"")_%IEN
.S %FOUND=%FOUND+1
I %FOUND>1 D
.W !,"Note... Multiple Script Generator Message files point to Transaction Type record ^INRHT("_%T,!
.F %IEN=1:1:%FOUND W ?15,$P(INY,U,%IEN),?25,$P(^INTHL7M(%IEN,0),U),!
Q INY
INHSYS02 ;SLT,JPD; 25 Sep 95 08:32;GIS configuration compilation utility
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
TTYPE(INY,%XIEN,INREPRT,%LEVEL) ;Check pointer pieces of 4000 file
+1 ;Input:
+2 ; INY-Data from node
+3 ; %XIEN-ien from 4000 file
+4 ; %LEVEL - Pointer level
+5 NEW %IP6,%IP9,%IP2,%IP3,%IP17,%LEN,I,J
+6 ; -- set Parent, Acknowlege, Destination and Script pieces (all ptr's)
+7 SET %IP6=+$PIECE(INY,U,6)
SET %IP9=+$PIECE(INY,U,9)
SET %IP2=+$PIECE(INY,U,2)
SET %IP3=+$PIECE(INY,U,3)
SET %IP17=+$PIECE(INY,U,17)
+8 ; - If parent TT pointer to file 4000 exists
+9 IF %IP6
DO XTRK0^INHSYS01(%IP6,4000,"^INRHT(",INREPRT,%LEVEL)
IF INPOP
QUIT
+10 ; - If Acknowledge TT pointer to file 4000 exists
+11 IF %IP9
DO XTRK0^INHSYS01(%IP9,4000,"^INRHT(",INREPRT,%LEVEL)
IF INPOP
QUIT
+12 ; - If Destination pointer to file 4005 exists
+13 IF %IP2
DO XTRK0^INHSYS01(%IP2,4005,"^INRHD(",INREPRT,%LEVEL)
IF INPOP
QUIT
+14 ; - If Background Process Control 4004 exists
+15 IF %IP17
DO XTRK0^INHSYS01(%IP17,4004,"^INTHPC(",INREPRT,%LEVEL)
IF INPOP
QUIT
+16 ; - If Script file pointer to file 4006 exists
+17 IF %IP3
Begin DoDot:1
+18 ;If TT is a parent, and points to script files and not replicate
+19 IF '%IP6
IF '$DATA(^INRHR("AC",%XIEN))
WRITE !!,"Note...Parent 4000 - ^INRHT("_%XIEN_" points to script file ^INRHS("_%IP3,!
+20 ;interface script file 4006
+21 DO XTRK0^INHSYS01(%IP3,4006,"^INRHS(",INREPRT,%LEVEL)
IF INPOP
QUIT
+22 ;Script generator Messages
+23 SET INSGM=$$SGM(%XIEN,%IP3)
SET %LEN=$LENGTH(INSGM,U)
+24 FOR I=1:1:%LEN
Begin DoDot:2
+25 SET INIEN=$PIECE(INSGM,U,I)
IF 'INIEN
QUIT
+26 ;script generator message exists
+27 DO XTRK0^INHSYS01(INIEN,4011,"^INTHL7M(",INREPRT,%LEVEL)
End DoDot:2
IF INPOP
QUIT
End DoDot:1
IF INPOP
QUIT
+28 IF INPOP
QUIT
FOR J="B","AC"
SET I=""
FOR
SET I=$ORDER(^INRHR("B",%XIEN,I))
IF I=""
QUIT
DO XTRK0^INHSYS01(I,4020,"^INRHR(",INREPRT,%LEVEL)
IF INPOP
QUIT
+29 ;Get Destination files that point to 4000 file
+30 IF INPOP
QUIT
SET I=""
FOR
SET I=$ORDER(^INRHD(I))
IF I=""
QUIT
Begin DoDot:1
+31 NEW INODE
+32 SET INODE=$GET(^INRHD(I,0))
IF INODE=""
QUIT
+33 IF $PIECE(INODE,U,2)=%XIEN
DO XTRK0^INHSYS01(I,4005,"^INRHD(",INREPRT,%LEVEL)
IF INPOP
QUIT
+34 IF $PIECE(INODE,U,10)=%XIEN
DO XTRK0^INHSYS01(I,4005,"^INRHD(",INREPRT,%LEVEL)
End DoDot:1
IF INPOP
QUIT
+35 ;Get TTypes if parent
+36 IF INPOP
QUIT
SET I=""
FOR
SET I=$ORDER(^INRHT("AC",%XIEN,I))
IF I=""
QUIT
DO XTRK0^INHSYS01(I,4000,"^INRHT(",INREPRT,%LEVEL)
IF INPOP
QUIT
+37 QUIT
SGM(%T,%SIEN) ;build list of Script Generator Message iens i.e. ien^ien^...
+1 ;input:
+2 ; %T - Transaction Type ien
+3 ; %SIEN - Script ien (only save one passed in)
+4 ;returns:
+5 ; INY - Script Generator Message ien list i.e. ien^ien^...^ien
+6 ;
+7 NEW %IEN,INY,%FOUND
+8 SET INY=""
SET (%FOUND,%IEN)=0
+9 FOR
SET %IEN=$ORDER(^INTHL7M(%IEN))
IF '%IEN
QUIT
IF $DATA(^INTHL7M(%IEN,2,"B",%T))
Begin DoDot:1
+10 ;input script or output script pointer exist
+11 IF $PIECE(^INTHL7M(%IEN,"S"),U)'=%SIEN
IF $PIECE(^("S"),U,2)'=%SIEN
WRITE !,"Note... Generated Script for Transaction Type ^INRHT("_%T_" doesn't agree with Script Generator Message ^INTHL7M("_%IEN
+12 SET INY=INY_$SELECT(INY]"":U,1:"")_%IEN
+13 SET %FOUND=%FOUND+1
End DoDot:1
+14 IF %FOUND>1
Begin DoDot:1
+15 WRITE !,"Note... Multiple Script Generator Message files point to Transaction Type record ^INRHT("_%T,!
+16 FOR %IEN=1:1:%FOUND
WRITE ?15,$PIECE(INY,U,%IEN),?25,$PIECE(^INTHL7M(%IEN,0),U),!
End DoDot:1
+17 QUIT INY
