65 lines
2.1 KiB
Mathematica
65 lines
2.1 KiB
Mathematica
LA7SUTL ;DALISC/JMC - Shipping Utility ;5/5/97 14:44
|
|
;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
|
|
Q
|
|
;
|
|
SSCFG(SCR) ; Select shipping configuration
|
|
; Call with X = 0 no screen
|
|
; = 1 active collecting facilty screen
|
|
; = 2 active host facility screen
|
|
; Returns Y = 0 (unsuccessful) or ien of entry in file #62.9 ^ .01 field name
|
|
;
|
|
N DIR,DIRUT,DTOUT,DUOUT,X,Y
|
|
S DIR(0)="PO^62.9:EM",DIR("A")="Select Shipping Configuration"
|
|
I SCR S DIR("S")="I $P(^LAHM(62.9,Y,0),U,SCR+1)=DUZ(2),$P(^LAHM(62.9,Y,0),U,4)"
|
|
D ^DIR
|
|
I Y<1 S Y=0
|
|
Q Y
|
|
;
|
|
JULIAN(LA7DT) ; Calculate julian date based on date passed
|
|
; Call with X = VA FileMan date.
|
|
; Returns Y = julian date justified to 3 digits.
|
|
N LA7JUL
|
|
S LA7JUL=$$FMDIFF^XLFDT(LA7DT,$E(LA7DT,1,3)_"0101",1)
|
|
S LA7JUL=LA7JUL+1
|
|
I $L(LA7JUL)<3 S LA7JUL=$E("000",1,3-$L(LA7JUL))_LA7JUL
|
|
Q LA7JUL
|
|
;
|
|
AD(LA7AA) ; Determine current accession date for a given accession area.
|
|
; Call with LA7AA = ien of entry in file ACCESSION #68.
|
|
; Returns LA7AD = accession date in VA FileMan format
|
|
; 0^error message if not valid pointer
|
|
N LA7AD,X
|
|
S LA7AA=+$G(LA7AA)
|
|
I $G(LA7AA)<1 Q "0^No pointer to accession file passed"
|
|
S DT=$$DT^XLFDT
|
|
S X=$P($G(^LRO(68,LA7AA,0)),U,3)
|
|
I $L(X) S LA7AD=$S(X="D":DT,X="M":$E(DT,1,5)_"00",X="Y":$E(DT,1,3)_"0000",X="Q":$E(DT,1,3)_"0000"+(($E(DT,4,5)-1)\3*300+100),1:DT) ; Calculate accession date based on accession transform.
|
|
E S LA7AD="0^No accession transform for this accession area"
|
|
Q LA7AD
|
|
TEST(IEN) ;USED FOR THE CATALOG
|
|
K OUT
|
|
G:'$D(^LAB(60,IEN,0)) EXIT
|
|
G:$P(^LAB(60,IEN,0),U,12)="" EXIT
|
|
S LAFLD=$P(^LAB(60,IEN,0),U,12),LADATA=@(U_LAFLD_0_")")
|
|
S LATYP=$E($P(LADATA,U,2),1,1)
|
|
I $L($T(@LATYP)) D @LATYP
|
|
EXIT ;EXIT
|
|
K LADES,LAFLD,LATYP,LADATA,LAI,LANUM,LASET
|
|
S OUT=$G(OUT)
|
|
Q OUT
|
|
F ;FREE TEXT
|
|
S OUT="FREE TEXT "
|
|
S OUT=OUT_$G(@(U_LAFLD_3_")"))
|
|
Q
|
|
N ;NUMERIC
|
|
S OUT="NUMERIC "
|
|
S OUT=OUT_$G(@(U_LAFLD_3_")"))
|
|
Q
|
|
S ;SET OF CODES
|
|
S OUT="CODES "
|
|
S LASET=$P(LADATA,U,3),LANUM=$L(LASET,";")-1
|
|
Q:LANUM'>0
|
|
F LAI=1:1:LANUM S LADES=$P(LASET,";",LAI) D
|
|
.S OUT=OUT_$P(LADES,":",1)_" = "_$P(LADES,":",2)_" "
|
|
Q
|