| 1 | ONCOLRU ;HInes OIFO/GWB - LAB UTILITY ;8/21/93
|
|---|
| 2 | ;;2.11;ONCOLOGY;**16,34**;Mar 07, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | D 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 | ;
|
|---|
| 9 | SSN 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 | ;
|
|---|
| 14 | B ;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 | ;
|
|---|
| 28 | 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
|
|---|
| 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
|
|---|
