BHLXRFL.m

BHLXRFL ; cmi/flag/maw - BHL Read X12 File in and stuff into ^INTHU ; [ 10/10/2002  9:29 AM ]

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

 ;

 ;

 ;

 ;this routine will grab a file from HFS and stuff it into the ^INTHU

 ;global for processing

 ;

MAIN(XMSG,BHLXDIR,BHLXPRE,BHLXTF) ;-- this is the main routine driver

 D ^%ZISC

 K ^BHLX12($J)

 D READ

 D ^%ZISC

 D EOJ

 Q

 ;

READ ;-- read the file in

 ;cmi/maw we need to set up dynamic directory reads here

 I $G(BHLXTF)="" S BHLXTF="T"

 S BHLXLST=$$LIST^%ZISH(BHLXDIR,BHLXPRE,.BHLXLST)

 S BHLXFDA=0 F  S BHLXFDA=$O(BHLXLST(BHLXFDA)) Q:'BHLXFDA  D

 . D ^%ZISC

 . S BHLXFNM=$G(BHLXLST(BHLXFDA))

 . S Y=$$OPEN^%ZISH(BHLXDIR,BHLXFNM,"R")

 . F I=1:1 U IO R BHLXT:DTIME Q:BHLXT=""  D

 .. I BHLXTF="P" F J=1:1 S BHLXREC=$P(BHLXT,"~",J),^BHLX12($J,J)=$G(BHLXREC) Q:BHLXREC=""  ;real messages

 .. I BHLXTF="T" S BHLXREC=BHLXT,^BHLX12($J,I)=$G(BHLXREC) Q:BHLXREC=""  ;test messages

 . D STUFF

 Q

 ;

STUFF ;-- stuff the information into ^INTHU

 D NOW^%DTC S BHLXDTM=$G(%)

 S BHLXH=$H

 S BHLXDEST=$O(^INRHD("B","X1 IHS "_XMSG_" IN",0))

 S BHLXSTAT="N"

 S BHLXIO="I"

 S BHLXPRIO=1

 K DD,DO

 S DIC="^INTHU(",DIC(0)="L",X=BHLXDTM

 S DIC("DR")=".02////"_BHLXDEST_";.03////"_BHLXSTAT_";.1////"_BHLXIO

 S DIC("DR")=DIC("DR")_";.16///"_BHLXPRIO

 D FILE^DICN

 S BHLXUIF=+Y

 S BHLXDA=0 F  S BHLXDA=$O(^BHLX12($J,BHLXDA)) Q:'BHLXDA  D

 . K DIC,DD,DO

 . S DIC="^INTHU("_BHLXUIF_",3,",DIC(0)="L"

 . S DIC("P")=$P(^DD(4001,3,0),"",2)

 . S DA(1)=BHLXUIF,X=$G(^BHLX12($J,BHLXDA))_"|CR|"

 . Q:X=""

 . D FILE^DICN

 K ^INTHU(BHLXUIF,3,"B")  ;don't need b index on msg multiple

 S ^INLHSCH(BHLXPRIO,BHLXH,BHLXUIF)=""

 Q

 ;

EOJ ;-- kill variables and quit

 K I,J

 D EN^XBVK("BHLX")

 K ^BHLX12($J)

 Q

 ;

BHLXRFL   ; cmi/flag/maw - BHL Read X12 File in and stuff into ^INTHU ; [ 10/10/2002  9:29 AM ]

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

 +2       ;

 +3       ;

 +4       ;

 +5       ;this routine will grab a file from HFS and stuff it into the ^INTHU

 +6       ;global for processing

 +7       ;

MAIN(XMSG,BHLXDIR,BHLXPRE,BHLXTF) ;-- this is the main routine driver

 +1        DO ^%ZISC

 +2        KILL ^BHLX12($JOB)

 +3        DO READ

 +4        DO ^%ZISC

 +5        DO EOJ

 +6        QUIT 

 +7       ;

READ      ;-- read the file in

 +1       ;cmi/maw we need to set up dynamic directory reads here

 +2        IF $GET(BHLXTF)=""

               SET BHLXTF="T"

 +3        SET BHLXLST=$$LIST^%ZISH(BHLXDIR,BHLXPRE,.BHLXLST)

 +4        SET BHLXFDA=0

           FOR 

               SET BHLXFDA=$ORDER(BHLXLST(BHLXFDA))

               IF 'BHLXFDA

                   QUIT 

               Begin DoDot:1

 +5                DO ^%ZISC

 +6                SET BHLXFNM=$GET(BHLXLST(BHLXFDA))

 +7                SET Y=$$OPEN^%ZISH(BHLXDIR,BHLXFNM,"R")

 +8                FOR I=1:1

                       USE IO

                       READ BHLXT:DTIME

                       IF BHLXT=""

                           QUIT 

                       Begin DoDot:2

 +9       ;real messages

                           IF BHLXTF="P"

                               FOR J=1:1

                                   SET BHLXREC=$PIECE(BHLXT,"~",J)

                                   SET ^BHLX12($JOB,J)=$GET(BHLXREC)

                                   IF BHLXREC=""

                                       QUIT 

 +10      ;test messages

                           IF BHLXTF="T"

                               SET BHLXREC=BHLXT

                               SET ^BHLX12($JOB,I)=$GET(BHLXREC)

                               IF BHLXREC=""

                                   QUIT 

                       End DoDot:2

 +11               DO STUFF

               End DoDot:1

 +12       QUIT 

 +13      ;

STUFF     ;-- stuff the information into ^INTHU

 +1        DO NOW^%DTC

           SET BHLXDTM=$GET(%)

 +2        SET BHLXH=$HOROLOG

 +3        SET BHLXDEST=$ORDER(^INRHD("B","X1 IHS "_XMSG_" IN",0))

 +4        SET BHLXSTAT="N"

 +5        SET BHLXIO="I"

 +6        SET BHLXPRIO=1

 +7        KILL DD,DO

 +8        SET DIC="^INTHU("

           SET DIC(0)="L"

           SET X=BHLXDTM

 +9        SET DIC("DR")=".02////"_BHLXDEST_";.03////"_BHLXSTAT_";.1////"_BHLXIO

 +10       SET DIC("DR")=DIC("DR")_";.16///"_BHLXPRIO

 +11       DO FILE^DICN

 +12       SET BHLXUIF=+Y

 +13       SET BHLXDA=0

           FOR 

               SET BHLXDA=$ORDER(^BHLX12($JOB,BHLXDA))

               IF 'BHLXDA

                   QUIT 

               Begin DoDot:1

 +14               KILL DIC,DD,DO

 +15               SET DIC="^INTHU("_BHLXUIF_",3,"

                   SET DIC(0)="L"

 +16               SET DIC("P")=$PIECE(^DD(4001,3,0),"",2)

 +17               SET DA(1)=BHLXUIF

                   SET X=$GET(^BHLX12($JOB,BHLXDA))_"|CR|"

 +18               IF X=""

                       QUIT 

 +19               DO FILE^DICN

               End DoDot:1

 +20      ;don't need b index on msg multiple

           KILL ^INTHU(BHLXUIF,3,"B")

 +21       SET ^INLHSCH(BHLXPRIO,BHLXH,BHLXUIF)=""

 +22       QUIT 

 +23      ;

EOJ       ;-- kill variables and quit

 +1        KILL I,J

 +2        DO EN^XBVK("BHLX")

 +3        KILL ^BHLX12($JOB)

 +4        QUIT 

 +5       ;