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

AGMCDPCM.m

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