- BMEMFALL ; IHS/PHXAO/TMJ - Roster Fall Offs ;
- ;;1.0T1;MEDICAID ELIGIBILITY DOWNLOAD;;JUN 25, 2003
- ;
- ;This routine $ORDER's through the RPMS Master File &
- ;checks for all records who's Still Active Date is not
- ;equal to the current month's Download Date. If these
- ;patients also do not have a Fall Off Date Recorded
- ;The MEDICAID ELIGIBILITY File will be populated/updated
- ;with an ending date ONLY if one does not exist for the
- ;last entry.
- ;
- ;
- START ;
- S BMEFCNT=0
- D GETLOG ;Get Last Download Log IEN #
- D MAST
- D LOG
- D END
- Q
- ;
- ;
- ;
- GETLOG ; -- this sets up the device and sets the file name
- S BMELSTN="" ;Last Log IEN # for Last File processed
- S BMELSTNM="" ;Actual File Name in Log
- S BMELSTN=$P($G(^BMEMLOG(0)),U,3)
- I BMELSTN="" W !,"No Date Exists on Last Download Run",! G END
- S BMELOGDT=$P($G(^BMEMLOG(BMELSTN,0)),U,2) ;Run Stop Date
- S BMELOGDT=$P(BMELOGDT,".",1) ;Strip Time off Date
- ;S BMELSTNM=$P($G(^BMEMLOG(BMELSTN,0)),U,8)
- ;I BMELSTNM="" W !!,"Last File Name does NOT exist in Log. Contact Site Manager!" S BMEERROR=1 Q
- S BMEMSTDT=$P($G(^BMEMLOG(BMELSTN,0)),U,1) ;START DT/TIME
- Q:'$G(BMEMSTDT)
- S BMEMSTDT=$P(BMEMSTDT,".",1) ;Strip Time off Start Date
- Q:BMEMSTDT'=BMELOGDT ;Quit if Start and Stop Date do not match
- ;
- ;
- Q
- ;
- ;
- ;
- MAST ;Begin $O through RPMS Master File ^BMEMASTR(
- S BMEMAIEN=0 F S BMEMAIEN=$O(^BMEMASTR(BMEMAIEN)) Q:'BMEMAIEN D
- . S BMEMREC=^BMEMASTR(BMEMAIEN,0)
- . S BMESTILL=$P(BMEMREC,U,4) ;Still Eligible Date
- . Q:'BMESTILL
- . S DFN=$P(BMEMREC,U,1) ;Patient DFN #
- . Q:'DFN
- . S BMEFALL=$P(BMEMREC,U,5) ; Fall Off Date
- . Q:BMEFALL'="" ;Quit if a Fall Date already exists
- . S BMELSTDT=$P(BMEMREC,U,6) ;Last Roster End Date
- . S BMELSTDT=$S(BMELSTDT'="":BMELSTDT,1:DT) ;If No Roster End Date - End with Todays Date
- . I BMESTILL'=BMELOGDT D MED
- ;
- ;
- MED ; -- add eligiblity date(s)/data
- S IEN=$O(^AUPNMCD("B",DFN,0)) Q:'IEN
- Q:'$D(^AUPNMCD(IEN,11,0)) ;Quit if Multiple Zero Node does not exist
- S BMELEBD=$P($G(^AUPNMCD(IEN,11,0)),U,3) ;Last Beg Date IEN entered
- I BMELEBD'="" D
- . S BMELEED=$P($G(^AUPNMCD(IEN,11,BMELEBD,0)),U,2) ;End Date
- . I BMELEED="" S DR=".02///"_BMELSTDT S DIE="^AUPNMCD("_IEN_",11,",DA(1)=IEN,DA=BMELEBD D ^DIE K DIE,DR,DA,DINUM D FALL^BMEMSTR S BMEFCNT=BMEFCNT+1
- Q
- ;
- ;
- LOG ;Populate Download Run Log with # of Fall Off's
- ;
- Q:BMELSTN=""
- Q:BMEFCNT<0
- S DIE="^BMEMLOG(",DA=BMELSTN,DR="2////"_BMEFCNT
- D ^DIE K DIE,DA,DR
- Q
- ;
- ;
- END ;End of Run
- K BMELSTN,BMELSTNM,BMELOGDT,BMEMAIEN,BMEMREC,BMESTILL,DFN,BMEFALL,BMELEBD,BMELEED,BMEFCNT
- Q
- BMEMFALL ; IHS/PHXAO/TMJ - Roster Fall Offs ;
- +1 ;;1.0T1;MEDICAID ELIGIBILITY DOWNLOAD;;JUN 25, 2003
- +2 ;
- +3 ;This routine $ORDER's through the RPMS Master File &
- +4 ;checks for all records who's Still Active Date is not
- +5 ;equal to the current month's Download Date. If these
- +6 ;patients also do not have a Fall Off Date Recorded
- +7 ;The MEDICAID ELIGIBILITY File will be populated/updated
- +8 ;with an ending date ONLY if one does not exist for the
- +9 ;last entry.
- +10 ;
- +11 ;
- START ;
- +1 SET BMEFCNT=0
- +2 ;Get Last Download Log IEN #
- DO GETLOG
- +3 DO MAST
- +4 DO LOG
- +5 DO END
- +6 QUIT
- +7 ;
- +8 ;
- +9 ;
- GETLOG ; -- this sets up the device and sets the file name
- +1 ;Last Log IEN # for Last File processed
- SET BMELSTN=""
- +2 ;Actual File Name in Log
- SET BMELSTNM=""
- +3 SET BMELSTN=$PIECE($GET(^BMEMLOG(0)),U,3)
- +4 IF BMELSTN=""
- WRITE !,"No Date Exists on Last Download Run",!
- GOTO END
- +5 ;Run Stop Date
- SET BMELOGDT=$PIECE($GET(^BMEMLOG(BMELSTN,0)),U,2)
- +6 ;Strip Time off Date
- SET BMELOGDT=$PIECE(BMELOGDT,".",1)
- +7 ;S BMELSTNM=$P($G(^BMEMLOG(BMELSTN,0)),U,8)
- +8 ;I BMELSTNM="" W !!,"Last File Name does NOT exist in Log. Contact Site Manager!" S BMEERROR=1 Q
- +9 ;START DT/TIME
- SET BMEMSTDT=$PIECE($GET(^BMEMLOG(BMELSTN,0)),U,1)
- +10 IF '$GET(BMEMSTDT)
- QUIT
- +11 ;Strip Time off Start Date
- SET BMEMSTDT=$PIECE(BMEMSTDT,".",1)
- +12 ;Quit if Start and Stop Date do not match
- IF BMEMSTDT'=BMELOGDT
- QUIT
- +13 ;
- +14 ;
- +15 QUIT
- +16 ;
- +17 ;
- +18 ;
- MAST ;Begin $O through RPMS Master File ^BMEMASTR(
- +1 SET BMEMAIEN=0
- FOR
- SET BMEMAIEN=$ORDER(^BMEMASTR(BMEMAIEN))
- IF 'BMEMAIEN
- QUIT
- Begin DoDot:1
- +2 SET BMEMREC=^BMEMASTR(BMEMAIEN,0)
- +3 ;Still Eligible Date
- SET BMESTILL=$PIECE(BMEMREC,U,4)
- +4 IF 'BMESTILL
- QUIT
- +5 ;Patient DFN #
- SET DFN=$PIECE(BMEMREC,U,1)
- +6 IF 'DFN
- QUIT
- +7 ; Fall Off Date
- SET BMEFALL=$PIECE(BMEMREC,U,5)
- +8 ;Quit if a Fall Date already exists
- IF BMEFALL'=""
- QUIT
- +9 ;Last Roster End Date
- SET BMELSTDT=$PIECE(BMEMREC,U,6)
- +10 ;If No Roster End Date - End with Todays Date
- SET BMELSTDT=$SELECT(BMELSTDT'="":BMELSTDT,1:DT)
- +11 IF BMESTILL'=BMELOGDT
- DO MED
- End DoDot:1
- +12 ;
- +13 ;
- MED ; -- add eligiblity date(s)/data
- +1 SET IEN=$ORDER(^AUPNMCD("B",DFN,0))
- IF 'IEN
- QUIT
- +2 ;Quit if Multiple Zero Node does not exist
- IF '$DATA(^AUPNMCD(IEN,11,0))
- QUIT
- +3 ;Last Beg Date IEN entered
- SET BMELEBD=$PIECE($GET(^AUPNMCD(IEN,11,0)),U,3)
- +4 IF BMELEBD'=""
- Begin DoDot:1
- +5 ;End Date
- SET BMELEED=$PIECE($GET(^AUPNMCD(IEN,11,BMELEBD,0)),U,2)
- +6 IF BMELEED=""
- SET DR=".02///"_BMELSTDT
- SET DIE="^AUPNMCD("_IEN_",11,"
- SET DA(1)=IEN
- SET DA=BMELEBD
- DO ^DIE
- KILL DIE,DR,DA,DINUM
- DO FALL^BMEMSTR
- SET BMEFCNT=BMEFCNT+1
- End DoDot:1
- +7 QUIT
- +8 ;
- +9 ;
- LOG ;Populate Download Run Log with # of Fall Off's
- +1 ;
- +2 IF BMELSTN=""
- QUIT
- +3 IF BMEFCNT<0
- QUIT
- +4 SET DIE="^BMEMLOG("
- SET DA=BMELSTN
- SET DR="2////"_BMEFCNT
- +5 DO ^DIE
- KILL DIE,DA,DR
- +6 QUIT
- +7 ;
- +8 ;
- END ;End of Run
- +1 KILL BMELSTN,BMELSTNM,BMELOGDT,BMEMAIEN,BMEMREC,BMESTILL,DFN,BMEFALL,BMELEBD,BMELEED,BMEFCNT
- +2 QUIT
