AGEVST ; cmi/flag/maw - AGEV Scheduled Visit Task ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
;this routine will go through file 44 and task eligibility
;requests for the following day's scheduled visits.
;
MAIN ;-- this is the main routine driver
D ASK
Q:Y<0
S AGEVTB=$P((^INTHU(0)),U,3)
D TASK
G EOJ:AGEVYN
D LOOP
Q
;
TASK ;-- if they want to task it
S DIR(0)="Y",DIR("A")="Would You like to Queue this "
S DIR("B")="Y"
D ^DIR
S AGEVYN=+Y
Q:AGEVYN<1
K DIR
F CIMTSKV="AGEVEXT","AGEVBDT","AGEVEDT","AGEVOELG","AGEVTB" S ZTSAVE(CIMTSKV)=""
S ZTIO=""
S ZTRTN="LOOP^AGEVST",ZTDESC="Envoy Eligibility Scheduled Visit Task"
D ^%ZTLOAD
Q
;
ASK ;-- get the beginning and end dates for search
S %DT="AEP",%DT("A")="Enter Begin Date: ",%DT("B")=$$FMTE^XLFDT(DT)
D ^%DT
Q:Y<0
S AGEVBDT=Y-.0001
K %DT
S %DT="AEP",%DT("A")="Enter End Date: ",%DT("B")=$$FMTE^XLFDT(DT)
D ^%DT
Q:Y<0
S AGEVEDT=Y+.9999
K %DT
S DIR(0)="Y"
S DIR("A")="Would you like to override previous eligibility checks "
D ^DIR
S AGEVOELG=+Y
K DIR
Q
;
LOOP ;-- loop through file 44 and get scheduled visits
D ^XBKVAR
S AGEVEXT=1
S AGEVVDA=0
F S AGEVVDA=$O(^SC(AGEVVDA)) Q:'AGEVVDA D
. S AGEVDT=AGEVBDT
. F S AGEVDT=$O(^SC(AGEVVDA,"S",AGEVDT)) Q:'AGEVDT!(AGEVDT>AGEVEDT) D
.. S AGEVIEN=0
.. F S AGEVIEN=$O(^SC(AGEVVDA,"S",AGEVDT,1,AGEVIEN)) Q:'AGEVIEN D
... S AGEVSPAT=$P($G(^SC(AGEVVDA,"S",AGEVDT,1,AGEVIEN,0)),U)
... S AGEVCDT=$P($G(AGEVDT),".")
... Q:$$ECHK^AGEVC(AGEVSPAT,AGEVCDT,$G(AGEVOELG))
... D E1^AGEVC(AGEVCDT)
... D AL^AGEVC(AGEVSPAT,$G(AGEVVST))
...Q
..Q
.Q
D EOJ
Q
;
CD(DT) ;-- get date to check
S X1=DT,X2=+1
D C^%DTC
Q X
;
EOJ ;-- kill variables
D CNT
D BUL
D EN^XBVK("AGEV")
KILL BGDT,EGDT,VDA
Q
;
CNT ;-- count records created
H 300
S AGEVCTR=0
S AGEVTE=$P($G(^INTHU(0)),U,3)
S AGEVCTR=$G(AGEVTE)-$G(AGEVTB)
Q
;
BUL ;-- send a bulletin with the counts
Q:$G(AGEVYN)
S XMB="BHLX 270 REQUEST COUNT",XMB(3)=$G(AGEVCTR)
S XMB(1)=$P($$FMTE^XLFDT(AGEVBDT),"@")
S XMB(2)=$P($$FMTE^XLFDT(AGEVEDT),"@")
D ^XMB
Q
AGEVST ; cmi/flag/maw - AGEV Scheduled Visit Task ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 ;this routine will go through file 44 and task eligibility
+4 ;requests for the following day's scheduled visits.
+5 ;
MAIN ;-- this is the main routine driver
+1 DO ASK
+2 IF Y<0
QUIT
+3 SET AGEVTB=$PIECE((^INTHU(0)),U,3)
+4 DO TASK
+5 IF AGEVYN
GOTO EOJ
+6 DO LOOP
+7 QUIT
+8 ;
TASK ;-- if they want to task it
+1 SET DIR(0)="Y"
SET DIR("A")="Would You like to Queue this "
+2 SET DIR("B")="Y"
+3 DO ^DIR
+4 SET AGEVYN=+Y
+5 IF AGEVYN<1
QUIT
+6 KILL DIR
+7 FOR CIMTSKV="AGEVEXT","AGEVBDT","AGEVEDT","AGEVOELG","AGEVTB"
SET ZTSAVE(CIMTSKV)=""
+8 SET ZTIO=""
+9 SET ZTRTN="LOOP^AGEVST"
SET ZTDESC="Envoy Eligibility Scheduled Visit Task"
+10 DO ^%ZTLOAD
+11 QUIT
+12 ;
ASK ;-- get the beginning and end dates for search
+1 SET %DT="AEP"
SET %DT("A")="Enter Begin Date: "
SET %DT("B")=$$FMTE^XLFDT(DT)
+2 DO ^%DT
+3 IF Y<0
QUIT
+4 SET AGEVBDT=Y-.0001
+5 KILL %DT
+6 SET %DT="AEP"
SET %DT("A")="Enter End Date: "
SET %DT("B")=$$FMTE^XLFDT(DT)
+7 DO ^%DT
+8 IF Y<0
QUIT
+9 SET AGEVEDT=Y+.9999
+10 KILL %DT
+11 SET DIR(0)="Y"
+12 SET DIR("A")="Would you like to override previous eligibility checks "
+13 DO ^DIR
+14 SET AGEVOELG=+Y
+15 KILL DIR
+16 QUIT
+17 ;
LOOP ;-- loop through file 44 and get scheduled visits
+1 DO ^XBKVAR
+2 SET AGEVEXT=1
+3 SET AGEVVDA=0
+4 FOR
SET AGEVVDA=$ORDER(^SC(AGEVVDA))
IF 'AGEVVDA
QUIT
Begin DoDot:1
+5 SET AGEVDT=AGEVBDT
+6 FOR
SET AGEVDT=$ORDER(^SC(AGEVVDA,"S",AGEVDT))
IF 'AGEVDT!(AGEVDT>AGEVEDT)
QUIT
Begin DoDot:2
+7 SET AGEVIEN=0
+8 FOR
SET AGEVIEN=$ORDER(^SC(AGEVVDA,"S",AGEVDT,1,AGEVIEN))
IF 'AGEVIEN
QUIT
Begin DoDot:3
+9 SET AGEVSPAT=$PIECE($GET(^SC(AGEVVDA,"S",AGEVDT,1,AGEVIEN,0)),U)
+10 SET AGEVCDT=$PIECE($GET(AGEVDT),".")
+11 IF $$ECHK^AGEVC(AGEVSPAT,AGEVCDT,$GET(AGEVOELG))
QUIT
+12 DO E1^AGEVC(AGEVCDT)
+13 DO AL^AGEVC(AGEVSPAT,$GET(AGEVVST))
+14 QUIT
End DoDot:3
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 DO EOJ
+18 QUIT
+19 ;
CD(DT) ;-- get date to check
+1 SET X1=DT
SET X2=+1
+2 DO C^%DTC
+3 QUIT X
+4 ;
EOJ ;-- kill variables
+1 DO CNT
+2 DO BUL
+3 DO EN^XBVK("AGEV")
+4 KILL BGDT,EGDT,VDA
+5 QUIT
+6 ;
CNT ;-- count records created
+1 HANG 300
+2 SET AGEVCTR=0
+3 SET AGEVTE=$PIECE($GET(^INTHU(0)),U,3)
+4 SET AGEVCTR=$GET(AGEVTE)-$GET(AGEVTB)
+5 QUIT
+6 ;
BUL ;-- send a bulletin with the counts
+1 IF $GET(AGEVYN)
QUIT
+2 SET XMB="BHLX 270 REQUEST COUNT"
SET XMB(3)=$GET(AGEVCTR)
+3 SET XMB(1)=$PIECE($$FMTE^XLFDT(AGEVBDT),"@")
+4 SET XMB(2)=$PIECE($$FMTE^XLFDT(AGEVEDT),"@")
+5 DO ^XMB
+6 QUIT
