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 ---[H[J[2J[HIBDFDE10 620 printed Dec 13, 2024@02:52:14 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
