- BLSLOINC ; IHS/CMI/LAB - USED TO ADD LOINC CODES TO MASTER FILE ; [ 11/18/2002 1:59 PM ]
- ;;5.2;LR;**1015**;NOV 18, 2002
- ;
- ;
- Q
- ML ;assign loinc codes to master.
- I '$D(DUZ) W !!,"Log into Kernel first using XUP." Q
- W:$D(IOF) @IOF
- W !!,"Hi Dorothy! Have fun Loincing!!!",!!!!
- S BLSQUIT=0
- S BLSN="" F S BLSN=$O(^BLSLMAST("B",BLSN)) Q:BLSN=""!(BLSQUIT) D
- .S BLSY=0 F S BLSY=$O(^BLSLMAST("B",BLSN,BLSY)) Q:BLSY'=+BLSY!(BLSQUIT) D ML1
- W !!,"So long for now..................."
- K BLSN,BLSQUIT D ^XBFMK
- Q
- ML1 ;
- Q:$P(^BLSLMAST(BLSY,0),U,4) ;already loinc
- Q:$P(^BLSLMAST(BLSY,0),U,6) ;no loincing
- W !!!,"Test Name: ",BLSN
- I $P(^BLSLMAST(BLSY,0),U,7)]"" W !," ",$P(^BLSLMAST(BLSY,0),U,7)
- I $P($G(^BLSLMAST(BLSY,11)),U)]"" W !," ",$P($G(^BLSLMAST(BLSY,11)),U)
- W !,"Site/Specimen: ",$P(^BLSLMAST(BLSY,0),U,2)
- W !,"Units: ",$P(^BLSLMAST(BLSY,0),U,3)
- W ! S DIR(0)="S^1:Assign a Loinc;2:Skip this one for now;3:Mark as Un-Loincable;4:Quit Loinc-ing",DIR("A")="Select Action",DIR("B")="1" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) S BLSQUIT=1 Q
- I Y=4 S BLSQUIT=1 Q
- I Y=2 Q
- I Y=3 S $P(^BLSLMAST(BLSY,0),U,6)=1 W " marked as not Loinc-able.." Q
- S DA=BLSY,DR=.04,DIE="^BLSLMAST(" D ^DIE K DIE,DA,DR D ^XBFMK
- Q
- BLSLOINC ; IHS/CMI/LAB - USED TO ADD LOINC CODES TO MASTER FILE ; [ 11/18/2002 1:59 PM ]
- +1 ;;5.2;LR;**1015**;NOV 18, 2002
- +2 ;
- +3 ;
- +4 QUIT
- ML ;assign loinc codes to master.
- +1 IF '$DATA(DUZ)
- WRITE !!,"Log into Kernel first using XUP."
- QUIT
- +2 IF $DATA(IOF)
- WRITE @IOF
- +3 WRITE !!,"Hi Dorothy! Have fun Loincing!!!",!!!!
- +4 SET BLSQUIT=0
- +5 SET BLSN=""
- FOR
- SET BLSN=$ORDER(^BLSLMAST("B",BLSN))
- IF BLSN=""!(BLSQUIT)
- QUIT
- Begin DoDot:1
- +6 SET BLSY=0
- FOR
- SET BLSY=$ORDER(^BLSLMAST("B",BLSN,BLSY))
- IF BLSY'=+BLSY!(BLSQUIT)
- QUIT
- DO ML1
- End DoDot:1
- +7 WRITE !!,"So long for now..................."
- +8 KILL BLSN,BLSQUIT
- DO ^XBFMK
- +9 QUIT
- ML1 ;
- +1 ;already loinc
- IF $PIECE(^BLSLMAST(BLSY,0),U,4)
- QUIT
- +2 ;no loincing
- IF $PIECE(^BLSLMAST(BLSY,0),U,6)
- QUIT
- +3 WRITE !!!,"Test Name: ",BLSN
- +4 IF $PIECE(^BLSLMAST(BLSY,0),U,7)]""
- WRITE !," ",$PIECE(^BLSLMAST(BLSY,0),U,7)
- +5 IF $PIECE($GET(^BLSLMAST(BLSY,11)),U)]""
- WRITE !," ",$PIECE($GET(^BLSLMAST(BLSY,11)),U)
- +6 WRITE !,"Site/Specimen: ",$PIECE(^BLSLMAST(BLSY,0),U,2)
- +7 WRITE !,"Units: ",$PIECE(^BLSLMAST(BLSY,0),U,3)
- +8 WRITE !
- SET DIR(0)="S^1:Assign a Loinc;2:Skip this one for now;3:Mark as Un-Loincable;4:Quit Loinc-ing"
- SET DIR("A")="Select Action"
- SET DIR("B")="1"
- KILL DA
- DO ^DIR
- KILL DIR
- +9 IF $DATA(DIRUT)
- SET BLSQUIT=1
- QUIT
- +10 IF Y=4
- SET BLSQUIT=1
- QUIT
- +11 IF Y=2
- QUIT
- +12 IF Y=3
- SET $PIECE(^BLSLMAST(BLSY,0),U,6)=1
- WRITE " marked as not Loinc-able.."
- QUIT
- +13 SET DA=BLSY
- SET DR=.04
- SET DIE="^BLSLMAST("
- DO ^DIE
- KILL DIE,DA,DR
- DO ^XBFMK
- +14 QUIT
