- 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 ---[H[J[2J[HLRMIEDIS 1754 printed Jan 18, 2025@03:17:42 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