- 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 ;
