BLRRLMP.m

BLRRLMP ; cmi/anch/maw - BLR Read Reference Lab into ^INTHU ;

 ;;5.2;LR;**1021**;Jul 27, 2006

 ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005

 ;

 ;

 ;

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

 ;global for processing

 ;

MAIN ;-- this is the main routine driver

 D ^%ZISC

 K ^TMP("BLRRL",$J)

 S BLRY=$$CHK^BHLBCK("OUTPUT CONTROLLER")

 D READ(DUZ(2))

 D EOJ

 Q

 ;

READ(BLRRLI) ;-- read the file in

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

 S BLRRL=$P($G(^BLRSITE(BLRRLI,"RL")),U)

 I $G(BLRRL)="" D  Q

 . Q:$D(ZTQUEUED)

 . W !,"Reference Lab not defined in BLR MASTER CONTROL File"

 S BLRRLNM=$P($G(^BLRRL(BLRRL,0)),U)

 S BLRDIR=$P($G(^BLRRL(BLRRL,0)),U,16)

 S BLRSDIR=$P($G(^BLRRL(BLRRL,0)),U,9)

 S BLROPS=$P($G(^AUTTSITE(1,0)),U,21)

 S BLRFST=$P($G(^BLRRL(BLRRL,0)),U,7)_"*"

 I '$D(ZTQUEUED) D

 . W !!,"Now reading in reference lab file from directory "_BLRDIR

 S BLRFLST=$$LIST^%ZISH(BLRDIR,BLRFST,.BLRLST)

 I $G(BLRRLNM)="LABCORP" D LC(.BLRLST,"") Q

 I $G(BLRRLNM)="UNILAB" D LC(.BLRLST,"") Q

 I $P($G(^BLRRL(BLRRL,0)),U,8) D CR(.BLRLST,"") Q

 D CRLF(.BLRLST,"")

 Q

 ;

LC(BLRLST,RFLG) ;-- parse specifically for labcorp

 S BLRFDA=0 F  S BLRFDA=$O(BLRLST(BLRFDA)) Q:'BLRFDA  D

 . D ^%ZISC

 . S BLRFNM=$G(BLRLST(BLRFDA))

 . Q:BLRFNM["ord"  ;testing

 . S Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")

 . I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q

 . S CNTR=1

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

 .. Q:BLRT=""

 .. I $E($G(BLRT),1,3)="MSH",CNTR>1 D STUFF K ^TMP("BLRRL",$J) S CNTR=1

 .. S ^TMP("BLRRL",$J,CNTR)=$G(BLRT)

 .. S CNTR=CNTR+1

 . S BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)

 . D STUFF

 . D ^%ZISC

 . I '$G(RFLG) D

 .. W:'$D(ZTQUEUED) !,"Now backing up read in file",!

 .. D MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)

 . K ^TMP("BLRRL",$J)

 Q

 ;

CRLF(BLRLST,RFLG) ;-- parse by carriage return line feed

 S BLRFDA=0 F  S BLRFDA=$O(BLRLST(BLRFDA)) Q:'BLRFDA  D

 . D ^%ZISC

 . S BLRFNM=$G(BLRLST(BLRFDA))

 . Q:BLRFNM["ord"  ;testing

 . S Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")

 . I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q

 . S CNTR=1

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

 .. Q:BLRT=""

 .. S ^TMP("BLRRL",$J,CNTR)=$G(BLRT)

 .. S CNTR=CNTR+1

 . S BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)

 . D STUFF

 . D ^%ZISC

 . I '$G(RFLG) D

 .. W:'$D(ZTQUEUED) !,"Now backing up read in file",!

 .. D MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)

 . K ^TMP("BLRRL",$J)

 Q

 ;

CR(BLRLST,RFLG) ;-- parse message by CR only

 S BLRFDA=0 F  S BLRFDA=$O(BLRLST(BLRFDA)) Q:'BLRFDA  D

 . D ^%ZISC

 . S BLRFNM=$G(BLRLST(BLRFDA))

 . Q:BLRFNM["ord"  ;testing

 . S Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")

 . I $G(Y),'$D(ZTQUEUED) W !,"Error Opening Device" Q

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

 .. S CNTR=1

 .. Q:BLRT=""

 .. F J=1:1 D  Q:$P($G(BLRT),$C(10),J)=""

 ... Q:$P($G(BLRT),$C(10),J)=""

 ... I $E($P($G(BLRT),$C(10),J),1,3)="MSH",CNTR>1 D STUFF K ^TMP("BLRRL",$J) S CNTR=1

 ... S ^TMP("BLRRL",$J,CNTR)=$P($G(BLRT),$C(10),J)

 ... S CNTR=CNTR+1

 .. S BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)

 .. D STUFF

 .. D ^%ZISC

 .. I '$G(RFLG) D

 ... W:'$D(ZTQUEUED) !,"Now backing up read in file",!

 ... D MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)

 .. K ^TMP("BLRRL",$J)

 Q

 ;

