source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VASITE.m@ 1141

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1VASITE ;ALB/AAS - TIME SENSETIVE VA STATION NUMBER UTILITY ; 4/22/92
2 ;;5.3;Registration;**134**;Aug 13, 1993
3 ;
4SITE(DATE,DIV) ;
5 ; -Output= Institution file pointer^Institution name^station number with suffix
6 ;
7 ; -Input (optional) date for division, if undefined will use DT
8 ; - (optional) medical center division=pointer in 40.8
9 ;
10 N PRIM,SITE
11 S:'$D(DATE) DATE=DT
12 S:'$D(DIV) DIV=$$PRIM(DATE)
13 I DATE'?7N!DIV<0 Q -1
14 S PRIM=$G(^VA(389.9,+$O(^(+$O(^VA(389.9,"AIVDT",DIV,$$IVDATE(DATE))),0)),0))
15 S SITE=$S('$P(PRIM,"^",6)&($P(PRIM,"^",4)?3N.AN):$P(PRIM,"^",4),1:-1)
16 S:SITE>0 SITE=$P(^DG(40.8,DIV,0),"^",7)_"^"_$P($G(^DIC(4,$P(^DG(40.8,DIV,0),"^",7),0)),"^")_"^"_SITE
17 Q SITE
18 ;
19ALL(DATE) ; -returns all possible station numbers
20 ; -input date, if date is undefined, then date will be today
21 ; - output VASITE= 1 or -1 if stations exist
22 ; VASITE(station number)=station number
23 ;
24 N PRIM,DIV
25 S:'$D(DATE) DATE=DT
26 S VASITE=-1
27 S DIV=0 F S DIV=$O(^VA(389.9,"C",DIV)) Q:'DIV S PRIM=$G(^VA(389.9,+$O(^(+$O(^VA(389.9,"AIVDT",DIV,$$IVDATE(DATE))),0)),0)) S:'$P(PRIM,"^",6)&($P(PRIM,"^",4)?3N) VASITE($P(PRIM,"^",4))=$P(PRIM,"^",4),VASITE=1
28 Q VASITE
29 ;
30IVDATE(DATE) ; -- inverse date reference start
31 Q -(DATE+.000001)
32 ;
33CHK ; -input transform for IS PRIMARY STATION? field
34 ; -only 1 primary station number allowed per effective date
35 ;
36 I '$P(^VA(389.9,DA,0),"^",2) W !,"Effective Date must be entered first" K X G CHKQ
37 I '$P(^VA(389.9,DA,0),"^",3) W !,"Medical Center Division must be entered first.",! K X G CHKQ
38 I $D(^VA(389.9,"AIVDT1",1,-X)) W !,"Another entry Is Primary Division for this date.",! K X G CHKQ
39 I 1
40CHKQ I 0 Q
41 ;
42YN ; -input transform for is primary facility
43 I '$P(^VA(389.9,DA,0),"^",2) W !,"Effective date must be entered first!" K X Q
44 I '$P(^VA(389.9,DA,0),"^",3) W !,"Medical Center Division must be entered first!" K X Q
45 I $D(^VA(389.9,"AIVDT1",1,-$P(^VA(389.9,DA,0),"^",2))) W !,"Only one division can be primary division for an effective date!" K X Q
46 S X=$E(X),X=$S(X=1:X,X=0:X,X="Y":1,X="y":1,X="n":0,X="N":0,1:2) I X'=2 W " (",$S(X:"YES",1:"NO"),")" Q
47 W !?4,"NOT A VALID CHOICE!",*7 K X Q
48 ;
49PRIM(DATE) ; -returns medical center division of primary medical center division
50 ; - input date, if date is null then date will be today
51 ;
52 N PRIM
53 S:'$D(DATE) DATE=DT S DATE=DATE+.24
54 S PRIM=$G(^VA(389.9,+$O(^(+$O(^VA(389.9,"AIVDT1",1,$$IVDATE(DATE))),0)),0))
55 Q $S($P(PRIM,"^",4)?3N:$P(PRIM,"^",3),1:-1)
56 ;
57NAME(DATE) ; -returns the new name of medical centers that have integrated
58 ;
59 ; -input date, if date is null then date will be today
60 S:'$D(DATE) DATE=DT S DATE=DATE+.24
61 Q $G(^VA(389.9,+$O(^(+$O(^VA(389.9,"AIVDT1",1,$$IVDATE(DATE))),0)),"INTEG"))
Note: See TracBrowser for help on using the repository browser.