VASITE ;ALB/AAS - TIME SENSETIVE VA STATION NUMBER UTILITY ; 4/22/92
;;5.3;Registration;**134**;Aug 13, 1993
;
SITE(DATE,DIV) ;
; -Output= Institution file pointer^Institution name^station number with suffix
;
; -Input (optional) date for division, if undefined will use DT
; - (optional) medical center division=pointer in 40.8
;
N PRIM,SITE
S:'$D(DATE) DATE=DT
S:'$D(DIV) DIV=$$PRIM(DATE)
I DATE'?7N!DIV<0 Q -1
S PRIM=$G(^VA(389.9,+$O(^(+$O(^VA(389.9,"AIVDT",DIV,$$IVDATE(DATE))),0)),0))
S SITE=$S('$P(PRIM,"^",6)&($P(PRIM,"^",4)?3N.AN):$P(PRIM,"^",4),1:-1)
S:SITE>0 SITE=$P(^DG(40.8,DIV,0),"^",7)_"^"_$P($G(^DIC(4,$P(^DG(40.8,DIV,0),"^",7),0)),"^")_"^"_SITE
Q SITE
;
ALL(DATE) ; -returns all possible station numbers
; -input date, if date is undefined, then date will be today
; - output VASITE= 1 or -1 if stations exist
; VASITE(station number)=station number
;
N PRIM,DIV
S:'$D(DATE) DATE=DT
S VASITE=-1
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
Q VASITE
;
IVDATE(DATE) ; -- inverse date reference start
Q -(DATE+.000001)
;
CHK ; -input transform for IS PRIMARY STATION? field
; -only 1 primary station number allowed per effective date
;
I '$P(^VA(389.9,DA,0),"^",2) W !,"Effective Date must be entered first" K X G CHKQ
I '$P(^VA(389.9,DA,0),"^",3) W !,"Medical Center Division must be entered first.",! K X G CHKQ
I $D(^VA(389.9,"AIVDT1",1,-X)) W !,"Another entry Is Primary Division for this date.",! K X G CHKQ
I 1
CHKQ I 0 Q
;
YN ; -input transform for is primary facility
I '$P(^VA(389.9,DA,0),"^",2) W !,"Effective date must be entered first!" K X Q
I '$P(^VA(389.9,DA,0),"^",3) W !,"Medical Center Division must be entered first!" K X Q
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
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
W !?4,"NOT A VALID CHOICE!",*7 K X Q
;
PRIM(DATE) ; -returns medical center division of primary medical center division
; - input date, if date is null then date will be today
;
N PRIM
S:'$D(DATE) DATE=DT S DATE=DATE+.24
S PRIM=$G(^VA(389.9,+$O(^(+$O(^VA(389.9,"AIVDT1",1,$$IVDATE(DATE))),0)),0))
Q $S($P(PRIM,"^",4)?3N:$P(PRIM,"^",3),1:-1)
;
NAME(DATE) ; -returns the new name of medical centers that have integrated
;
; -input date, if date is null then date will be today
S:'$D(DATE) DATE=DT S DATE=DATE+.24
Q $G(^VA(389.9,+$O(^(+$O(^VA(389.9,"AIVDT1",1,$$IVDATE(DATE))),0)),"INTEG"))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVASITE 2840 printed Apr 09, 2024@21:55:53 Page 2
VASITE ;ALB/AAS - TIME SENSETIVE VA STATION NUMBER UTILITY ; 4/22/92
+1 ;;5.3;Registration;**134**;Aug 13, 1993
+2 ;
SITE(DATE,DIV) ;
+1 ; -Output= Institution file pointer^Institution name^station number with suffix
+2 ;
+3 ; -Input (optional) date for division, if undefined will use DT
+4 ; - (optional) medical center division=pointer in 40.8
+5 ;
+6 NEW PRIM,SITE
+7 if '$DATA(DATE)
SET DATE=DT
+8 if '$DATA(DIV)
SET DIV=$$PRIM(DATE)
+9 IF DATE'?7N!DIV<0
QUIT -1
+10 SET PRIM=$GET(^VA(389.9,+$ORDER(^(+$ORDER(^VA(389.9,"AIVDT",DIV,$$IVDATE(DATE))),0)),0))
+11 SET SITE=$SELECT('$PIECE(PRIM,"^",6)&($PIECE(PRIM,"^",4)?3N.AN):$PIECE(PRIM,"^",4),1:-1)
+12 if SITE>0
SET SITE=$PIECE(^DG(40.8,DIV,0),"^",7)_"^"_$PIECE($GET(^DIC(4,$PIECE(^DG(40.8,DIV,0),"^",7),0)),"^")_"^"_SITE
+13 QUIT SITE
+14 ;
ALL(DATE) ; -returns all possible station numbers
+1 ; -input date, if date is undefined, then date will be today
+2 ; - output VASITE= 1 or -1 if stations exist
+3 ; VASITE(station number)=station number
+4 ;
+5 NEW PRIM,DIV
+6 if '$DATA(DATE)
SET DATE=DT
+7 SET VASITE=-1
+8 SET DIV=0
FOR
SET DIV=$ORDER(^VA(389.9,"C",DIV))
if 'DIV
QUIT
SET PRIM=$GET(^VA(389.9,+$ORDER(^(+$ORDER(^VA(389.9,"AIVDT",DIV,$$IVDATE(DATE))),0)),0))
if '$PIECE(PRIM,"^",6)&($PIECE(PRIM,"^",4)?3N)
SET VASITE($PIECE(PRIM,"^",4))=$PIECE(PRIM,"^",4)
SET VASITE=1
+9 QUIT VASITE
+10 ;
IVDATE(DATE) ; -- inverse date reference start
+1 QUIT -(DATE+.000001)
+2 ;
CHK ; -input transform for IS PRIMARY STATION? field
+1 ; -only 1 primary station number allowed per effective date
+2 ;
+3 IF '$PIECE(^VA(389.9,DA,0),"^",2)
WRITE !,"Effective Date must be entered first"
KILL X
GOTO CHKQ
+4 IF '$PIECE(^VA(389.9,DA,0),"^",3)
WRITE !,"Medical Center Division must be entered first.",!
KILL X
GOTO CHKQ
+5 IF $DATA(^VA(389.9,"AIVDT1",1,-X))
WRITE !,"Another entry Is Primary Division for this date.",!
KILL X
GOTO CHKQ
+6 IF 1
CHKQ IF 0
QUIT
+1 ;
YN ; -input transform for is primary facility
+1 IF '$PIECE(^VA(389.9,DA,0),"^",2)
WRITE !,"Effective date must be entered first!"
KILL X
QUIT
+2 IF '$PIECE(^VA(389.9,DA,0),"^",3)
WRITE !,"Medical Center Division must be entered first!"
KILL X
QUIT
+3 IF $DATA(^VA(389.9,"AIVDT1",1,-$PIECE(^VA(389.9,DA,0),"^",2)))
WRITE !,"Only one division can be primary division for an effective date!"
KILL X
QUIT
+4 SET X=$EXTRACT(X)
SET X=$SELECT(X=1:X,X=0:X,X="Y":1,X="y":1,X="n":0,X="N":0,1:2)
IF X'=2
WRITE " (",$SELECT(X:"YES",1:"NO"),")"
QUIT
+5 WRITE !?4,"NOT A VALID CHOICE!",*7
KILL X
QUIT
+6 ;
PRIM(DATE) ; -returns medical center division of primary medical center division
+1 ; - input date, if date is null then date will be today
+2 ;
+3 NEW PRIM
+4 if '$DATA(DATE)
SET DATE=DT
SET DATE=DATE+.24
+5 SET PRIM=$GET(^VA(389.9,+$ORDER(^(+$ORDER(^VA(389.9,"AIVDT1",1,$$IVDATE(DATE))),0)),0))
+6 QUIT $SELECT($PIECE(PRIM,"^",4)?3N:$PIECE(PRIM,"^",3),1:-1)
+7 ;
NAME(DATE) ; -returns the new name of medical centers that have integrated
+1 ;
+2 ; -input date, if date is null then date will be today
+3 if '$DATA(DATE)
SET DATE=DT
SET DATE=DATE+.24
+4 QUIT $GET(^VA(389.9,+$ORDER(^(+$ORDER(^VA(389.9,"AIVDT1",1,$$IVDATE(DATE))),0)),"INTEG"))
