- BMEMFALL ;Roster Fall Offs [ 06/11/03 3:29 PM ]
- ;
- ;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 FALLCT=0
- D AZAG ;Get Last Download Log IEN #
- D MAST
- D LOG
- D END
- Q
- ;
- ;
- ;
- AZAG ; -- this sets up the device and sets the file name
- S AZALSTN="" ;Last Log IEN # for Last File processed
- S AZALSTNM="" ;Actual File Name in Log
- S AZALSTN=$P($G(^AZAMEDLG(0)),U,3)
- I AZALSTN="" W !,"No Date Exists on Last Download Run",! G END
- S LOGDT=$P($G(^AZAMEDLG(AZALSTN,0)),U,2) ;Run Stop Date
- S LOGDT=$P(LOGDT,".",1) ;Strip Time off Date
- ;S AZALSTNM=$P($G(^AZAMEDLG(AZALSTN,0)),U,8)
- ;I AZALSTNM="" W !!,"Last File Name does NOT exist in Log. Contact Site Manager!" S AZAERROR=1 Q
- S AZAMSTDT=$P($G(^AZAMEDLG(AZALSTN,0)),U,1) ;START DT/TIME
- Q:'$G(AZAMSTDT)
- S AZAMSTDT=$P(AZAMSTDT,".",1) ;Strip Time off Start Date
- Q:AZAMSTDT'=LOGDT ;Quite if Start and Stop Date do not match
- ;
- ;
- Q
- ;
- ;
- ;
- MAST ;Begin $O through RPMS Master File ^AZAMASTR(
- S MASIEN=0 F S MASIEN=$O(^AZAMASTR(MASIEN)) Q:'MASIEN D
- . S RECORD=^AZAMASTR(MASIEN,0)
- . S STILLDT=$P(RECORD,U,4) ;Still Eligible Date
- . Q:'STILLDT
- . S DFN=$P(RECORD,U,1) ;Patient DFN #
- . Q:'DFN
- . S FALLDT=$P(RECORD,U,5) ; Fall Off Date
- . Q:FALLDT'="" ;Quit if a Fall Date already exists
- . S LSTENDT=$P(RECORD,U,6) ;Last Roster End Date
- . S LSTENDT=$S(LSTENDT'="":LSTENDT,1:DT) ;If No Roster End Date - End with Todays Date
- . I STILLDT'=LOGDT 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 LSTEBD=$P($G(^AUPNMCD(IEN,11,0)),U,3) ;Last Beg Date IEN entered
- I LSTEBD'="" D
- . S SENDDT=$P($G(^AUPNMCD(IEN,11,LSTEBD,0)),U,2) ;End Date
- . I SENDDT="" S DR=".02///"_LSTENDT S DIE="^AUPNMCD("_IEN_",11,",DA(1)=IEN,DA=LSTEBD D ^DIE K DIE,DR,DA,DINUM D FALL^AZAMSTR S FALLCT=FALLCT+1
- Q
- ;
- ;
- LOG ;Populate Download Run Log with # of Fall Off's
- ;
- Q:AZALSTN=""
- Q:FALLCT<0
- S DIE="^AZAMEDLG(",DA=AZALSTN,DR="2////"_FALLCT
- D ^DIE K DIE,DA,DR
- Q
- ;
- ;
- END ;End of Run
- K AZALSTN,AZALSTNM,LOGDT,MASIEN,RECORD,STILLDT,DFN,FALLDT,LSTEBD,SENDDT,FALLCT
- Q
- BMEMFALL ;Roster Fall Offs [ 06/11/03 3:29 PM ]
- +1 ;
- +2 ;This routine $ORDER's through the RPMS Master File &
- +3 ;checks for all records who's Still Active Date is not
- +4 ;equal to the current month's Download Date. If these
- +5 ;patients also do not have a Fall Off Date Recorded
- +6 ;The MEDICAID ELIGIBILITY File will be populated/updated
- +7 ;with an ending date ONLY if one does not exist for the
- +8 ;last entry.
- +9 ;
- +10 ;
- START ;
- +1 SET FALLCT=0
- +2 ;Get Last Download Log IEN #
- DO AZAG
- +3 DO MAST
- +4 DO LOG
- +5 DO END
- +6 QUIT
- +7 ;
- +8 ;
- +9 ;
- AZAG ; -- this sets up the device and sets the file name
- +1 ;Last Log IEN # for Last File processed
- SET AZALSTN=""
- +2 ;Actual File Name in Log
- SET AZALSTNM=""
- +3 SET AZALSTN=$PIECE($GET(^AZAMEDLG(0)),U,3)
- +4 IF AZALSTN=""
- WRITE !,"No Date Exists on Last Download Run",!
- GOTO END
- +5 ;Run Stop Date
- SET LOGDT=$PIECE($GET(^AZAMEDLG(AZALSTN,0)),U,2)
- +6 ;Strip Time off Date
- SET LOGDT=$PIECE(LOGDT,".",1)
- +7 ;S AZALSTNM=$P($G(^AZAMEDLG(AZALSTN,0)),U,8)
- +8 ;I AZALSTNM="" W !!,"Last File Name does NOT exist in Log. Contact Site Manager!" S AZAERROR=1 Q
- +9 ;START DT/TIME
- SET AZAMSTDT=$PIECE($GET(^AZAMEDLG(AZALSTN,0)),U,1)
- +10 IF '$GET(AZAMSTDT)
- QUIT
- +11 ;Strip Time off Start Date
- SET AZAMSTDT=$PIECE(AZAMSTDT,".",1)
- +12 ;Quite if Start and Stop Date do not match
- IF AZAMSTDT'=LOGDT
- QUIT
- +13 ;
- +14 ;
- +15 QUIT
- +16 ;
- +17 ;
- +18 ;
- MAST ;Begin $O through RPMS Master File ^AZAMASTR(
- +1 SET MASIEN=0
- FOR
- SET MASIEN=$ORDER(^AZAMASTR(MASIEN))
- IF 'MASIEN
- QUIT
- Begin DoDot:1
- +2 SET RECORD=^AZAMASTR(MASIEN,0)
- +3 ;Still Eligible Date
- SET STILLDT=$PIECE(RECORD,U,4)
- +4 IF 'STILLDT
- QUIT
- +5 ;Patient DFN #
- SET DFN=$PIECE(RECORD,U,1)
- +6 IF 'DFN
- QUIT
- +7 ; Fall Off Date
- SET FALLDT=$PIECE(RECORD,U,5)
- +8 ;Quit if a Fall Date already exists
- IF FALLDT'=""
- QUIT
- +9 ;Last Roster End Date
- SET LSTENDT=$PIECE(RECORD,U,6)
- +10 ;If No Roster End Date - End with Todays Date
- SET LSTENDT=$SELECT(LSTENDT'="":LSTENDT,1:DT)
- +11 IF STILLDT'=LOGDT
- 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 LSTEBD=$PIECE($GET(^AUPNMCD(IEN,11,0)),U,3)
- +4 IF LSTEBD'=""
- Begin DoDot:1
- +5 ;End Date
- SET SENDDT=$PIECE($GET(^AUPNMCD(IEN,11,LSTEBD,0)),U,2)
- +6 IF SENDDT=""
- SET DR=".02///"_LSTENDT
- SET DIE="^AUPNMCD("_IEN_",11,"
- SET DA(1)=IEN
- SET DA=LSTEBD
- DO ^DIE
- KILL DIE,DR,DA,DINUM
- DO FALL^AZAMSTR
- SET FALLCT=FALLCT+1
- End DoDot:1
- +7 QUIT
- +8 ;
- +9 ;
- LOG ;Populate Download Run Log with # of Fall Off's
- +1 ;
- +2 IF AZALSTN=""
- QUIT
- +3 IF FALLCT<0
- QUIT
- +4 SET DIE="^AZAMEDLG("
- SET DA=AZALSTN
- SET DR="2////"_FALLCT
- +5 DO ^DIE
- KILL DIE,DA,DR
- +6 QUIT
- +7 ;
- +8 ;
- END ;End of Run
- +1 KILL AZALSTN,AZALSTNM,LOGDT,MASIEN,RECORD,STILLDT,DFN,FALLDT,LSTEBD,SENDDT,FALLCT
- +2 QUIT
