- 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 Jan 18, 2025@02:43:31 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