- 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
