| [613] | 1 | VASITE ;ALB/AAS - TIME SENSETIVE VA STATION NUMBER UTILITY ; 4/22/92
|
|---|
| 2 | ;;5.3;Registration;**134**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | SITE(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 | ;
|
|---|
| 19 | ALL(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 | ;
|
|---|
| 30 | IVDATE(DATE) ; -- inverse date reference start
|
|---|
| 31 | Q -(DATE+.000001)
|
|---|
| 32 | ;
|
|---|
| 33 | CHK ; -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
|
|---|
| 40 | CHKQ I 0 Q
|
|---|
| 41 | ;
|
|---|
| 42 | YN ; -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 | ;
|
|---|
| 49 | PRIM(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 | ;
|
|---|
| 57 | NAME(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"))
|
|---|
