INHSYS02.m

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