source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSSGET.m@ 1450

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1GECSSGET ;WISC/RFJ/KLD-get data from stack file ;13 Oct 98
2 ;;2.0;GCS;**19,28**;MAR 14, 1995
3 Q
4 ;
5 ;
6DATA(DOCID,CODESHET) ; return data from stack file for docid (.01 field)
7 ; pass codeshet=1 for code sheet data also
8 ; data will be returned in gecsdata
9 K GECSDATA
10 N %,D0,DA,DIC,DIQ,DIQ2,DR
11 S DOCID=$$PADSPACE(DOCID)
12 S DA=+$O(^GECS(2100.1,"B",DOCID,0)) Q:'DA
13 S DIC="^GECS(2100.1,",DR=".01:26",DIQ="GECSDATA",DIQ(0)="E"
14 I '$G(CODESHET) S DR=".01:7;11:26"
15 S GECSDATA=DA
16 D EN^DIQ1
17 Q
18 ;
19 ;
20STATUS(DOCID) ; return status of docid (.01 field)
21 ; return -1 if entry not found
22 N %,DA,STATUS
23 S DOCID=$$PADSPACE(DOCID)
24 S DA=+$O(^GECS(2100.1,"B",DOCID,0)) I 'DA Q -1
25 S STATUS=$P($G(^GECS(2100.1,DA,0)),"^",4)
26 Q $P($P($P(^DD(2100.1,3,0),"^",3),STATUS_":",2),";")
27 ;
28 ;
29PADSPACE(DOCID) ; return docid with padded spaces
30 N %
31 S %=$P(DOCID,"-")_$E(" ",1,2-$L($P(DOCID,"-")))_"-"_$P(DOCID,"-",2)_$E(" ",1,11-$L($P(DOCID,"-",2)))
32 I $P(DOCID,"-",3)'="" S %=%_"-"_$P(DOCID,"-",3)_$E(" ",1,6-$L($P(DOCID,"-",3)))
33 Q %
34 ;
35 ;
36KEYLOOK(GECSKEY,CODESHET) ; lookup and return document data based on a lookup key
37 ; codeshet passed to data to return the document code sheet data
38 N GECSDA,GECSDOC
39 I $L(GECSKEY)="" Q
40 ; find the document ien based on input key
41 S GECSDA=$O(^GECS(2100.1,"KEY",GECSKEY,0))
42 I 'GECSDA Q
43 ; find the document identifier (.01 field)
44 S GECSDOC=$P($G(^GECS(2100.1,GECSDA,0)),"^")
45 I GECSDOC="" Q
46 ; get the data
47 D DATA(GECSDOC,CODESHET)
48 Q
49 ;
50 ;
51GETID(IEN) ; return .01 field of file #2100.1
52 ;
53 N ID
54 S ID=$$GET1^DIQ(2100.1,IEN,.01)
55 Q ID
Note: See TracBrowser for help on using the repository browser.