LRMIEDIS.m

LRMIEDIS ;BPFO/DTG - LAB MICRO - ETIOLOGY FIELD FILE 61.2 FOR INACTIVE DATE ;08/15/2017

 ;;5.2;LAB SERVICE;**495**;Sep 27, 1994;Build 6

 ;

 ; uses input template [LRMIETI INACTIVE DATE]

 ;

 ; allows the Micro Supervisor or LIM to edit the Inactive Date field (#64.9102) in

 ; the Etiology Field File

 ;

 Q

 ;

EN ; Edit the Inactive Date

 N LRETIDONE,MSG

 D INFO S LRETIDONE=0

 F  Q:LRETIDONE  D

 . N DIE,DA,DR,DIC,X,Y,DIR,DUOUT,LRETI,Y,X

 . N LRETINAM,LR0,LR6491,LXA,LXB,DIQ,DTOUT

 . ;

 . S LRETI=$$GETETI(.LRETIDONE) Q:$G(LRETIDONE)  ; Get Etiology IEN

 . ; get 61.2 info

 . ; .01 - NAME, 2 - SNOMED CODE, 3 - GRAM STAIN, 4 - IDENTIFIER, 64.9102 - INACTIVE DATE

 . S DA=LRETI,DIQ="LXB",DIQ(0)="IE",DIC=61.2,DR=".01;2;3;4;64.9102" D EN^DIQ1

 . K LXA M LXA=LXB(61.2,DA) K LXB

 . ; Print info

 . W !!,"Organism: ",$G(LXA(.01,"E")),!,"Snomed Code: ",$G(LXA(2,"E")),?25,"Gram Stain: ",$G(LXA(3,"E"))

 . W !,"Identifier: ",$G(LXA(4,"E")),?28,"Inactive Date: ",$G(LXA(64.9102,"E")),!

 . ; use input template

 . K DIE,DTOUT,DR,Y,X

 . S DIE="^LAB(61.2,"

 . S DR="[LRMIETI INACTIVE DATE]"

 . S DA=LRETI

 . S DIE("NO^")="OUTOK"

 . D ^DIE

 . ;set done flag if '^' is entered while asking date

 . I $D(Y) S LRETIDONE=1 Q

 . ;

 G OUT

 ;

GETETI(LRETIDONE)  ; Prompt user for Etiology Field file (#61.2) entry

 N DIC

 S DIC=61.2,DIC(0)="QEAMZ"

 W ! D ^DIC I Y<0  S LRETIDONE=1 Q ""  ; Nothing selected, quit

 S LRETI=+Y,LRETINAM=$P(Y,"^",2)

 Q LRETI

 ;

INFO ; Display message, clear screen

 N MSG

 S MSG(1)="   This option allows the editing of the INACTIVE DATE field"

 S MSG(2)="   in the ETIOLOGY FIELD File (#61.2)."

 S MSG(3)=""

 D CLEAR^VALM1

 D BMES^XPDUTL(.MSG)

 Q

 ;

OUT ; quit point

 K LRETIDONE,MSG

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRMIEDIS   1754     printed  Apr 09, 2024@21:06:53                                                                                                                                                                                                    Page 2

LRMIEDIS  ;BPFO/DTG - LAB MICRO - ETIOLOGY FIELD FILE 61.2 FOR INACTIVE DATE ;08/15/2017

 +1       ;;5.2;LAB SERVICE;**495**;Sep 27, 1994;Build 6

 +2       ;

 +3       ; uses input template [LRMIETI INACTIVE DATE]

 +4       ;

 +5       ; allows the Micro Supervisor or LIM to edit the Inactive Date field (#64.9102) in

 +6       ; the Etiology Field File

 +7       ;

 +8        QUIT 

 +9       ;

EN        ; Edit the Inactive Date

 +1        NEW LRETIDONE,MSG

 +2        DO INFO

           SET LRETIDONE=0

 +3        FOR 

               if LRETIDONE

                   QUIT 

               Begin DoDot:1

 +4                NEW DIE,DA,DR,DIC,X,Y,DIR,DUOUT,LRETI,Y,X

 +5                NEW LRETINAM,LR0,LR6491,LXA,LXB,DIQ,DTOUT

 +6       ;

 +7       ; Get Etiology IEN

                   SET LRETI=$$GETETI(.LRETIDONE)

                   if $GET(LRETIDONE)

                       QUIT 

 +8       ; get 61.2 info

 +9       ; .01 - NAME, 2 - SNOMED CODE, 3 - GRAM STAIN, 4 - IDENTIFIER, 64.9102 - INACTIVE DATE

 +10               SET DA=LRETI

                   SET DIQ="LXB"

                   SET DIQ(0)="IE"

                   SET DIC=61.2

                   SET DR=".01;2;3;4;64.9102"

                   DO EN^DIQ1

 +11               KILL LXA

                   MERGE LXA=LXB(61.2,DA)

                   KILL LXB

 +12      ; Print info

 +13               WRITE !!,"Organism: ",$GET(LXA(.01,"E")),!,"Snomed Code: ",$GET(LXA(2,"E")),?25,"Gram Stain: ",$GET(LXA(3,"E"))

 +14               WRITE !,"Identifier: ",$GET(LXA(4,"E")),?28,"Inactive Date: ",$GET(LXA(64.9102,"E")),!

 +15      ; use input template

 +16               KILL DIE,DTOUT,DR,Y,X

 +17               SET DIE="^LAB(61.2,"

 +18               SET DR="[LRMIETI INACTIVE DATE]"

 +19               SET DA=LRETI

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

 +21               DO ^DIE

 +22      ;set done flag if '^' is entered while asking date

 +23               IF $DATA(Y)

                       SET LRETIDONE=1

                       QUIT 

 +24      ;

               End DoDot:1

 +25       GOTO OUT

 +26      ;

GETETI(LRETIDONE) ; Prompt user for Etiology Field file (#61.2) entry

 +1        NEW DIC

 +2        SET DIC=61.2

           SET DIC(0)="QEAMZ"

 +3       ; Nothing selected, quit

           WRITE !

           DO ^DIC

           IF Y<0

               SET LRETIDONE=1

               QUIT ""

 +4        SET LRETI=+Y

           SET LRETINAM=$PIECE(Y,"^",2)

 +5        QUIT LRETI

 +6       ;

INFO      ; Display message, clear screen

 +1        NEW MSG

 +2        SET MSG(1)="   This option allows the editing of the INACTIVE DATE field"

 +3        SET MSG(2)="   in the ETIOLOGY FIELD File (#61.2)."

 +4        SET MSG(3)=""

 +5        DO CLEAR^VALM1

 +6        DO BMES^XPDUTL(.MSG)

 +7        QUIT 

 +8       ;

OUT       ; quit point

 +1        KILL LRETIDONE,MSG

 +2        QUIT