STUFF ;-- stuff the information into ^INTHU

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

 S BLRH=$H

 S BLRDEST=$O(^INRHD("B","HL IHS LAB R01 "_BLRRLNM_" IN",0))

 S BLRSTAT="N"

 S BLRIO="I"

 S BLRPRIO=1

 K DD,DO

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

 S DIC("DR")=".02////"_BLRDEST_";.03////"_BLRSTAT_";.1////"_BLRIO

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

 D FILE^DICN

 S BLRUIF=+Y

 S BLRLSMSG=$$LOGM^BLRRLU(BLRFNM,BLRUIF)

 S BLRDA=0 F  S BLRDA=$O(^TMP("BLRRL",$J,BLRDA)) Q:'BLRDA  D

 . M ^INTHU(BLRUIF,3,BLRDA,0)=^TMP("BLRRL",$J,BLRDA)

 . S ^INTHU(BLRUIF,3,BLRDA,0)=^INTHU(BLRUIF,3,BLRDA,0)_"|CR|"

 S ^INLHSCH(BLRPRIO,BLRH,BLRUIF)=""

 ;S ^INLHDEST(BLRDEST,0,$H,BLRUIF)=""

 Q

 ;

REDO(BLRRLI) ; EP -- redo the import

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

 S BLRRL=$P($G(^BLRSITE(BLRRLI,"RL")),U)

 I $G(BLRRL)="" D  Q

 . Q:$D(ZTQUEUED)

 . W !,"Reference Lab not defined in BLR MASTER CONTROL File"

 S BLRRLNM=$P($G(^BLRRL(BLRRL,0)),U)

 S BLRDIR=$P($G(^BLRRL(BLRRL,0)),U,2)

 S BLRSDIR=$P($G(^BLRRL(BLRRL,0)),U,9)

 S BLROPS=$P($G(^AUTTSITE(1,0)),U,21)

 S BLRFST=$P($G(^BLRRL(BLRRL,0)),U,7)_"*"

 S BLRFLST=$$LIST(BLRSDIR,BLRFST)

 I BLRFLST<1 W !,"No Files in the directory, goodbye" Q

 S BLRLSDA=0 F  S BLRLSDA=$O(BLRLST(BLRLSDA)) Q:'BLRLSDA  D

 . W !,BLRLSDA_" - "_$G(BLRLST(BLRLSDA))

 S DIR(0)="L^1:"_BLRFLST,DIR("A")="Reimport which file(s) "

 D ^DIR

 Q:$D(DIRUT)

 S BLRFNMI=Y

 F BLRI=1:1:(BLRFLST+1)  S BLRFLI=$P(BLRFNMI,",",BLRI) Q:BLRFLI=""  D

 . S BLRFNM=$G(BLRLST(BLRFLI))

 . S BLRFILES(BLRFLI)=BLRFNM

 . I '$D(ZTQUEUED) D

 .. W !!,"Now reading in reference lab file "_BLRFNM_" from directory "_BLRSDIR

 K BLRLST

 I $P($G(^BLRRL(BLRRL,0)),U,8) D CR(.BLRFILES,1),EOJ Q

 D CRLF(.BLRFILES,1),EOJ

 Q

 ;

MOVE(DIR,FN,OPS,SDIR) ;-- move files to storage directory

 S BLRMVMSG=$$MV^%ZISH(DIR,FN,SDIR,FN)  ;maw new 4/16/03

 ;cmi/maw original code below

 ;I '$G(OPS) S OPS=1

 ;I OPS=1 D  Q

 ;S X=$$TERMINAL^%HOSTCMD("mv "_DIR_FN_" "_SDIR)

 ;S X=$ZOS(3,DIR_FN,SDIR_FN)

 Q

 ;

LIST(DIR,LST) ;-- get a list of files in the directory

 S Y=$$LIST^%ZISH(DIR,LST,.BLRLST)

 Q $O(BLRLST(""),-1)

 ;

