LRLNC1A.m

LRLNC1A ; DALCOI/CA/FHS - ADD/EDIT RESULT NLT CODES IN LAB TEST FILE (#60) ; 1-OCT-1998

 ;;5.2;LAB SERVICE;**278**;Sep 27,1994

 ;=================================================================

TEST ;ADD/EDIT RESULT NLT CODE

 W !!

 N DIC,DA,Y,X,DIE S DIE("NO^")="OUTOK"

 S DIC=60,DIC(0)="AEQZNM"

 S DIC("A")="Lab Test: ",DIC("S")="I ""BO""[$P(^(0),U,3)"

 D ^DIC

 I $D(DUOUT)!($D(DTOUT))!(Y=-1) D EXIT Q

 S LRIEN=+Y,LRTEST=$P(Y,U,2)

 ;Check for RESULT NLT CODE and if not one let enter

 K DIE,DR,DA S DA=LRIEN,DIE="^LAB(60,",DR=64.1

 D ^DIE

 I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q

 S DIC=DIE,DR="64" W !! W ?5,"IEN: [",DA,"] ",$P(^LAB(60,LRIEN,0),U) S S=$Y D EN^LRDIQ W !

 S LRNLT=$P($G(^LAB(60,LRIEN,64)),U,2)

 D EXIT

 G TEST

EXIT K DA,DIC,DIE,DR,DTOUT,DUOUT,LRIEN,LRNLT,LRTEST,S,Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRLNC1A   806     printed  Apr 09, 2024@21:11:33                                                                                                                                                                                                      Page 2

LRLNC1A   ; DALCOI/CA/FHS - ADD/EDIT RESULT NLT CODES IN LAB TEST FILE (#60) ; 1-OCT-1998

 +1       ;;5.2;LAB SERVICE;**278**;Sep 27,1994

 +2       ;=================================================================

TEST      ;ADD/EDIT RESULT NLT CODE

 +1        WRITE !!

 +2        NEW DIC,DA,Y,X,DIE

           SET DIE("NO^")="OUTOK"

 +3        SET DIC=60

           SET DIC(0)="AEQZNM"

 +4        SET DIC("A")="Lab Test: "

           SET DIC("S")="I ""BO""[$P(^(0),U,3)"

 +5        DO ^DIC

 +6        IF $DATA(DUOUT)!($DATA(DTOUT))!(Y=-1)

               DO EXIT

               QUIT 

 +7        SET LRIEN=+Y

           SET LRTEST=$PIECE(Y,U,2)

 +8       ;Check for RESULT NLT CODE and if not one let enter

 +9        KILL DIE,DR,DA

           SET DA=LRIEN

           SET DIE="^LAB(60,"

           SET DR=64.1

 +10       DO ^DIE

 +11       IF $DATA(DUOUT)!$DATA(DTOUT)

               KILL DUOUT,DTOUT

               QUIT 

 +12       SET DIC=DIE

           SET DR="64"

           WRITE !!

           WRITE ?5,"IEN: [",DA,"] ",$PIECE(^LAB(60,LRIEN,0),U)

           SET S=$Y

           DO EN^LRDIQ

           WRITE !

 +13       SET LRNLT=$PIECE($GET(^LAB(60,LRIEN,64)),U,2)

 +14       DO EXIT

 +15       GOTO TEST

EXIT       KILL DA,DIC,DIE,DR,DTOUT,DUOUT,LRIEN,LRNLT,LRTEST,S,Y

 +1        QUIT