BCHKERM.m

BCHKERM ; IHS/TUCSON/LAB - MOVES KERMIT FILE TO HL7 VIA MAIL SERVER//FJ ;  [ 10/28/96  2:05 PM ]

 ;;1.0;IHS RPMS CHR SYSTEM;;OCT 28, 1996

 ;

 D INIT

 D GENMSG

 D CALLXMB

 D EOJ

 Q

 ;

INIT ;INIT VARS

 K ^TMP("BCH",$J)

 S BCHNUM=0,BCHLINE=$P(^DIZ(8980,XTKDA,2,0),U,3)

 Q

 ;

GENMSG ;GENERATE MAIL MSG

 F BCHX=1:1:BCHLINE D

 .S:$P(^DIZ(8980,XTKDA,2,BCHX,0),U,1)="MSH" BCHCTR=1,BCHNUM=BCHNUM+1

 .S ^TMP("BCH",$J,BCHNUM,BCHCTR)=^DIZ(8980,XTKDA,2,BCHX,0),BCHCTR=BCHCTR+1

 Q

 ;

CALLXMB ;LOOP THRU TMP GLOBAL BY FILE MSG NUMBER

 S BCHX=0 F  S BCHX=$O(^TMP("BCH",$J,BCHX)) Q:'BCHX  D MAIL

 Q

 ;

MAIL ;CREATE SINGLE MAIL MESSAGE FOR EACH ABOVE FILE MSG NUM

 S XMDUZ=.5

 S XMTEXT="^TMP(""BCH"",$J,"_BCHX_","

 S XMSUB="KERMIT TO HL7 INTEGRATION MESSAGE "_BCHX_" FROM "_XTKFILE

 S Y=$G(^XMB(1,1,0)),Y=$P(Y,U) I Y S Y=$G(^DIC(4.2,Y,0)),Y=$P(Y,U)

 S BCHVAR("IS DOMAIN")=Y

 S BCHVAR("S.RTM")="S.HL V16 SERVER"

 S X=BCHVAR("S.RTM"),Y=BCHVAR("IS DOMAIN")

 S XMY(X_"@"_Y)=""

 D ^XMD K XMY,XMTEXT,XMSUB

 Q

 ;

EOJ ;KILL VARS

 K BCHCTR,BCHNUM,BCHX,BCHVAR,XTKFILE,XTKDA

 K ^TMP("BCH",$J)

 Q

 ;

BCHKERM   ; IHS/TUCSON/LAB - MOVES KERMIT FILE TO HL7 VIA MAIL SERVER//FJ ;  [ 10/28/96  2:05 PM ]

 +1       ;;1.0;IHS RPMS CHR SYSTEM;;OCT 28, 1996

 +2       ;

 +3        DO INIT

 +4        DO GENMSG

 +5        DO CALLXMB

 +6        DO EOJ

 +7        QUIT 

 +8       ;

INIT      ;INIT VARS

 +1        KILL ^TMP("BCH",$JOB)

 +2        SET BCHNUM=0

           SET BCHLINE=$PIECE(^DIZ(8980,XTKDA,2,0),U,3)

 +3        QUIT 

 +4       ;

GENMSG    ;GENERATE MAIL MSG

 +1        FOR BCHX=1:1:BCHLINE

               Begin DoDot:1

 +2                IF $PIECE(^DIZ(8980,XTKDA,2,BCHX,0),U,1)="MSH"

                       SET BCHCTR=1

                       SET BCHNUM=BCHNUM+1

 +3                SET ^TMP("BCH",$JOB,BCHNUM,BCHCTR)=^DIZ(8980,XTKDA,2,BCHX,0)

                   SET BCHCTR=BCHCTR+1

               End DoDot:1

 +4        QUIT 

 +5       ;

CALLXMB   ;LOOP THRU TMP GLOBAL BY FILE MSG NUMBER

 +1        SET BCHX=0

           FOR 

               SET BCHX=$ORDER(^TMP("BCH",$JOB,BCHX))

               IF 'BCHX

                   QUIT 

               DO MAIL

 +2        QUIT 

 +3       ;

MAIL      ;CREATE SINGLE MAIL MESSAGE FOR EACH ABOVE FILE MSG NUM

 +1        SET XMDUZ=.5

 +2        SET XMTEXT="^TMP(""BCH"",$J,"_BCHX_","

 +3        SET XMSUB="KERMIT TO HL7 INTEGRATION MESSAGE "_BCHX_" FROM "_XTKFILE

 +4        SET Y=$GET(^XMB(1,1,0))

           SET Y=$PIECE(Y,U)

           IF Y

               SET Y=$GET(^DIC(4.2,Y,0))

               SET Y=$PIECE(Y,U)

 +5        SET BCHVAR("IS DOMAIN")=Y

 +6        SET BCHVAR("S.RTM")="S.HL V16 SERVER"

 +7        SET X=BCHVAR("S.RTM")

           SET Y=BCHVAR("IS DOMAIN")

 +8        SET XMY(X_"@"_Y)=""

 +9        DO ^XMD

           KILL XMY,XMTEXT,XMSUB

 +10       QUIT 

 +11      ;

EOJ       ;KILL VARS

 +1        KILL BCHCTR,BCHNUM,BCHX,BCHVAR,XTKFILE,XTKDA

 +2        KILL ^TMP("BCH",$JOB)

 +3        QUIT 

 +4       ;