EOJ ;-- kill variables and quit

 D EN^XBVK("BLR")

 K ^BLRRL($J)

 Q

 ;

BLRRLMP   ; cmi/anch/maw - BLR Read Reference Lab into ^INTHU ;

 +1       ;;5.2;LR;**1021**;Jul 27, 2006

 +2       ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005

 +3       ;

 +4       ;

 +5       ;

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

 +7       ;global for processing

 +8       ;

MAIN      ;-- this is the main routine driver

 +1        DO ^%ZISC

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

 +3        SET BLRY=$$CHK^BHLBCK("OUTPUT CONTROLLER")

 +4        DO READ(DUZ(2))

 +5        DO EOJ

 +6        QUIT 

 +7       ;

READ(BLRRLI) ;-- read the file in

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

 +2        SET BLRRL=$PIECE($GET(^BLRSITE(BLRRLI,"RL")),U)

 +3        IF $GET(BLRRL)=""

               Begin DoDot:1

 +4                IF $DATA(ZTQUEUED)

                       QUIT 

 +5                WRITE !,"Reference Lab not defined in BLR MASTER CONTROL File"

               End DoDot:1

               QUIT 

 +6        SET BLRRLNM=$PIECE($GET(^BLRRL(BLRRL,0)),U)

 +7        SET BLRDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,16)

 +8        SET BLRSDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,9)

 +9        SET BLROPS=$PIECE($GET(^AUTTSITE(1,0)),U,21)

 +10       SET BLRFST=$PIECE($GET(^BLRRL(BLRRL,0)),U,7)_"*"

 +11       IF '$DATA(ZTQUEUED)

               Begin DoDot:1

 +12               WRITE !!,"Now reading in reference lab file from directory "_BLRDIR

               End DoDot:1

 +13       SET BLRFLST=$$LIST^%ZISH(BLRDIR,BLRFST,.BLRLST)

 +14       IF $GET(BLRRLNM)="LABCORP"

               DO LC(.BLRLST,"")

               QUIT 

 +15       IF $GET(BLRRLNM)="UNILAB"

               DO LC(.BLRLST,"")

               QUIT 

 +16       IF $PIECE($GET(^BLRRL(BLRRL,0)),U,8)

               DO CR(.BLRLST,"")

               QUIT 

 +17       DO CRLF(.BLRLST,"")

 +18       QUIT 

 +19      ;

LC(BLRLST,RFLG) ;-- parse specifically for labcorp

 +1        SET BLRFDA=0

           FOR 

               SET BLRFDA=$ORDER(BLRLST(BLRFDA))

               IF 'BLRFDA

                   QUIT 

               Begin DoDot:1

 +2                DO ^%ZISC

 +3                SET BLRFNM=$GET(BLRLST(BLRFDA))

 +4       ;testing

                   IF BLRFNM["ord"

                       QUIT 

 +5                SET Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")

 +6                IF $GET(Y)

                       IF '$DATA(ZTQUEUED)

                           WRITE !,"Error Opening Device"

                           QUIT 

 +7                SET CNTR=1

 +8                FOR I=1:1

                       USE IO

                       READ BLRT:DTIME

                       Begin DoDot:2

 +9                        IF BLRT=""

                               QUIT 

 +10                       IF $EXTRACT($GET(BLRT),1,3)="MSH"

                               IF CNTR>1

                                   DO STUFF

                                   KILL ^TMP("BLRRL",$JOB)

                                   SET CNTR=1

 +11                       SET ^TMP("BLRRL",$JOB,CNTR)=$GET(BLRT)

 +12                       SET CNTR=CNTR+1

                       End DoDot:2

                       IF BLRT=""

                           QUIT 

 +13               SET BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)

 +14               DO STUFF

 +15               DO ^%ZISC

 +16               IF '$GET(RFLG)

                       Begin DoDot:2

 +17                       IF '$DATA(ZTQUEUED)

                               WRITE !,"Now backing up read in file",!

 +18                       DO MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)

                       End DoDot:2

 +19               KILL ^TMP("BLRRL",$JOB)

               End DoDot:1

 +20       QUIT 

 +21      ;

