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

ONCOLRU.m

Go to the documentation of this file.
  1. ONCOLRU ;Hines OIFO/GWB - LAB UTILITY ;8/21/93
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. ;
  1. D S %=$E(Y,4,5)*3
  1. S Y=$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" "_$S($E(Y,6,7):$J(+$E(Y,6,7),2)_", ",1:"")_($E(Y,1,3)+1700)_$S(Y[".":" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"")
  1. S:Y[1700 Y=""
  1. Q
  1. ;
  1. SSN S SSN(2)=SSN
  1. I $L(DUZ("AG")),"NAFARMY"[DUZ("AG") S SSN=$S($L(SSN)<11:$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10),1:$E(SSN,10,11)_"/"_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)) S SSN(1)=$S($P(SSN,"-",3):$P(SSN,"-",3),1:$E(SSN,9,12)) Q
  1. S:$L(SSN)>8 SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,99)
  1. S SSN(1)=$S($P(SSN,"-",3):$P(SSN,"-",3),1:"????") S:'$L(SSN) SSN="?" Q
  1. ;
  1. B ;Start Date/Go to Date
  1. S Y=$P(^ONCO(160.1,OSP,0),U,5)
  1. I Y="" S Y=DT
  1. S Y=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
  1. S %DT="AEX",%DT(0)="-"_DT,%DT("A")="Start Date: ",%DT("B")=Y
  1. D ^%DT K %DT
  1. Q:Y<1 S LRSDT=Y
  1. S %DT="AEX",%DT(0)="-"_DT,%DT("A")="Go to Date: ",%DT("B")="TODAY"
  1. D ^%DT K %DT
  1. Q:Y<1 S LRLDT=Y I LRSDT>LRLDT S X=LRSDT,LRSDT=LRLDT,LRLDT=X
  1. S $P(^ONCO(160.1,OSP,0),U,5)=LRLDT
  1. S Y=LRSDT D D S LRSTR=Y,Y=LRLDT D D S LRLST=Y Q
  1. ;
  1. ;
  1. V K A,B,C,D,DEF,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
  1. K AGE,DOB,PNM,POP,SEX
  1. K DIC,DIE,DR,DFN,DIWF,D0,DQ,DA,DX,DE,DG
  1. K %Y,%X
  1. K ZTSK,ZTRTN,ZTSAVE,ZTDESC
  1. K LRWHO,LRSDT,LRLDT,LRSTR,LRLST,LRXR,LRXREF,LRADM,LRADX,LRABV,LRAWRD
  1. K LRAX,LRAD,LRDPAF,LRFNAM,LRMD,LRPF,LRPFN,LRSVC,LRID,LRAP,LRSAV,LREP
  1. K LRDTI,LRODT,LRSN,LRBL,LRCPT,LRFND,LRPPT,LRIDT,LRPMD,LRRMD,LR,LRA,LRB
  1. K LRC,LRD,LRE,LRF,LRG,LRH,LRI,LRJ,LRK,LRL,LRM,LRN,LRO,LRP,LRQ,LRR,LRS
  1. K LRT,LRU,LRV,LRW,LRX,LRY,LRZ,LRAU,LRFLN,LRLIDT,LRND,LRST,LRTK,LRWW
  1. K LRAC,DIWL,DIWR,DIWF,LROLLOC,LRCAPLOC,LRDFN,LRSF,LR,LRAN,LRAA,LRSOP
  1. K LROPT,LRRH,SSN,LRLLOC,LRDPF,LREND,LREXP,LRTOD,LRABO,LRPABO,LRPRH,LRSS
  1. K LRCS,LRRC,LRSIT,LRWHN,LRSA,LRIFN,LRBLT
  1. K ^TMP($J),^TMP("LRBL",$J)
  1. Q