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