CRLF(BLRLST,RFLG) ;-- parse by carriage return line feed

 +1        SET BLRFDA=0

           FOR 

               SET BLRFDA=$ORDER(BLRLST(BLRFDA))

               IF 'BLRFDA

                   QUIT 

               Begin DoDot:1

 +2                DO ^%ZISC

 +3                SET BLRFNM=$GET(BLRLST(BLRFDA))

 +4       ;testing

                   IF BLRFNM["ord"

                       QUIT 

 +5                SET Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")

 +6                IF $GET(Y)

                       IF '$DATA(ZTQUEUED)

                           WRITE !,"Error Opening Device"

                           QUIT 

 +7                SET CNTR=1

 +8                FOR I=1:1

                       USE IO

                       READ BLRT:DTIME

                       Begin DoDot:2

 +9                        IF BLRT=""

                               QUIT 

 +10                       SET ^TMP("BLRRL",$JOB,CNTR)=$GET(BLRT)

 +11                       SET CNTR=CNTR+1

                       End DoDot:2

                       IF BLRT=""

                           QUIT 

 +12               SET BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)

 +13               DO STUFF

 +14               DO ^%ZISC

 +15               IF '$GET(RFLG)

                       Begin DoDot:2

 +16                       IF '$DATA(ZTQUEUED)

                               WRITE !,"Now backing up read in file",!

 +17                       DO MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)

                       End DoDot:2

 +18               KILL ^TMP("BLRRL",$JOB)

               End DoDot:1

 +19       QUIT 

 +20      ;

