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

LRWLST1A.m

Go to the documentation of this file. 
  1. LRWLST1A ;DALOI/JDB - ACCESSION SETUP CONT ;03/07/12  16:44
  1.  ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
  1.  ;
  1.  Q
  1.  ;
  1. SLRSS ;
  1.  ; 
  1.  ; Originally in SLRSS^LRWLST11.
  1.  ; Note: This subroutine gets called after AP Log-in (LRAP)
  1.  ; as well as from other processes such as LEDI.
  1.  ;
  1.  ; Expects: LRAA,LRAD,LRAN,LRCDT,LRDFN,LREAL,LRIDT,LRLLOC,LRNT
  1.  ; LRORU3,LRPRAC,LRSAMP,LRSPEC,LRSS,LRORDRR,LRRSITE,LROLLOC
  1.  ;
  1.  N FLD,FLDS,LRFILE,LRFLDS,LRDATA,DATA,X,I
  1.  N LRFDA,LRIEN,LRMSG,DIERR
  1.  S LRFILE=$S(LRSS="CH":63.04,LRSS="MI":63.05,LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,LRSS="BB":63.01,1:0)
  1.  Q:'LRFILE
  1.  ;
  1.  ; Fields to use for each subfile
  1.  S LRFLDS=""
  1.  I LRSS="CH" D  ;
  1.  . S LRFLDS=".01;.02;.05;.06;.09;.1;.11;.111;.112;.31;.32;.33;.34;.342"
  1.  I LRSS="MI" D  ;
  1.  . S LRFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.055;.111;.112;.31;.32;.33;.34;.342"
  1.  I LRSS="SP" D  ;
  1.  . S LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
  1.  I LRSS="CY" D  ;
  1.  . S LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
  1.  I LRSS="EM" D  ;
  1.  . S LRFLDS=".01;.02;.06;.07;.08;.09;.1;.31;.32;.33;.34;.342"
  1.  I LRSS="BB" D  ;
  1.  . S LRFLDS=".01;.02;.05;.06;.07;.08;.09;.1;.055"
  1.  Q:LRFLDS=""
  1.  ;
  1.  ; Get current values from database
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  D GETS^DIQ(LRFILE,LRIEN,LRFLDS,"IN","LRDATA","LRMSG")
  1.  M DATA=LRDATA(LRFILE,LRIEN)
  1.  ; DATA(field#,"I")=value
  1.  K LRDATA
  1.  ;
  1.  S FLD=""
  1.  F I=1:1:$L(LRFLDS,";") S FLD=$P(LRFLDS,";",I) Q:'FLD  D  ;
  1.  . ; skip if database already has a value
  1.  . Q:$G(DATA(FLD,"I"))'=""
  1.  . ;
  1.  . ; dont process .01 field
  1.  . I FLD=.01 Q
  1.  . ;
  1.  . I FLD=.02 I "CHMI"[LRSS D  Q  ;
  1.  . . D MAKEFDA(.02,LREAL)
  1.  . ;
  1.  . ; Is there a pathologist variable available here?
  1.  . ;I FLD=.02 I "^63.08^63.09^63.02^"[("^"_LRFILE_"^") D  Q  ;
  1.  . ;I FLD=.02 I "SPCYEM"[LRSS D  Q  ;
  1.  . ;. D MAKEFDA(.02,LREAL)
  1.  . ;
  1.  . I FLD=.05 I "CHMIBB"[LRSS D  Q  ;
  1.  . . I LRSS="CH" D MAKEFDA(.05,LRSPEC)
  1.  . . I LRSS'="CH" D  ;
  1.  . . . S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
  1.  . . . S X=$P(X,U,1)
  1.  . . . D MAKEFDA(.05,X)
  1.  . . ;
  1.  . ;
  1.  . I FLD=.055 I "MIBB"[LRSS D  Q  ;
  1.  . . S X=$P(LRSAMP,";",1)
  1.  . . D MAKEFDA(.055,X)
  1.  . ;
  1.  . I FLD=.06 D MAKEFDA(.06,LRACC) Q  ;
  1.  . ;
  1.  . ;FLD .07 handled below
  1.  . ;FLD .08 handled below
  1.  . ;
  1.  . ;I FLD=.09 I "SPCYEMBB"[LRSS  D  Q  ;
  1.  . ;. ;D MAKEFDA(.09,"????")  ; ???what goes here???
  1.  . ;I FLD=.09 I LRSS="CH" D  Q  ;
  1.  . ;. ;D MAKEFDA(.09,"????")  ;;???SUM REPROT NUM???
  1.  . ;I FLD=.09 I LRSS="MI" D  Q  ;
  1.  . ;. ;D MAKEFDA(.09,"????")  ;;???AMENDED REPORT???
  1.  . ;
  1.  . ; FLD .1 handled below
  1.  . ; FLD .11 handled below
  1.  . ;
  1.  . I FLD=.111 I "CHMI"[LRSS  D  Q  ;
  1.  . . S X=""
  1.  . . I $G(LRORDRR)="R" I +$G(LRRSITE("RSITE")) D  ;
  1.  . . . S X=+LRRSITE("RSITE")_";DIC(4,"
  1.  . . I $G(LRORDRR)'="R" I $G(LROLLOC) D  ;
  1.  . . . S X=LROLLOC_";SC("
  1.  . . Q:X=""
  1.  . . D MAKEFDA(.111,X)
  1.  . ;
  1.  . I FLD=.112 I "CHMI"[LRSS  D  Q  ;
  1.  . . S X=$G(LRDUZ(2))
  1.  . . I X="" S X=$G(DUZ(2))
  1.  . . D MAKEFDA(.112,X)
  1.  . ;
  1.  . ;
  1.  . I LRSS="CH" D  Q  ;
  1.  . . I FLD=.07 Q 
  1.  . . I FLD=.1 D MAKEFDA(.1,LRPRAC)
  1.  . . I FLD=.11 D MAKEFDA(.11,LRLLOC)
  1.  . ;
  1.  . I "MICYSPEMBB"[LRSS D  Q  ;
  1.  . . I FLD=.07 D MAKEFDA(.07,LRPRAC)
  1.  . . I FLD=.08 D MAKEFDA(.08,LRLLOC)
  1.  . . I FLD=.1 D MAKEFDA(.1,LRNT)
  1.  . ;
  1.  ;
  1.  I $G(LRORU3)'="" I "CHMISPCYEM"[LRSS D  ;
  1.  . D MAKEFDA(.31,$P(LRORU3,U))
  1.  . D MAKEFDA(.32,$P(LRORU3,U,2))
  1.  . D MAKEFDA(.33,$P(LRORU3,U,3))
  1.  . D MAKEFDA(.34,$P(LRORU3,U,4))
  1.  . D MAKEFDA(.342,$P(LRORU3,U,5))
  1.  ;
  1.  I $D(LRFDA(63)) D FILE^DIE("","LRFDA(63)","LRMSG")
  1.  ;
  1.  Q
  1.  ;
  1. MAKEFDA(FLD,VAL) ;
  1.  ; Adds entries to the LRFDA array.
  1.  ; Helper method for SLRSS method.
  1.  ; (Private method)
  1.  ; Requires LRFILE,LRIEN,DATA variables in symbol table
  1.  ; Inputs
  1.  ;   FLD : Field #
  1.  ;   VAL : Value
  1.  ;
  1.  Q:$G(DATA(FLD,"I"))'=""
  1.  Q:VAL=""
  1.  S LRFDA(63,LRFILE,LRIEN,FLD)=VAL
  1.  Q
  1.  ;
  1. SLRSSOLD ;
  1.  Q
  1.  ; For legacy documentation only
  1.  ; This is the code that was in SLRSS^LRWLST11
  1.  ;S FDAIEN(1)=LRIDT
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.01)=LRCDT
  1.  ;S:"CYSPEM"'[LRSS FDA(63,LRX,LRIDT_","_LRDFN_",",.02)=LREAL
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.05)=$P(H8,U)
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.06)=$P(H8,U,2)
  1.  ;I "MICYSPEMBB"[LRSS S FDA(63,LRX,LRIDT_","_LRDFN_",",.07)=LRPRAC
  1.  ;I LRSS="CH" S FDA(63,LRX,LRIDT_","_LRDFN_",",.07)=$P(H8,U,3)
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.08)=$P(H8,U,4)
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.09)=$P(H8,U,5)
  1.  ;I LRSS="CH" S FDA(63,LRX,LRIDT_","_LRDFN_",",.1)=LRPRAC
  1.  ;I "MICYSPEMBB"[LRSS S FDA(63,LRX,LRIDT_","_LRDFN_",",.1)=LRNT
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.055)=$P(H8,U,7)
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.2)=$P(H8,U,8)
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.111)=$P(H8,U,9)
  1.  ;S FDA(63,LRX,LRIDT_","_LRDFN_",",.112)=$P(H8,U,10)
  1.  ;I $G(LRORU3)'="" D
  1.  ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.31)=$P(LRORU3,U)
  1.  ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.32)=$P(LRORU3,U,2)
  1.  ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.33)=$P(LRORU3,U,3)
  1.  ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.34)=$P(LRORU3,U,4)
  1.  ;.S FDA(63,LRX,LRIDT_","_LRDFN_",",.342)=$P(LRORU3,U,5)
  1.  ;I LRX D FILE^DIE("","FDA(63)","LRDIE(63)")
  1.  Q