source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SUTL.m@ 623

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1LA7SUTL ;DALISC/JMC - Shipping Utility ;5/5/97 14:44
2 ;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
3 Q
4 ;
5SSCFG(SCR) ; Select shipping configuration
6 ; Call with X = 0 no screen
7 ; = 1 active collecting facilty screen
8 ; = 2 active host facility screen
9 ; Returns Y = 0 (unsuccessful) or ien of entry in file #62.9 ^ .01 field name
10 ;
11 N DIR,DIRUT,DTOUT,DUOUT,X,Y
12 S DIR(0)="PO^62.9:EM",DIR("A")="Select Shipping Configuration"
13 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)"
14 D ^DIR
15 I Y<1 S Y=0
16 Q Y
17 ;
18JULIAN(LA7DT) ; Calculate julian date based on date passed
19 ; Call with X = VA FileMan date.
20 ; Returns Y = julian date justified to 3 digits.
21 N LA7JUL
22 S LA7JUL=$$FMDIFF^XLFDT(LA7DT,$E(LA7DT,1,3)_"0101",1)
23 S LA7JUL=LA7JUL+1
24 I $L(LA7JUL)<3 S LA7JUL=$E("000",1,3-$L(LA7JUL))_LA7JUL
25 Q LA7JUL
26 ;
27AD(LA7AA) ; Determine current accession date for a given accession area.
28 ; Call with LA7AA = ien of entry in file ACCESSION #68.
29 ; Returns LA7AD = accession date in VA FileMan format
30 ; 0^error message if not valid pointer
31 N LA7AD,X
32 S LA7AA=+$G(LA7AA)
33 I $G(LA7AA)<1 Q "0^No pointer to accession file passed"
34 S DT=$$DT^XLFDT
35 S X=$P($G(^LRO(68,LA7AA,0)),U,3)
36 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.
37 E S LA7AD="0^No accession transform for this accession area"
38 Q LA7AD
39TEST(IEN) ;USED FOR THE CATALOG
40 K OUT
41 G:'$D(^LAB(60,IEN,0)) EXIT
42 G:$P(^LAB(60,IEN,0),U,12)="" EXIT
43 S LAFLD=$P(^LAB(60,IEN,0),U,12),LADATA=@(U_LAFLD_0_")")
44 S LATYP=$E($P(LADATA,U,2),1,1)
45 I $L($T(@LATYP)) D @LATYP
46EXIT ;EXIT
47 K LADES,LAFLD,LATYP,LADATA,LAI,LANUM,LASET
48 S OUT=$G(OUT)
49 Q OUT
50F ;FREE TEXT
51 S OUT="FREE TEXT "
52 S OUT=OUT_$G(@(U_LAFLD_3_")"))
53 Q
54N ;NUMERIC
55 S OUT="NUMERIC "
56 S OUT=OUT_$G(@(U_LAFLD_3_")"))
57 Q
58S ;SET OF CODES
59 S OUT="CODES "
60 S LASET=$P(LADATA,U,3),LANUM=$L(LASET,";")-1
61 Q:LANUM'>0
62 F LAI=1:1:LANUM S LADES=$P(LASET,";",LAI) D
63 .S OUT=OUT_$P(LADES,":",1)_" = "_$P(LADES,":",2)_" "
64 Q
Note: See TracBrowser for help on using the repository browser.