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 Dec 13, 2024@02:16:59 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
