DVBAUTL1 ;ALB/JLU;UTILITY ROUTINE;11/8/94
;;2.7;AMIE;;Apr 10, 1995
;
STATION(DFN) ;
;this function call returns the station number of the patient in the
;parameter or -1 if no station number.
;
N X
I '$D(^DPT(DFN,.31)) Q -1
S X=$P(^DPT(DFN,.31),U,4)
I X="" Q -1
I '$D(^DIC(4,X,99)) Q -1
S X=$P(^DIC(4,X,99),U,1)
I X<1 Q -1
Q X
;
EXIT ;this entry point is called from the DVBAPOST routine. It is used as
;the kill statment at the end of the post init.
;
I $D(V3) K CNT,LP1,V3,XMZ,XMY(DUZ),XMY(.5),XMSUB,XMDUZ
K STOP
Q
;
SET1 ;sets the parameter file node to be used in the post init Keyword
;population.
I '$D(CNT) S CNT=1
I $D(^DVB(396.1,0)) DO
.N DVBA
.S DVBA=$$IFNPAR^DVBAUTL3()
.I DVBA=0 DO
..S DIC="^DVB(396.1,",DIC(0)="L"
..K DD,D0
..S X=$P(^DG(40.8,$$PRIM^VASITE,0),U,1)
..D FILE^DICN
..S DVBA=$S(Y=-1:0,1:+Y)
..K DIC,DD,D0,Y,X
..Q
.S ^DVB(396.1,DVBA,"POST")="DVBA;ADVB;DVBB;ADVB"
.S:$P(^DVB(396.1,DVBA,0),U,15)']"" $P(^(0),U,15)=1
.S:$P(^DVB(396.1,DVBA,0),U,18)']"" $P(^(0),U,18)=1
.S:$P(^DVB(396.1,DVBA,0),U,19)']"" $P(^(0),U,19)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUTL1 1123 printed Dec 13, 2024@01:42:17 Page 2
DVBAUTL1 ;ALB/JLU;UTILITY ROUTINE;11/8/94
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
STATION(DFN) ;
+1 ;this function call returns the station number of the patient in the
+2 ;parameter or -1 if no station number.
+3 ;
+4 NEW X
+5 IF '$DATA(^DPT(DFN,.31))
QUIT -1
+6 SET X=$PIECE(^DPT(DFN,.31),U,4)
+7 IF X=""
QUIT -1
+8 IF '$DATA(^DIC(4,X,99))
QUIT -1
+9 SET X=$PIECE(^DIC(4,X,99),U,1)
+10 IF X<1
QUIT -1
+11 QUIT X
+12 ;
EXIT ;this entry point is called from the DVBAPOST routine. It is used as
+1 ;the kill statment at the end of the post init.
+2 ;
+3 IF $DATA(V3)
KILL CNT,LP1,V3,XMZ,XMY(DUZ),XMY(.5),XMSUB,XMDUZ
+4 KILL STOP
+5 QUIT
+6 ;
SET1 ;sets the parameter file node to be used in the post init Keyword
+1 ;population.
+2 IF '$DATA(CNT)
SET CNT=1
+3 IF $DATA(^DVB(396.1,0))
Begin DoDot:1
+4 NEW DVBA
+5 SET DVBA=$$IFNPAR^DVBAUTL3()
+6 IF DVBA=0
Begin DoDot:2
+7 SET DIC="^DVB(396.1,"
SET DIC(0)="L"
+8 KILL DD,D0
+9 SET X=$PIECE(^DG(40.8,$$PRIM^VASITE,0),U,1)
+10 DO FILE^DICN
+11 SET DVBA=$SELECT(Y=-1:0,1:+Y)
+12 KILL DIC,DD,D0,Y,X
+13 QUIT
End DoDot:2
+14 SET ^DVB(396.1,DVBA,"POST")="DVBA;ADVB;DVBB;ADVB"
+15 if $PIECE(^DVB(396.1,DVBA,0),U,15)']""
SET $PIECE(^(0),U,15)=1
+16 if $PIECE(^DVB(396.1,DVBA,0),U,18)']""
SET $PIECE(^(0),U,18)=1
+17 if $PIECE(^DVB(396.1,DVBA,0),U,19)']""
SET $PIECE(^(0),U,19)=1
End DoDot:1
+18 QUIT
