- ADEPME ; IHS/HQT/MJL - MEDICAID ELIGIBLES PT 1 ;08:33 PM [ 03/24/1999 9:04 AM ]
- ;;6.0;ADE;;APRIL 1999
- INIT ;
- ;------->GET DATE RANGE
- D DATE G:Y<0 END
- ;------->DEVICE
- ASKDEV ;FHL 9/9/98 S %ZIS="Q" D ^%ZIS G END:POP I $D(IO("Q")) K IO("Q") D QUE W:$D(ZTSK) !,"REQUEST QUEUED." G END
- S %ZIS="Q" D ^%ZIS G END:POP I $D(IO("Q")) K IO("Q") D QUE W:$D(ZTQUEUED) !,"REQUEST QUEUED." G END
- ZTM ;EP
- ;------->$O THRU ADEPCD("AC" (TASKMAN ENTRY)
- D PROC
- ;------->PRINT
- D ^ADEPME1
- I $D(ZTQUEUED) S ZTREQ="@"
- K ^ADEUTL("ADEPME",$J) ;^ADEUTL is a transient report global
- ;------->END
- END K ADEAGE,ADEBD,ADEBDT,ADEDAT,ADEDFN,ADEDOB,ADEED,ADEFAC,ADELIN,ADEMDFN,ADENAM,ADEND,ADENOD,ADENUM,ADEPAG,ADEPAT,ADEPRV,J
- Q
- QUE S ZTRTN="ZTM^ADEPME",ZTDESC="DENTAL MEDICAID ELIGIBLE REPORT"
- F J="ADEBD","ADEED" S ZTSAVE(J)=""
- D ^%ZTLOAD Q
- DATE S U="^",%DT="AE",%DT(0)=-DT,%DT("A")="SELECT BEGINNING DATE: " D ^%DT K %DT
- Q:Y<0
- S ADEBD=Y,%DT="AE",%DT(0)=ADEBD,%DT("A")="SELECT ENDING DATE: " D ^%DT K %DT
- G:X="^" DATE Q:Y<0 S ADEED=Y I ADEED>DT W " ??",*7 G DATE
- Q
- PROC S ADEBD=ADEBD-1
- K ^ADEUTL("ADEPME",$J)
- I '$D(IO("S")),$P(IOST,"-")="C" W !,"Please wait while I scan the records..."
- F J=0:0 S ADEBD=$O(^ADEPCD("AC",ADEBD)) Q:'ADEBD!(ADEBD>ADEED) S ADEDAT=$E(ADEBD,4,5)_"-"_$E(ADEBD,6,7)_"-"_$E(ADEBD,2,3) D P1
- Q
- P1 S ADEDFN=0 F J=0:0 S ADEDFN=$O(^ADEPCD("AC",ADEBD,ADEDFN)) Q:'ADEDFN D P3
- Q
- P3 Q:'$D(^ADEPCD(ADEDFN,0))
- S ADENOD=^ADEPCD(ADEDFN,0)
- Q:$P(ADENOD,U,9)'="d"
- S ADEPAT=$P(ADENOD,U)
- S ADEPRV=$P(ADENOD,U,4)
- Q:'ADEPRV Q:'$D(^DIC(16,ADEPRV,0))
- S ADEPRV=$P(^DIC(16,ADEPRV,0),U)
- Q:'$D(^AUPNMCD("B",ADEPAT))
- S ADEMDFN=$O(^AUPNMCD("B",ADEPAT,0))
- Q:'ADEMDFN Q:'$D(^AUPNMCD(ADEMDFN,0))
- S ADENUM=$P(^AUPNMCD(ADEMDFN,0),U,3) S:ADENUM']"" ADENUM="<Missing>"
- Q:'$D(^DPT(ADEPAT,0))
- S ADENOD=^DPT(ADEPAT,0),ADENAM=$P(ADENOD,U),ADEDOB=$P(ADENOD,U,3)
- Q:'ADEDOB
- S X1=DT,X2=ADEDOB D ^%DTC Q:X<1
- ;beginning Y2K fix
- ;S ADEAGE=X\364.25
- S ADEAGE=X\365.25 ;Y2000
- ;end Y2K fix block
- S ADEAGE=$S(ADEAGE<19:"0-18 YRS",(ADEAGE>18)&(ADEAGE<22):"19-21 YRS",ADEAGE>21:"22+ YRS",1:"") Q:ADEAGE=""
- ;***FUTURE VERSION: CALL LOCAL ELIGIBLE SERVICES TABLE HERE
- S ^ADEUTL("ADEPME",$J,ADEAGE,ADENAM,ADEDFN)=ADEDAT_U_ADENUM_U_ADEPRV
- Q
- ADEPME ; IHS/HQT/MJL - MEDICAID ELIGIBLES PT 1 ;08:33 PM [ 03/24/1999 9:04 AM ]
- +1 ;;6.0;ADE;;APRIL 1999
- INIT ;
- +1 ;------->GET DATE RANGE
- +2 DO DATE
- IF Y<0
- GOTO END
- +3 ;------->DEVICE
- ASKDEV ;FHL 9/9/98 S %ZIS="Q" D ^%ZIS G END:POP I $D(IO("Q")) K IO("Q") D QUE W:$D(ZTSK) !,"REQUEST QUEUED." G END
- +1 SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- GOTO END
- IF $DATA(IO("Q"))
- KILL IO("Q")
- DO QUE
- IF $DATA(ZTQUEUED)
- WRITE !,"REQUEST QUEUED."
- GOTO END
- ZTM ;EP
- +1 ;------->$O THRU ADEPCD("AC" (TASKMAN ENTRY)
- +2 DO PROC
- +3 ;------->PRINT
- +4 DO ^ADEPME1
- +5 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +6 ;^ADEUTL is a transient report global
- KILL ^ADEUTL("ADEPME",$JOB)
- +7 ;------->END
- END KILL ADEAGE,ADEBD,ADEBDT,ADEDAT,ADEDFN,ADEDOB,ADEED,ADEFAC,ADELIN,ADEMDFN,ADENAM,ADEND,ADENOD,ADENUM,ADEPAG,ADEPAT,ADEPRV,J
- +1 QUIT
- QUE SET ZTRTN="ZTM^ADEPME"
- SET ZTDESC="DENTAL MEDICAID ELIGIBLE REPORT"
- +1 FOR J="ADEBD","ADEED"
- SET ZTSAVE(J)=""
- +2 DO ^%ZTLOAD
- QUIT
- DATE SET U="^"
- SET %DT="AE"
- SET %DT(0)=-DT
- SET %DT("A")="SELECT BEGINNING DATE: "
- DO ^%DT
- KILL %DT
- +1 IF Y<0
- QUIT
- +2 SET ADEBD=Y
- SET %DT="AE"
- SET %DT(0)=ADEBD
- SET %DT("A")="SELECT ENDING DATE: "
- DO ^%DT
- KILL %DT
- +3 IF X="^"
- GOTO DATE
- IF Y<0
- QUIT
- SET ADEED=Y
- IF ADEED>DT
- WRITE " ??",*7
- GOTO DATE
- +4 QUIT
- PROC SET ADEBD=ADEBD-1
- +1 KILL ^ADEUTL("ADEPME",$JOB)
- +2 IF '$DATA(IO("S"))
- IF $PIECE(IOST,"-")="C"
- WRITE !,"Please wait while I scan the records..."
- +3 FOR J=0:0
- SET ADEBD=$ORDER(^ADEPCD("AC",ADEBD))
- IF 'ADEBD!(ADEBD>ADEED)
- QUIT
- SET ADEDAT=$EXTRACT(ADEBD,4,5)_"-"_$EXTRACT(ADEBD,6,7)_"-"_$EXTRACT(ADEBD,2,3)
- DO P1
- +4 QUIT
- P1 SET ADEDFN=0
- FOR J=0:0
- SET ADEDFN=$ORDER(^ADEPCD("AC",ADEBD,ADEDFN))
- IF 'ADEDFN
- QUIT
- DO P3
- +1 QUIT
- P3 IF '$DATA(^ADEPCD(ADEDFN,0))
- QUIT
- +1 SET ADENOD=^ADEPCD(ADEDFN,0)
- +2 IF $PIECE(ADENOD,U,9)'="d"
- QUIT
- +3 SET ADEPAT=$PIECE(ADENOD,U)
- +4 SET ADEPRV=$PIECE(ADENOD,U,4)
- +5 IF 'ADEPRV
- QUIT
- IF '$DATA(^DIC(16,ADEPRV,0))
- QUIT
- +6 SET ADEPRV=$PIECE(^DIC(16,ADEPRV,0),U)
- +7 IF '$DATA(^AUPNMCD("B",ADEPAT))
- QUIT
- +8 SET ADEMDFN=$ORDER(^AUPNMCD("B",ADEPAT,0))
- +9 IF 'ADEMDFN
- QUIT
- IF '$DATA(^AUPNMCD(ADEMDFN,0))
- QUIT
- +10 SET ADENUM=$PIECE(^AUPNMCD(ADEMDFN,0),U,3)
- IF ADENUM']""
- SET ADENUM="<Missing>"
- +11 IF '$DATA(^DPT(ADEPAT,0))
- QUIT
- +12 SET ADENOD=^DPT(ADEPAT,0)
- SET ADENAM=$PIECE(ADENOD,U)
- SET ADEDOB=$PIECE(ADENOD,U,3)
- +13 IF 'ADEDOB
- QUIT
- +14 SET X1=DT
- SET X2=ADEDOB
- DO ^%DTC
- IF X<1
- QUIT
- +15 ;beginning Y2K fix
- +16 ;S ADEAGE=X\364.25
- +17 ;Y2000
- SET ADEAGE=X\365.25
- +18 ;end Y2K fix block
- +19 SET ADEAGE=$SELECT(ADEAGE<19:"0-18 YRS",(ADEAGE>18)&(ADEAGE<22):"19-21 YRS",ADEAGE>21:"22+ YRS",1:"")
- IF ADEAGE=""
- QUIT
- +20 ;***FUTURE VERSION: CALL LOCAL ELIGIBLE SERVICES TABLE HERE
- +21 SET ^ADEUTL("ADEPME",$JOB,ADEAGE,ADENAM,ADEDFN)=ADEDAT_U_ADENUM_U_ADEPRV
- +22 QUIT
