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
