source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOLRU.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1ONCOLRU ;HInes OIFO/GWB - LAB UTILITY ;8/21/93
2 ;;2.11;ONCOLOGY;**16,34**;Mar 07, 1995
3 ;
4D S %=$E(Y,4,5)*3
5 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:"")
6 S:Y[1700 Y=""
7 Q
8 ;
9SSN S SSN(2)=SSN
10 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
11 S:$L(SSN)>8 SSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,99)
12 S SSN(1)=$S($P(SSN,"-",3):$P(SSN,"-",3),1:"????") S:'$L(SSN) SSN="?" Q
13 ;
14B ;Start Date/Go to Date
15 S Y=$P(^ONCO(160.1,OSP,0),U,5)
16 I Y="" S Y=DT
17 S Y=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
18 S %DT="AEX",%DT(0)="-"_DT,%DT("A")="Start Date: ",%DT("B")=Y
19 D ^%DT K %DT
20 Q:Y<1 S LRSDT=Y
21 S %DT="AEX",%DT(0)="-"_DT,%DT("A")="Go to Date: ",%DT("B")="TODAY"
22 D ^%DT K %DT
23 Q:Y<1 S LRLDT=Y I LRSDT>LRLDT S X=LRSDT,LRSDT=LRLDT,LRLDT=X
24 S $P(^ONCO(160.1,OSP,0),U,5)=LRLDT
25 S Y=LRSDT D D S LRSTR=Y,Y=LRLDT D D S LRLST=Y Q
26 ;
27 ;
28V 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
29 K AGE,DOB,PNM,POP,SEX
30 K DIC,DIE,DR,DFN,DIWF,D0,DQ,DA,DX,DE,DG
31 K %Y,%X
32 K ZTSK,ZTRTN,ZTSAVE,ZTDESC
33 K LRWHO,LRSDT,LRLDT,LRSTR,LRLST,LRXR,LRXREF,LRADM,LRADX,LRABV,LRAWRD
34 K LRAX,LRAD,LRDPAF,LRFNAM,LRMD,LRPF,LRPFN,LRSVC,LRID,LRAP,LRSAV,LREP
35 K LRDTI,LRODT,LRSN,LRBL,LRCPT,LRFND,LRPPT,LRIDT,LRPMD,LRRMD,LR,LRA,LRB
36 K LRC,LRD,LRE,LRF,LRG,LRH,LRI,LRJ,LRK,LRL,LRM,LRN,LRO,LRP,LRQ,LRR,LRS
37 K LRT,LRU,LRV,LRW,LRX,LRY,LRZ,LRAU,LRFLN,LRLIDT,LRND,LRST,LRTK,LRWW
38 K LRAC,DIWL,DIWR,DIWF,LROLLOC,LRCAPLOC,LRDFN,LRSF,LR,LRAN,LRAA,LRSOP
39 K LROPT,LRRH,SSN,LRLLOC,LRDPF,LREND,LREXP,LRTOD,LRABO,LRPABO,LRPRH,LRSS
40 K LRCS,LRRC,LRSIT,LRWHN,LRSA,LRIFN,LRBLT
41 K ^TMP($J),^TMP("LRBL",$J)
42 Q
Note: See TracBrowser for help on using the repository browser.