Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGMCDPN

AGMCDPN.m

Go to the documentation of this file.
AGMCDPN ; IHS/ASDS/EFG - PRINT LIST OF MEDICAID ACCOUNTS BY ACCOUNT #;
 ;;7.1;PATIENT REGISTRATION;**12**;AUG 25,2005;Build 1
 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE
 ;
 ;Modified so user can select one/many/all plans
 ;
 ;variables:
 ;   AGACCTS-who is on report (elig); contains O,C,T,A
 ;   AGPTS  -all patients or just active; 1 if all; 0 if not
 ;   AGFRMDT-from date for elig.
 ;   AGTODT -thru date for elig.
 ;   AGST   -state code for Medicaid number
 ;
 S AGIO=IO,AG("HAT")=""
 N AGST
 D NOW^%DTC
 S AGTODAY=X-1
ACCTS ;
 S DIR(0)="S^A:ALL ACCOUNTS (all patients);O:OPEN ACCOUNTS (anyone with coverage in date range);T:TERMED ACCOUNTS(people termed in range);C:CURRENT ACCOUNTS(anyone covered at this time)"
 S DIR("A")="Select desired accounts"
 D ^DIR K DIR
 S AGACCTS=Y
 Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")
 I "OT"[AGACCTS D FROM   ;do date range if OPEN or TERMED is selected
 Q:$G(AGFRMDT)["^"!($G(AGTODT)["^")
PLANS ;
 K AG("PLANS")
PLAN2 ;
 W !
 F  D  Q:+Y<0!(X["^")
 .S DIR(0)="FO"
 .I '$D(AG("PLANS")) D
 ..S DIR("A")="Enter PLAN NAME (type NONE for ones with no name)"
 ..S DIR("B")="ALL"
 .E  S DIR("A")="Enter another PLAN NAME"
 .D ^DIR K DIR
 .Q:+Y<0
 .Q:$D(DUOUT)!$D(DIROUT)!$D(DTOUT)
 .I Y="NONE" S AG("PLANS",Y)="" S Y=1 Q
 .I Y="ALL" K AG("PLANS") S Y=-1 Q
 .S DIC="^AUTNINS("
 .S X=Y
 .S DIC(0)="EMQ"
 .;S DIC("S")="I ""DK""[$P($G(^(2)),""^"",1)"
 .S DIC("S")="I ""DK""[$$INSTYP^AGUTL(Y)"  ;IHS/OIT/NKD AG*7.1*12
 .D ^DIC
 .Q:X["^"
 .S AG("PLANS",+Y)=$P(Y,"^",2)
 Q:$D(DUOUT)
PTS ;
 S DIR(0)="Y"
 S DIR("A",1)="Unless specified, ONLY ACTIVE PATIENTS will be included."
 S DIR("A")="Do you want to include inactive/deceased patients?"
 S DIR("B")="N"
 D ^DIR K DIR
 S AGPTS=Y
 Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")
DEV S %ZIS="OPQ" D ^%ZIS I POP S IOP=ION D ^%ZIS Q
 G:'$D(IO("Q")) START K IO("Q") I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
 X ^%ZOSF("UCI")
 S ZTRTN="START^AGMCDPN"
 S ZTUCI=Y,ZTIO=""
 S ZTDESC="MCAID Accounts by Account Number for "_$P(^AUTTLOC(DUZ(2),0),U,2)_"."
 S AGQIO=IO F G="AGQIO" S ZTSAVE(G)=""
 S ZTSAVE("AG*")=""
 D ^%ZTLOAD
 G:'$D(ZTSK) DEV K AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC
 Q
START ;EP - From TaskMan.
 S DFN=0
 S AGST=""
 S (AGIMID,AGMID)=""
 K ^TMP($J)
 F  S DFN=$O(^AUPNMCD("AB",DFN)) Q:+DFN<1  D
 .F  S AGST=$O(^AUPNMCD("AB",DFN,AGST))  Q:AGST=""  D
 ..F  S AGMID=$O(^AUPNMCD("AB",DFN,AGST,AGMID))  Q:AGMID=""  D
 ...F  S AGIMID=$O(^AUPNMCD("AB",DFN,AGST,AGMID,AGIMID))  Q:AGIMID=""  D
 ....S AGFLAG=0
 ....I AGPTS["0" D ACTIVE       ;if only active
 ....I AGPTS["1" D ALL       ;if everyone
 D WRITE
 I 'AGEND D END
 Q
WRITE D NOW^AG S X=AGTIME D CTR^AG S AGTIME=X
 I $D(AGQIO) F AGZ("I")=1:1 S IOP=AGQIO D ^%ZIS Q:'POP  H 30
 S AGBM=IOSL-10 I $D(AGIO),AGIO=IO S AGBM=IOSL-4
 S (AGTOT,AGPGPG)=0
 S AG("LOC")=$P(^DIC(4,DUZ(2),0),U)
 S AG("USR")=$P(^VA(200,DUZ,0),U)
 S AG("USRLOC")=AG("USR")_$J("",40-($L(AG("LOC"))\2)-$L(AG("USR")))
 S AG("USRLOC")=AG("USRLOC")_AG("LOC") X ^%ZOSF("UCI")
 S X="UCI: "_$P(Y,",",1) D CTR^AG S AGUCI=X,AGNM=""
 U IO D HDR
 S (AGST,AGNM,AGCTY,DFN,AGEND)=""
 F  S AGMID=$O(^TMP($J,AGMID)) Q:AGMID=""  D  Q:AGEND
 .F  S AGNM=$O(^TMP($J,AGMID,AGNM)) Q:AGNM=""  D  Q:AGEND
 ..F  S AGST=$O(^TMP($J,AGMID,AGNM,AGST)) Q:AGST=""  D  Q:AGEND
 ...F  S AGCTY=$O(^TMP($J,AGMID,AGNM,AGST,AGCTY))  Q:AGCTY=""  D  Q:AGEND
 ....F  S DFN=$O(^TMP($J,AGMID,AGNM,AGST,AGCTY,DFN)) Q:DFN=""  D  Q:AGEND
 .....W AGNM
 .....I AGACCTS="T" W ?30,$P($G(^DPT(DFN,.13)),U)
 .....W ?45 W:$D(^AUPNPAT(DFN,41,DUZ(2),0)) $P(^(0),U,2)
 .....W ?55,AGCTY
 .....W ?77,$P(^DIC(5,AGST,0),U,2)   ;STATE ABBREV.
 .....S AGELGBEG=""
 .....F  S AGELGBEG=$O(^TMP($J,AGMID,AGNM,AGST,AGCTY,DFN,AGELGBEG))  Q:AGELGBEG=""  D
 ......S AGREC=$G(^TMP($J,AGMID,AGNM,AGST,AGCTY,DFN,AGELGBEG))
 ......S (AGELGBG1,AGELGED1,AGPLAN,AGRATE,AGCOV)=""
 ......S AGELGBG1=$$DT(AGELGBEG)
 ......S AGELGED1=$$DT($P(AGREC,U))
 ......S AGPLAN=$P(AGREC,U,2)
 ......I $G(AGPLAN)'="" S AGPLAN=$E($P($G(^AUTNINS(AGPLAN,0)),U),1,22)
 ......S AGRATE=$P(AGREC,U,3)
 ......S AGCOV=$P(AGREC,U,4)
 ......W !,?3,AGPLAN,?26,AGELGBG1,?37,$E(AGMID,1,20),?50,AGELGED1,?61,AGRATE,?71,AGCOV
 ....W !
 ...S AGTOT=AGTOT+1
 ...F A=1:1:80 W "-"
 .W !      ;space between states,counties
 .I $Y>AGBM D
 ..D RTRN^AG
 ..I $D(DUOUT)!$D(DTOUT)!$D(DFOUT) S AGEND=1 G END
 ..D HDR
 Q
END W !!!,"TOTAL MEDICAID PATIENTS: ",AGTOT K AG("HAT") D RTRN^AG W $$S^AGVDF("IOF")
 D ^%ZISC
 K AG("LKDATA"),AG("LKERR"),AG("LKPRINT"),AG("LOC"),AGNM,AGNUM,AGPCC
 K AGPGPG,AGPT,AGST,AGTOT,AGUCI,AG("USR"),AG("USRLOC"),X,Y
 D:$D(ZTQUEUED) KILL^%ZTLOAD
 Q
HDR ;
 I $D(AGFRMDT),$D(AGTODT) D
 .S AGFRMDT1=$$DT(AGFRMDT)
 .S AGTODT1=$$DT(AGTODT)
 S AGPGPG=AGPGPG+1 D
 .W $$S^AGVDF("IOF"),!!,AG("USRLOC"),?72,"page ",AGPGPG
 .I AGPTS["1" S AGPTS1="ACTIVE/INACTIVE/DECEASED"
 .E  S AGPTS1="ACTIVE"
 .W !?8,AGPTS1_" PATIENTS - MEDICAID ACCOUNTS BY ACCOUNT NUMBER"
 .I AGACCTS["A" S AGACCTS1="ALL ACCOUNTS"
 .I AGACCTS["C" S AGACCTS1="CURRENT ACCOUNTS"
 .I AGACCTS["O" S AGACCTS1="OPEN ACCOUNTS BETWEEN "_AGFRMDT1_" AND "_AGTODT1
 .I AGACCTS["T" S AGACCTS1="TERMED ACCOUNTS BETWEEN "_AGFRMDT1_" AND "_AGTODT1
 .W !?8,"FOR "_AGACCTS1
 .S (AGPLNNM,AGPLN,AGPLNS)=""
 .F  S AGPLNNM=$O(AG("PLANS",AGPLNNM)) Q:AGPLNNM=""  D
 ..S AGPLN=$G(AG("PLANS",AGPLNNM))
 ..I AGPLNNM="NONE" S AGPLN="WITH NO PLAN NAME"
 ..I AGPLNS="" S AGPLNS=AGPLN
 ..E  S AGPLNS=AGPLNS_" and "_AGPLN
 .W " FOR "_AGPLNS
 .I '$D(AG("PLANS")) W " FOR ALL PLANS"
 .W !,AGUCI
 .W !!,AGTIME,!!,?1,"PATIENT NAME"
 .I AGACCTS="T" W ?30,"HOME PHONE"
 .W ?45,"IHS #",?55,"COUNTY(RES)",?77,"ST."
 .W !,?3,"PLAN NAME",?26,"ELIG BEGIN",?37,"NUMBER",?50,"ELIG END",?61,"RATE CODE",?71,"COV.TYPE"
 .S AG("LINE")="=" D LINE^AG
 Q
FROM ;
 S DIR(0)="D"
 S DIR("A")="ENTER FROM DATE"
 D ^DIR K DIR
 S AGFRMDT=Y
 Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")
TO ;
 S DIR(0)="D"
 S DIR("A")="ENTER THRU DATE"
 D ^DIR K DIR
 S AGTODT=Y
 Q:$D(DTOUT)!(Y="^")!(Y="/.,")!(Y="^^")
 Q
ACTIVE ;if they have HRN, are active, and have info in VA PATIENT
 I $D(^AUPNPAT(DFN,41,DUZ(2))),$P(^(DUZ(2),0),U,3)="",$D(^DPT(DFN)),'$D(^DPT(DFN,.35)) D
 .I AGACCTS="O" D OPEN
 .I AGACCTS="C" D CURRENT
 .I AGACCTS="T" D TERM
 .I AGACCTS="A" D ALL
 Q
ALL ;
 S AGELGDT=0
 F  S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:AGELGDT=""  D
 .S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))
 .S AGELGBEG=$P(AGELG,U)
 .S AGELGEND=$P(AGELG,U,2)
 .S AGCOV=$P(AGELG,U,3)
 .S AGELG2=$G(^AUPNMCD(AGIMID,0))
 .S AGPLAN=$P(AGELG2,U,10)
 .S AGFLG=0
 .I $D(AG("PLANS")) D  Q:AGFLG
 ..I $G(AGPLAN)="",'$D(AG("PLANS","NONE")) S AGFLG=1 Q
 ..I $G(AGPLAN)'="",'$D(AG("PLANS",AGPLAN)) S AGFLG=1 Q
 .S AGRATE=$P(AGELG2,U,11)
 .D COUNTY
 .S ^TMP($J,AGMID,$P(^DPT(DFN,0),U),AGST,AGCTY,DFN,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
 Q
OPEN ;
 S AGELGDT=0
 F  S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:AGELGDT=""  D
 .S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))
 .S AGELGBEG=$P(AGELG,U)
 .S AGELGEND=$P(AGELG,U,2)
 .S AGCOV=$P(AGELG,U,3)
 .S AGELG2=$G(^AUPNMCD(AGIMID,0))
 .S AGPLAN=$P(AGELG2,U,10)
 .S AGFLG=0
 .I $D(AG("PLANS")) D  Q:AGFLG
 ..I $G(AGPLAN)="",'$D(AG("PLANS","NONE")) S AGFLG=1 Q
 ..I $G(AGPLAN)'="",'$D(AG("PLANS",AGPLAN)) S AGFLG=1 Q
 .S AGRATE=$P(AGELG2,U,11)
 .I +$G(AGELGEND)'=0 Q
 .I $D(AGELGBEG),AGELGBEG<AGTODT,AGELGBEG>AGFRMDT D
 ..D COUNTY
 ..S ^TMP($J,AGMID,$P(^DPT(DFN,0),U),AGST,AGCTY,DFN,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
 Q
CURRENT ;
 S AGELGDT=0
 F  S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:AGELGDT=""  D
 .S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))
 .S AGELGBEG=$P(AGELG,U)
 .S AGELGEND=$P(AGELG,U,2)
 .S AGCOV=$P(AGELG,U,3)
 .S AGELG2=$G(^AUPNMCD(AGIMID,0))
 .S AGPLAN=$P(AGELG2,U,10)
 .S AGFLG=0
 .I $D(AG("PLANS")) D  Q:AGFLG
 ..I $G(AGPLAN)="",'$D(AG("PLANS","NONE")) S AGFLG=1 Q
 ..I $G(AGPLAN)'="",'$D(AG("PLANS",AGPLAN)) S AGFLG=1 Q
 .S AGRATE=$P(AGELG2,U,11)
 .I AGELGEND>AGTODAY!(+$G(AGELGEND)=0) D
 ..D COUNTY
 ..S ^TMP($J,AGMID,$P(^DPT(DFN,0),U),AGST,AGCTY,DFN,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
 Q
TERM ;
 S AGELGDT=0
 F  S AGELGDT=$O(^AUPNMCD(AGIMID,11,AGELGDT)) Q:AGELGDT=""  D
 .S AGELG=$G(^AUPNMCD(AGIMID,11,AGELGDT,0))
 .S AGELGBEG=$P(AGELG,U)
 .S AGELGEND=$P(AGELG,U,2)
 .S AGCOV=$P(AGELG,U,3)
 .S AGELG2=$G(^AUPNMCD(AGIMID,0))
 .S AGPLAN=$P(AGELG2,U,10)
 .S AGFLG=0
 .I $D(AG("PLANS")) D  Q:AGFLG
 ..I $G(AGPLAN)="",'$D(AG("PLANS","NONE")) S AGFLG=1 Q
 ..I $G(AGPLAN)'="",'$D(AG("PLANS",AGPLAN)) S AGFLG=1 Q
 .S AGRATE=$P(AGELG2,U,11)
 .I +$G(AGELGEND)=0 Q
 .I AGELGEND<AGTODT,AGELGEND>AGFRMDT D
 ..D COUNTY
 ..S ^TMP($J,AGMID,$P(^DPT(DFN,0),U),AGST,AGCTY,DFN,AGELGBEG)=AGELGEND_U_AGPLAN_U_AGRATE_U_AGCOV
 Q
B1 I $Y>AGBM D RTRN^AG G END:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D HDR
 W !!
 Q
DT(DT) ;
 I DT="" Q ""
 S DT1=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"
 S DT1=DT1_$S($E(DT,1)=3:20,$E(DT,1)=2:19)_$E(DT,2,3)
 Q DT1
COUNTY ;
 S DA=DFN
 S DIC=9000001.51
 S DR=.03
 S AG("DRENT")=0
 S AGCTY=""
 D ^AGDICLK
 I '$D(AG("LKERR")),AG("LKDATA")]"",$D(^AUTTCOM(AG("LKDATA"),0)) D
 .S AGCTY=$P(^AUTTCOM(AG("LKDATA"),0),U,2) Q:AGCTY']""
 .I $D(^AUTTCTY(AGCTY,0)) S AGCTY=$P(^AUTTCTY(AGCTY,0),U)
 Q