Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRMIEDIS

LRMIEDIS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; uses input template [LRMIETI INACTIVE DATE]
  1. ;
  1. ; allows the Micro Supervisor or LIM to edit the Inactive Date field (#64.9102) in
  1. ; the Etiology Field File
  1. ;
  1. Q
  1. ;
  1. EN ; Edit the Inactive Date
  1. N LRETIDONE,MSG
  1. D INFO S LRETIDONE=0
  1. F Q:LRETIDONE D
  1. . N DIE,DA,DR,DIC,X,Y,DIR,DUOUT,LRETI,Y,X
  1. . N LRETINAM,LR0,LR6491,LXA,LXB,DIQ,DTOUT
  1. . ;
  1. . S LRETI=$$GETETI(.LRETIDONE) Q:$G(LRETIDONE) ; Get Etiology IEN
  1. . ; get 61.2 info
  1. . ; .01 - NAME, 2 - SNOMED CODE, 3 - GRAM STAIN, 4 - IDENTIFIER, 64.9102 - INACTIVE DATE
  1. . S DA=LRETI,DIQ="LXB",DIQ(0)="IE",DIC=61.2,DR=".01;2;3;4;64.9102" D EN^DIQ1
  1. . K LXA M LXA=LXB(61.2,DA) K LXB
  1. . ; Print info
  1. . W !!,"Organism: ",$G(LXA(.01,"E")),!,"Snomed Code: ",$G(LXA(2,"E")),?25,"Gram Stain: ",$G(LXA(3,"E"))
  1. . W !,"Identifier: ",$G(LXA(4,"E")),?28,"Inactive Date: ",$G(LXA(64.9102,"E")),!
  1. . ; use input template
  1. . K DIE,DTOUT,DR,Y,X
  1. . S DIE="^LAB(61.2,"
  1. . S DR="[LRMIETI INACTIVE DATE]"
  1. . S DA=LRETI
  1. . S DIE("NO^")="OUTOK"
  1. . D ^DIE
  1. . ;set done flag if '^' is entered while asking date
  1. . I $D(Y) S LRETIDONE=1 Q
  1. . ;
  1. G OUT
  1. ;
  1. GETETI(LRETIDONE) ; Prompt user for Etiology Field file (#61.2) entry
  1. N DIC
  1. S DIC=61.2,DIC(0)="QEAMZ"
  1. W ! D ^DIC I Y<0 S LRETIDONE=1 Q "" ; Nothing selected, quit
  1. S LRETI=+Y,LRETINAM=$P(Y,"^",2)
  1. Q LRETI
  1. ;
  1. INFO ; Display message, clear screen
  1. N MSG
  1. S MSG(1)=" This option allows the editing of the INACTIVE DATE field"
  1. S MSG(2)=" in the ETIOLOGY FIELD File (#61.2)."
  1. S MSG(3)=""
  1. D CLEAR^VALM1
  1. D BMES^XPDUTL(.MSG)
  1. Q
  1. ;
  1. OUT ; quit point
  1. K LRETIDONE,MSG
  1. Q