- 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 ---[H[J[2J[HLRLNC1A 806 printed Feb 18, 2025@23:42:22 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