CR(BLRLST,RFLG) ;-- parse message by CR only

 +1        SET BLRFDA=0

           FOR 

               SET BLRFDA=$ORDER(BLRLST(BLRFDA))

               IF 'BLRFDA

                   QUIT 

               Begin DoDot:1

 +2                DO ^%ZISC

 +3                SET BLRFNM=$GET(BLRLST(BLRFDA))

 +4       ;testing

                   IF BLRFNM["ord"

                       QUIT 

 +5                SET Y=$$OPEN^%ZISH(BLRDIR,BLRFNM,"R")

 +6                IF $GET(Y)

                       IF '$DATA(ZTQUEUED)

                           WRITE !,"Error Opening Device"

                           QUIT 

 +7                FOR I=1:1

                       USE IO

                       READ BLRT:DTIME

                       Begin DoDot:2

 +8                        SET CNTR=1

 +9                        IF BLRT=""

                               QUIT 

 +10                       FOR J=1:1

                               Begin DoDot:3

 +11                               IF $PIECE($GET(BLRT),$CHAR(10),J)=""

                                       QUIT 

 +12                               IF $EXTRACT($PIECE($GET(BLRT),$CHAR(10),J),1,3)="MSH"

                                       IF CNTR>1

                                           DO STUFF

                                           KILL ^TMP("BLRRL",$JOB)

                                           SET CNTR=1

 +13                               SET ^TMP("BLRRL",$JOB,CNTR)=$PIECE($GET(BLRT),$CHAR(10),J)

 +14                               SET CNTR=CNTR+1

                               End DoDot:3

                               IF $PIECE($GET(BLRT),$CHAR(10),J)=""

                                   QUIT 

 +15                       SET BLRLMSG=$$LOG^BLRRLU(BLRFNM,"R",DUZ)

 +16                       DO STUFF

 +17                       DO ^%ZISC

 +18                       IF '$GET(RFLG)

                               Begin DoDot:3

 +19                               IF '$DATA(ZTQUEUED)

                                       WRITE !,"Now backing up read in file",!

 +20                               DO MOVE(BLRDIR,BLRFNM,BLROPS,BLRSDIR)

                               End DoDot:3

 +21                       KILL ^TMP("BLRRL",$JOB)

                       End DoDot:2

                       IF BLRT=""

                           QUIT 

               End DoDot:1

 +22       QUIT 

 +23      ;

STUFF     ;-- stuff the information into ^INTHU

 +1        DO NOW^%DTC

           SET BLRDTM=$GET(%)

 +2        SET BLRH=$HOROLOG

 +3        SET BLRDEST=$ORDER(^INRHD("B","HL IHS LAB R01 "_BLRRLNM_" IN",0))

 +4        SET BLRSTAT="N"

 +5        SET BLRIO="I"

 +6        SET BLRPRIO=1

 +7        KILL DD,DO

 +8        SET DIC="^INTHU("

           SET DIC(0)="L"

           SET X=BLRDTM

 +9        SET DIC("DR")=".02////"_BLRDEST_";.03////"_BLRSTAT_";.1////"_BLRIO

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

 +11       DO FILE^DICN

 +12       SET BLRUIF=+Y

 +13       SET BLRLSMSG=$$LOGM^BLRRLU(BLRFNM,BLRUIF)

 +14       SET BLRDA=0

           FOR 

               SET BLRDA=$ORDER(^TMP("BLRRL",$JOB,BLRDA))

               IF 'BLRDA

                   QUIT 

               Begin DoDot:1

 +15               MERGE ^INTHU(BLRUIF,3,BLRDA,0)=^TMP("BLRRL",$JOB,BLRDA)

 +16               SET ^INTHU(BLRUIF,3,BLRDA,0)=^INTHU(BLRUIF,3,BLRDA,0)_"|CR|"

               End DoDot:1

 +17       SET ^INLHSCH(BLRPRIO,BLRH,BLRUIF)=""

 +18      ;S ^INLHDEST(BLRDEST,0,$H,BLRUIF)=""

 +19       QUIT 

 +20      ;

REDO(BLRRLI) ; EP -- redo the import

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

 +2        SET BLRRL=$PIECE($GET(^BLRSITE(BLRRLI,"RL")),U)

 +3        IF $GET(BLRRL)=""

               Begin DoDot:1

 +4                IF $DATA(ZTQUEUED)

                       QUIT 

 +5                WRITE !,"Reference Lab not defined in BLR MASTER CONTROL File"

               End DoDot:1

               QUIT 

 +6        SET BLRRLNM=$PIECE($GET(^BLRRL(BLRRL,0)),U)

 +7        SET BLRDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,2)

 +8        SET BLRSDIR=$PIECE($GET(^BLRRL(BLRRL,0)),U,9)

 +9        SET BLROPS=$PIECE($GET(^AUTTSITE(1,0)),U,21)

 +10       SET BLRFST=$PIECE($GET(^BLRRL(BLRRL,0)),U,7)_"*"

 +11       SET BLRFLST=$$LIST(BLRSDIR,BLRFST)

 +12       IF BLRFLST<1

               WRITE !,"No Files in the directory, goodbye"

               QUIT 

 +13       SET BLRLSDA=0

           FOR 

               SET BLRLSDA=$ORDER(BLRLST(BLRLSDA))

               IF 'BLRLSDA

                   QUIT 

               Begin DoDot:1

 +14               WRITE !,BLRLSDA_" - "_$GET(BLRLST(BLRLSDA))

               End DoDot:1

 +15       SET DIR(0)="L^1:"_BLRFLST

           SET DIR("A")="Reimport which file(s) "

 +16       DO ^DIR

 +17       IF $DATA(DIRUT)

               QUIT 

 +18       SET BLRFNMI=Y

 +19       FOR BLRI=1:1:(BLRFLST+1)

               SET BLRFLI=$PIECE(BLRFNMI,",",BLRI)

               IF BLRFLI=""

                   QUIT 

               Begin DoDot:1

 +20               SET BLRFNM=$GET(BLRLST(BLRFLI))

 +21               SET BLRFILES(BLRFLI)=BLRFNM

 +22               IF '$DATA(ZTQUEUED)

                       Begin DoDot:2

 +23                       WRITE !!,"Now reading in reference lab file "_BLRFNM_" from directory "_BLRSDIR

                       End DoDot:2

               End DoDot:1

 +24       KILL BLRLST

 +25       IF $PIECE($GET(^BLRRL(BLRRL,0)),U,8)

               DO CR(.BLRFILES,1)

               DO EOJ

               QUIT 

 +26       DO CRLF(.BLRFILES,1)

           DO EOJ

 +27       QUIT 

 +28      ;

MOVE(DIR,FN,OPS,SDIR) ;-- move files to storage directory

 +1       ;maw new 4/16/03

           SET BLRMVMSG=$$MV^%ZISH(DIR,FN,SDIR,FN)

 +2       ;cmi/maw original code below

 +3       ;I '$G(OPS) S OPS=1

 +4       ;I OPS=1 D  Q

 +5       ;S X=$$TERMINAL^%HOSTCMD("mv "_DIR_FN_" "_SDIR)

 +6       ;S X=$ZOS(3,DIR_FN,SDIR_FN)

 +7        QUIT 

 +8       ;

LIST(DIR,LST) ;-- get a list of files in the directory

 +1        SET Y=$$LIST^%ZISH(DIR,LST,.BLRLST)

 +2        QUIT $ORDER(BLRLST(""),-1)

 +3       ;

EOJ       ;-- kill variables and quit

 +1        DO EN^XBVK("BLR")

 +2        KILL ^BLRRL($JOB)

 +3        QUIT 

 +4       ;