IBDFDE10.m

IBDFDE10 ;ALB/AAS - AICS Data entry utility ; 5-MAR-97

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;

SCREEN(Y,IBDDT) ; -- Copy of provider screen from sdutl2

 ;

 ; INPUT:      Y = ien of file 200

 ;         IBDDT = today's date

 ;

 ; OUTPUT: 1 to select; 0 to not select

 ;

 N IBDINACT,IBDT,IBDY S IBDY=0

 S:'+$G(IBDDT) IBDDT=DT

 I '+$G(Y) G SCRNQ

 ;

 S IBDINACT=$G(^VA(200,+Y,"PS"))

 I '$S(IBDINACT']"":1,'+$P(IBDINACT,"^",4):1,DT<+$P(IBDINACT,"^",4):1,1:0) G SCRNQ

 S IBDT=+$P($G(^VA(200,+Y,0)),U,11)

 I $S('IBDT:0,(IBDT<DT):1,1:0) G SCRNQ

 I $$GET^XUA4A72(Y,IBDDT)>0 S IBDY=1

SCRNQ Q IBDY

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBDFDE10   620     printed  Apr 09, 2024@21:18:50                                                                                                                                                                                                     Page 2

IBDFDE10  ;ALB/AAS - AICS Data entry utility ; 5-MAR-97

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;

SCREEN(Y,IBDDT) ; -- Copy of provider screen from sdutl2

 +1       ;

 +2       ; INPUT:      Y = ien of file 200

 +3       ;         IBDDT = today's date

 +4       ;

 +5       ; OUTPUT: 1 to select; 0 to not select

 +6       ;

 +7        NEW IBDINACT,IBDT,IBDY

           SET IBDY=0

 +8        if '+$GET(IBDDT)

               SET IBDDT=DT

 +9        IF '+$GET(Y)

               GOTO SCRNQ

 +10      ;

 +11       SET IBDINACT=$GET(^VA(200,+Y,"PS"))

 +12       IF '$SELECT(IBDINACT']"":1,'+$PIECE(IBDINACT,"^",4):1,DT<+$PIECE(IBDINACT,"^",4):1,1:0)

               GOTO SCRNQ

 +13       SET IBDT=+$PIECE($GET(^VA(200,+Y,0)),U,11)

 +14       IF $SELECT('IBDT:0,(IBDT<DT):1,1:0)

               GOTO SCRNQ

 +15       IF $$GET^XUA4A72(Y,IBDDT)>0

               SET IBDY=1

SCRNQ      QUIT IBDY