- SDAMBAE2 ;ALB/BOK - ADD/EDIT CON'T ;11/21/91 12:15 ;
- ;;5.3;Scheduling;**15,79,111,132**;Aug 13, 1993
- ;
- APP ; -- screen on APPOINTMENT TYPE field in VISIT file CLINIC STOP multiple
- ; Z - zeroth node of app type file - NAKED REFERENCE - ^SD(409.1,IFN,0)
- ; P - pt ifn
- ; E - pt's elig code
- ; V - elig code is vet code
- ;
- N Z,P,E,V
- S Z=^(0),P=+$P(^SDV(DA(1),0),U,2),E=$S($D(^DPT(P,.36)):+^(.36),1:0),V=$S($D(^DIC(8,E,0)):$P(^(0),U,5),1:"")
- I '$P(Z,U,3),$S(V["Y":1,1:$P(Z,U,5)),$S('$P(Z,U,6):1,$D(^DPT(P,"E",$P(Z,U,6),0)):1,1:E=$P(Z,U,6))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMBAE2 579 printed Feb 19, 2025@00:13:50 Page 2
- SDAMBAE2 ;ALB/BOK - ADD/EDIT CON'T ;11/21/91 12:15 ;
- +1 ;;5.3;Scheduling;**15,79,111,132**;Aug 13, 1993
- +2 ;
- APP ; -- screen on APPOINTMENT TYPE field in VISIT file CLINIC STOP multiple
- +1 ; Z - zeroth node of app type file - NAKED REFERENCE - ^SD(409.1,IFN,0)
- +2 ; P - pt ifn
- +3 ; E - pt's elig code
- +4 ; V - elig code is vet code
- +5 ;
- +6 NEW Z,P,E,V
- +7 SET Z=^(0)
- SET P=+$PIECE(^SDV(DA(1),0),U,2)
- SET E=$SELECT($DATA(^DPT(P,.36)):+^(.36),1:0)
- SET V=$SELECT($DATA(^DIC(8,E,0)):$PIECE(^(0),U,5),1:"")
- +8 IF '$PIECE(Z,U,3)
- IF $SELECT(V["Y":1,1:$PIECE(Z,U,5))
- IF $SELECT('$PIECE(Z,U,6):1,$DATA(^DPT(P,"E",$PIECE(Z,U,6),0)):1,1:E=$PIECE(Z,U,6))
- +9 QUIT