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

LRMIEDIM.m

Go to the documentation of this file. 
  1. LRMIEDIM ;BPFO/DTG - LAB MICRO - LOOP ETIOLOGY FIELD FILE 61.2 FOR INACTIVE DATE ;08/15/2017
  1.  ;;5.2;LAB SERVICE;**495**;Sep 27, 1994;Build 6
  1.  ;
  1.  ;associated to the [LRMI EDIT INACT DT MULTI 61.2] option
  1.  ;
  1.  ;This routine will go through the 61.2 by IDENTIFIER oldest to newest for those entries
  1.  ;that do not have an INACTIVE DATE. The last entry (if the file for that combination was
  1.  ;not complete) will be stored for upto 6 months so that when re-starting for that identifier
  1.  ;it will allow to restart with that item if it does not have a inactive date or the next newest
  1.  ;if it does. The person will also have the choice to start over from the oldest entry.
  1.  ;
  1.  Q
  1.  ;
  1. EN ; entry point from option
  1.  N DIR,DIRUT,DIC,A,B,LRXT,MSG,LRRUN,LR0,LRIDENT,LRIDNM,X,Y,DIE,DTOUT,DR,DA,LR6491
  1. EN1 S U="^" I $G(DT)="" S DT=$$DT^XLFDT
  1.  S B=$$SITE^VASITE,B=$P(B,U,1),LRXT="LRENT-INACT"
  1.  ;
  1.  D ASKFILE
  1.  I $D(DIRUT)!(Y="^") K MSG D  G OUT
  1.  . S MSG(1)="Identifier Type Not Selected. Quitting"
  1.  . S MSG(2)=""
  1.  . D DISP
  1.  S LRIDENT=Y,LRIDNM=Y(0)
  1.  K DIR,DIRUT
  1.  ;get ^XTMP for identifier
  1.  S LRRUN=0,A=$G(^XTMP(LRXT,0)),B=$G(^XTMP(LRXT,LRIDENT,0))
  1.  I +B>0 S LRRUN=+B
  1.  I A="" S $P(A,U,3)="Save of Etiology File 61.2 Identifiers for Inactive Date entry"
  1.  S $P(A,U,1)=$$FMADD^XLFDT(DT,60),$P(A,U,2)=DT
  1.  S ^XTMP(LRXT,0)=A,^XTMP(LRXT,LRIDENT,0)=LRRUN
  1.  I LRRUN=0 D XSET(LRIDENT,"") G LOOP
  1.  S A=$$GETVAL(LRRUN)
  1.  K DIR,DIRUT S DIR(0)="SO^C:CONTINUE WITH "_$E($P(A,U,1),1,45)_"  ["_(+B)_"];S:START OVER"
  1.  S DIR("L",1)="   CONTINUE WITH "_$E($P(A,U,1),1,45)_"  ["_(+B)_"] (C)"
  1.  S DIR("L")="   START OVER (S)"
  1.  D ^DIR
  1.  I $D(DIRUT)!(Y="^") K MSG D  G OUT
  1.  . S MSG(1)="Continuation Method Not Selected. Quitting"
  1.  . S MSG(2)=""
  1.  . D DISP
  1.  I $G(Y)="S" S LRRUN=0 G LOOP
  1.  S LRRUN=LRRUN+1
  1.  ;
  1. LOOP S LRRUN=$O(^LAB(61.2,LRRUN)) I 'LRRUN D XSET(LRIDENT,"") D  G OUT
  1.  . K MSG S MSG(1)="All Entries for the Selected Identifier ("_LRIDNM_") have been reviewed. Quitting"
  1.  . S MSG(2)=""
  1.  . D DISP
  1.  S LR0=$G(^LAB(61.2,LRRUN,0)),LR6491=$G(^LAB(61.2,LRRUN,"64.91"))
  1.  ; check if inactive date
  1.  I $P(LR6491,U,2)'="" D XSET(LRIDENT,LRRUN) G LOOP
  1.  ; check if right identifier
  1.  I LRIDENT="X" G LP1
  1.  I $P(LR0,U,5)=""&(LRIDENT="N") G LP1
  1.  I $P(LR0,U,5)'=LRIDENT D XSET(LRIDENT,LRRUN) G LOOP
  1.  ;
  1. LP1 ; ask inactive date
  1.  ; first lock entry
  1.  L +^LAB(61.2,LRRUN):60 I '$T D  G OUT
  1.  . K MSG S MSG(1)="Not Able to Lock Entry ("_$E($P(LR0,U,1),1,45)_" ["_LRRUN_"]). Quitting"
  1.  . S MSG(2)=""
  1.  . D DISP
  1.  W !!,"Organism: ",$E($P(LR0,U,1),1,45)," (",LRRUN,")"
  1.  K Y,DIE,DTOUT S DIE("NO^")="OUTOK",DIE="^LAB(61.2,",DA=LRRUN,DR="64.9102" D ^DIE
  1.  L -^LAB(61.2,LRRUN)
  1.  ; check if ^ was entered
  1.  I $D(Y) D  G OUT
  1.  . K MSG S MSG(1)="An '^' was detected. Quitting"
  1.  . S MSG(2)=""
  1.  . D DISP
  1.  D XSET(LRIDENT,LRRUN)
  1.  G LOOP
  1.  ;
  1. ASKFILE()  ; Ask user to select Identifier
  1.  K DIR,DIRUT
  1.  S DIR(0)="SO^B:BACTERIUM;F:FUNGUS;P:PARASITE;M:MYCOBACTERIUM;V:VIRUS;C:CHEMICAL;D:DRUG;R:RICKETTSIAE;A:PHYSICAL AGENT;N:NULL;X:ALL"
  1.  S DIR("L",1)="   BACTERIUM           (B)"
  1.  S DIR("L",2)="   FUNGUS              (F)"
  1.  S DIR("L",3)="   PARASITE            (P)"
  1.  S DIR("L",4)="   MYCOBACTERIUM       (M)"
  1.  S DIR("L",5)="   VIRUS               (V)"
  1.  S DIR("L",6)="   CHEMICAL            (C)"
  1.  S DIR("L",7)="   DRUG                (D)"
  1.  S DIR("L",8)="   RICKETTSIAE         (R)"
  1.  S DIR("L",9)="   PHYSICAL AGENT      (A)"
  1.  S DIR("L",10)="   NULL                (N)"
  1.  S DIR("L")="   ALL                 (X)"
  1.  S DIR("A")="Enter the Identifier Name or Code "
  1.  D ^DIR
  1.  Q
  1.  ;
  1. DISP ; display message
  1.  D CLEAR^VALM1
  1.  D BMES^XPDUTL(.MSG)
  1.  Q
  1.  ;
  1. GETVAL(C) ; get 61.2 info
  1.  N A,B,D
  1.  S A=$G(^LAB(61.2,C,0)),B=$G(^LAB(61.2,C,64.91))
  1.  S D=$P(A,U,1)_U_$P(A,U,5)_U_$P(B,U,2)
  1.  Q D
  1.  ;
  1. OUT ; quit
  1.  K DIR,DIRUT,DIC,A,B,LRXT,MSG,LRRUN,LR0,LRIDENT,LRIDNM,X,Y,DIE,DTOUT,DR,DA,LR6491,DIE("NO^")
  1.  Q
  1.  ;
  1. XSET(A,B) ; set into XTMP
  1.  ; A - Identifier,  B - value
  1.  S ^XTMP(LRXT,A,0)=B
  1.  Q