- BLRRPOST ; cmi/anch/maw - BLR Reference Lab Post Init ; [ 03/13/06 ]
- ;;5.2;LR;**1021**;Jul 27, 2006
- ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
- ;
- ;
- ;this routine will set up the necessary site parameters and compile
- ;the scripts for the Reference Lab software
- ;
- MAIN ;PEP - Main Routine Driver
- D SETLA7
- D SITE
- D CUSER
- D UPIN
- D EOJ
- Q
- ;
- SITE ;EP - setup the site parameters in BLR MASTER CONTROL
- ;and BLR REFERENCE LAB
- X ^%ZOSF("EON")
- W !,"Now setting up reference lab parameters.."
- S DIC="^BLRRL(",DIC(0)="AEMQZ"
- S DIC("A")="Setup Parameters for which Reference Lab: "
- D ^DIC
- S BLRRL=+Y
- Q:'BLRRL
- S BLRRLE=$P($G(^BLRRL(BLRRL,0)),U)
- S DIE=DIC,DA=BLRRL,DR=".02:.07;.09;.16;1:7;20"
- D ^DIE
- K DIE,DR,DIC,DA
- W !!,"Now setting up GIS HL7 Message Parameters.."
- S BLRMSG=$O(^INTHL7M("B","HL IHS LAB O01 "_BLRRLE,0))
- Q:'BLRMSG
- S BLRMSGI=$O(^INTHL7M("B","HL IHS LAB O01 "_BLRRLE_" IN",0))
- Q:'BLRMSGI
- S DIE="^INTHL7M(",DA=BLRMSG,DR="7.01:7.04;.08///N"
- D ^DIE
- S DA=BLRMSGI,DR=".08///N"
- D ^DIE
- K DIE,DR,DA
- S DIC="^BLRSITE(",DIC(0)="AEMQZ"
- S DIC("A")="Add this Reference Lab to which Site: "
- D ^DIC
- Q:Y<0
- S DIE=DIC,DA=+Y,DR="3001////"_BLRRL
- D ^DIE
- K DIC,DIE,DR,DA
- W !!,"Now setting up Lab HL7 Message Parameter File.."
- I $O(^LAHM(62.48,"B",BLRRLE,0)) D
- . K DD,DO,DIC
- . S BLRHM=$O(^LAHM(62.48,"B",BLRRLE,0))
- . I 'BLRHM W !!,"Error creating entry in LAHM(62.48" Q
- . S DA(1)=BLRHM
- . S DIC="^LAHM(62.48,"_DA(1)_",90,",DIC(0)="L"
- . S DIC("P")=$P(^DD(62.48,90,0),U,2)
- . S BLRRID=$P($G(^INTHL7M(BLRMSG,7)),U,4)_$P($G(^INTHL7M(BLRMSG,7)),U,2)
- . S X=BLRRID
- . D FILE^DICN
- . I '+$G(Y) W !!,"Error creating entry in LAHM(62.48" Q
- . S DIE="^LAHM(62.48,",DA=BLRHM,DR="2///A"
- . D ^DIE
- W !!,"Now activating Reference Lab Interface.."
- F BLRY=BLRMSG,BLRMSGI D COMPILE^BHLU(BLRY)
- Q
- ;
- SETLA7 ;-- setup the LA7 Message Parameter File
- S BLRDA=0 F S BLRDA=$O(^BLRRL(BLRDA)) Q:'BLRDA D
- . K DD,DO,DIC
- . S BLRRF=$P($G(^BLRRL(BLRDA,0)),U)
- . S BLRPIN="D QUE^BLR"_$E(BLRRF,1)_"IIN"
- . Q:$O(^LAHM(62.48,"B",BLRRF,0))
- . S DIC="^LAHM(62.48,",DIC(0)="L"
- . S X=BLRRF
- . S DIC("DR")="1///HL7;2///I;4///Y;5///"_$G(BLRPIN)
- . D FILE^DICN
- Q
- ;
- CUSER ;-- create a lab technician user for the interface
- W !,"Now creating TECHNICIAN,LAB for filing data..."
- Q:$O(^VA(200,"B","TECHNICIAN,LAB",0))
- K DD,DO
- S DIC="^VA(200,",DIC(0)="L",X="TECHNICIAN,LAB"
- S DIC("DR")="1///LT"
- D FILE^DICN
- K DIC
- Q
- ;
- UPIN ;-- create UPIN cross reference
- Q
- ;
- EOJ ;-- kill variables and quit
- X ^%ZOSF("EOFF")
- D EN^XBVK("BLR")
- Q
- ;
- BLRRPOST ; cmi/anch/maw - BLR Reference Lab Post Init ; [ 03/13/06 ]
- +1 ;;5.2;LR;**1021**;Jul 27, 2006
- +2 ;;1.0;BLR REFERENCE LAB;;MAR 14, 2005
- +3 ;
- +4 ;
- +5 ;this routine will set up the necessary site parameters and compile
- +6 ;the scripts for the Reference Lab software
- +7 ;
- MAIN ;PEP - Main Routine Driver
- +1 DO SETLA7
- +2 DO SITE
- +3 DO CUSER
- +4 DO UPIN
- +5 DO EOJ
- +6 QUIT
- +7 ;
- SITE ;EP - setup the site parameters in BLR MASTER CONTROL
- +1 ;and BLR REFERENCE LAB
- +2 XECUTE ^%ZOSF("EON")
- +3 WRITE !,"Now setting up reference lab parameters.."
- +4 SET DIC="^BLRRL("
- SET DIC(0)="AEMQZ"
- +5 SET DIC("A")="Setup Parameters for which Reference Lab: "
- +6 DO ^DIC
- +7 SET BLRRL=+Y
- +8 IF 'BLRRL
- QUIT
- +9 SET BLRRLE=$PIECE($GET(^BLRRL(BLRRL,0)),U)
- +10 SET DIE=DIC
- SET DA=BLRRL
- SET DR=".02:.07;.09;.16;1:7;20"
- +11 DO ^DIE
- +12 KILL DIE,DR,DIC,DA
- +13 WRITE !!,"Now setting up GIS HL7 Message Parameters.."
- +14 SET BLRMSG=$ORDER(^INTHL7M("B","HL IHS LAB O01 "_BLRRLE,0))
- +15 IF 'BLRMSG
- QUIT
- +16 SET BLRMSGI=$ORDER(^INTHL7M("B","HL IHS LAB O01 "_BLRRLE_" IN",0))
- +17 IF 'BLRMSGI
- QUIT
- +18 SET DIE="^INTHL7M("
- SET DA=BLRMSG
- SET DR="7.01:7.04;.08///N"
- +19 DO ^DIE
- +20 SET DA=BLRMSGI
- SET DR=".08///N"
- +21 DO ^DIE
- +22 KILL DIE,DR,DA
- +23 SET DIC="^BLRSITE("
- SET DIC(0)="AEMQZ"
- +24 SET DIC("A")="Add this Reference Lab to which Site: "
- +25 DO ^DIC
- +26 IF Y<0
- QUIT
- +27 SET DIE=DIC
- SET DA=+Y
- SET DR="3001////"_BLRRL
- +28 DO ^DIE
- +29 KILL DIC,DIE,DR,DA
- +30 WRITE !!,"Now setting up Lab HL7 Message Parameter File.."
- +31 IF $ORDER(^LAHM(62.48,"B",BLRRLE,0))
- Begin DoDot:1
- +32 KILL DD,DO,DIC
- +33 SET BLRHM=$ORDER(^LAHM(62.48,"B",BLRRLE,0))
- +34 IF 'BLRHM
- WRITE !!,"Error creating entry in LAHM(62.48"
- QUIT
- +35 SET DA(1)=BLRHM
- +36 SET DIC="^LAHM(62.48,"_DA(1)_",90,"
- SET DIC(0)="L"
- +37 SET DIC("P")=$PIECE(^DD(62.48,90,0),U,2)
- +38 SET BLRRID=$PIECE($GET(^INTHL7M(BLRMSG,7)),U,4)_$PIECE($GET(^INTHL7M(BLRMSG,7)),U,2)
- +39 SET X=BLRRID
- +40 DO FILE^DICN
- +41 IF '+$GET(Y)
- WRITE !!,"Error creating entry in LAHM(62.48"
- QUIT
- +42 SET DIE="^LAHM(62.48,"
- SET DA=BLRHM
- SET DR="2///A"
- +43 DO ^DIE
- End DoDot:1
- +44 WRITE !!,"Now activating Reference Lab Interface.."
- +45 FOR BLRY=BLRMSG,BLRMSGI
- DO COMPILE^BHLU(BLRY)
- +46 QUIT
- +47 ;
- SETLA7 ;-- setup the LA7 Message Parameter File
- +1 SET BLRDA=0
- FOR
- SET BLRDA=$ORDER(^BLRRL(BLRDA))
- IF 'BLRDA
- QUIT
- Begin DoDot:1
- +2 KILL DD,DO,DIC
- +3 SET BLRRF=$PIECE($GET(^BLRRL(BLRDA,0)),U)
- +4 SET BLRPIN="D QUE^BLR"_$EXTRACT(BLRRF,1)_"IIN"
- +5 IF $ORDER(^LAHM(62.48,"B",BLRRF,0))
- QUIT
- +6 SET DIC="^LAHM(62.48,"
- SET DIC(0)="L"
- +7 SET X=BLRRF
- +8 SET DIC("DR")="1///HL7;2///I;4///Y;5///"_$GET(BLRPIN)
- +9 DO FILE^DICN
- End DoDot:1
- +10 QUIT
- +11 ;
- CUSER ;-- create a lab technician user for the interface
- +1 WRITE !,"Now creating TECHNICIAN,LAB for filing data..."
- +2 IF $ORDER(^VA(200,"B","TECHNICIAN,LAB",0))
- QUIT
- +3 KILL DD,DO
- +4 SET DIC="^VA(200,"
- SET DIC(0)="L"
- SET X="TECHNICIAN,LAB"
- +5 SET DIC("DR")="1///LT"
- +6 DO FILE^DICN
- +7 KILL DIC
- +8 QUIT
- +9 ;
- UPIN ;-- create UPIN cross reference
- +1 QUIT
- +2 ;
- EOJ ;-- kill variables and quit
- +1 XECUTE ^%ZOSF("EOFF")
- +2 DO EN^XBVK("BLR")
- +3 QUIT
- +4 ;
