BLRMPC.m

BLRMPC(REFLAB,DIR,FILE) ; cmi/anch/maw - BLR Import Reference Lab Order/Result Codes ;

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

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

 ;

 ;

 ;this routine will read in a ref lab database and attempt to

 ;match against file 60

 ;

 ;EP - This is the main routine driver

 S C=","

 D LOAD(REFLAB,DIR,FILE)

 Q:$G(BLRFLG)

 Q

 ;D EOJ

 Q

 ;

LOAD(RL,DIR,FL) ;-- load from the file and stuff in BLR REFERENCE LAB File

 S BLRLI=$$REF(RL)

 S BLRY=$$OPEN^%ZISH(DIR,FL,"R")

 I BLRY D  Q

 . S BLRFLG=1

 . W !,"Trouble Opening File, please fix and try again" Q

 F BLRI=1:1 U IO R BLRX:DTIME D  Q:BLRX=""

 . Q:BLRX=""

 . S ORDC=$P(BLRX,C)

 . S TNM=$P(BLRX,C,2)

 . S RESC=$P(BLRX,C,3)

 . S TNMA=$P(BLRX,C,4)

 . S BLRTI=$$ADD(BLRLI,ORDC,TNM,RESC,TNMA)

 . Q:'BLRTI

 . Q

 . ;S BLRLT=$$MTCH(BLRTI)

 Q

 ;

REF(RLNM)          ;-- check for existence of ref lab, add if not there

 I $O(^BLRRL("B",RLNM,0)) Q $O(^BLRRL("B",RLNM,0))

 K DD,DO

 S DIC="^BLRRL(",DIC(0)="L",X=RLNM

 D FILE^DICN

 Q +Y

 ;

ADD(LI,OCD,NM,RCD,NMA)          ;-- add the test code to the file

 K ORD,RES

 I $O(^BLRRL("BORD",OCD,LI,0)) S ORD=1

 I $O(^BLRRL("BRES",RCD,LI,0)) S RES=1

 I '$G(ORD) D

 . Q:NM=""

 . K BLROI

 . K DD,DO

 . S DA(1)=LI

 . S DIC("P")=$P(^DD(9009026,10,0),"^",2)

 . S DIC="^BLRRL("_LI_",1,",DIC(0)="L",X=NM

 . S DIC("DR")=".03///"_OCD

 . D FILE^DICN

 . S BLROI=+Y

 I '$G(RES) D

 . Q:NMA=""

 . K BLROI

 . K DD,DO

 . S DA(1)=LI

 . S DIC("P")=$P(^DD(9009026,10,0),"^",2)

 . S DIC="^BLRRL("_LI_",1,",DIC(0)="L",X=NMA

 . S DIC("DR")=".04///"_RCD

 . D FILE^DICN

 . S BLROI=+Y

 Q $G(BLROI)

 ;

BLRMPC(REFLAB,DIR,FILE) ; cmi/anch/maw - BLR Import Reference Lab Order/Result Codes ;

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

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

 +3       ;

 +4       ;

 +5       ;this routine will read in a ref lab database and attempt to

 +6       ;match against file 60

 +7       ;

 +8       ;EP - This is the main routine driver

 +9        SET C=","

 +10       DO LOAD(REFLAB,DIR,FILE)

 +11       IF $GET(BLRFLG)

               QUIT 

 +12       QUIT 

 +13      ;D EOJ

 +14       QUIT 

 +15      ;

LOAD(RL,DIR,FL) ;-- load from the file and stuff in BLR REFERENCE LAB File

 +1        SET BLRLI=$$REF(RL)

 +2        SET BLRY=$$OPEN^%ZISH(DIR,FL,"R")

 +3        IF BLRY

               Begin DoDot:1

 +4                SET BLRFLG=1

 +5                WRITE !,"Trouble Opening File, please fix and try again"

                   QUIT 

               End DoDot:1

               QUIT 

 +6        FOR BLRI=1:1

               USE IO

               READ BLRX:DTIME

               Begin DoDot:1

 +7                IF BLRX=""

                       QUIT 

 +8                SET ORDC=$PIECE(BLRX,C)

 +9                SET TNM=$PIECE(BLRX,C,2)

 +10               SET RESC=$PIECE(BLRX,C,3)

 +11               SET TNMA=$PIECE(BLRX,C,4)

 +12               SET BLRTI=$$ADD(BLRLI,ORDC,TNM,RESC,TNMA)

 +13               IF 'BLRTI

                       QUIT 

 +14               QUIT 

 +15      ;S BLRLT=$$MTCH(BLRTI)

               End DoDot:1

               IF BLRX=""

                   QUIT 

 +16       QUIT 

 +17      ;

REF(RLNM) ;-- check for existence of ref lab, add if not there

 +1        IF $ORDER(^BLRRL("B",RLNM,0))

               QUIT $ORDER(^BLRRL("B",RLNM,0))

 +2        KILL DD,DO

 +3        SET DIC="^BLRRL("

           SET DIC(0)="L"

           SET X=RLNM

 +4        DO FILE^DICN

 +5        QUIT +Y

 +6       ;

ADD(LI,OCD,NM,RCD,NMA) ;-- add the test code to the file

 +1        KILL ORD,RES

 +2        IF $ORDER(^BLRRL("BORD",OCD,LI,0))

               SET ORD=1

 +3        IF $ORDER(^BLRRL("BRES",RCD,LI,0))

               SET RES=1

 +4        IF '$GET(ORD)

               Begin DoDot:1

 +5                IF NM=""

                       QUIT 

 +6                KILL BLROI

 +7                KILL DD,DO

 +8                SET DA(1)=LI

 +9                SET DIC("P")=$PIECE(^DD(9009026,10,0),"^",2)

 +10               SET DIC="^BLRRL("_LI_",1,"

                   SET DIC(0)="L"

                   SET X=NM

 +11               SET DIC("DR")=".03///"_OCD

 +12               DO FILE^DICN

 +13               SET BLROI=+Y

               End DoDot:1

 +14       IF '$GET(RES)

               Begin DoDot:1

 +15               IF NMA=""

                       QUIT 

 +16               KILL BLROI

 +17               KILL DD,DO

 +18               SET DA(1)=LI

 +19               SET DIC("P")=$PIECE(^DD(9009026,10,0),"^",2)

 +20               SET DIC="^BLRRL("_LI_",1,"

                   SET DIC(0)="L"

                   SET X=NMA

 +21               SET DIC("DR")=".04///"_RCD

 +22               DO FILE^DICN

 +23               SET BLROI=+Y

               End DoDot:1

 +24       QUIT $GET(BLROI)

 +25      ;