SDAMBAE2.m

SDAMBAE2 ;ALB/BOK - ADD/EDIT CON'T ;11/21/91  12:15 ;

 ;;5.3;Scheduling;**15,79,111,132,1015**;Aug 13, 1993;Build 21

 ;

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

SDAMBAE2  ;ALB/BOK - ADD/EDIT CON'T ;11/21/91  12:15 ;

 +1       ;;5.3;Scheduling;**15,79,111,132,1015**;Aug 13, 1993;Build 21

 +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