BLSLOINC.m

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