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
