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

CIMGAGP.m

Go to the documentation of this file. 
  1. CIMGAGP ; CMI/TUCSON/LAB - aberdeen area GPRA ;   [ 03/16/00  1:55 PM ]
  1.  ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !!,$$CTR("Aberdeen Area GPRA Report",80)
  1. INTRO ;
  1.  D EXIT
  1.  ;check for community taxonomy
  1.  I $G(DUZ(2)) S CIMAREA=$P($G(^AUTTAREA(+$P($G(^AUTTLOC(DUZ(2),0)),U,4),0)),U)
  1.  D SU^CIMGAGP0
  1.  I $D(CIMQUIT) W !!,"Cannot find community taxonomy" H 4 Q
  1.  I $O(CIMTAX(""))="" D GETTAX I $O(CIMTAX(""))="" D EXIT Q
  1.  S CIMASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
  1.  S CIMSUC=$E(CIMASUF,1,4)
  1. DATES ;
  1.  K CIMBD,CIMED,CIMPER
  1.  S CIMQTR=0
  1.  D Y
  1.  I $D(CIMQUIT) D EXIT Q
  1.  S CIMQY=""
  1.  S DIR(0)="S^Q:One Quarter in FY "_$$FMTE^XLFDT(CIMPER)_";F:Full Fiscal Year",DIR("A")="Run the report for a",DIR("B")="Q" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D EXIT Q
  1.  S CIMQY=Y
  1.  I CIMQY="Q" D Q I $D(CIMQUIT) G DATES
  1. HOME ;
  1.  K DIC S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Please enter your HOME Location: " D ^DIC
  1.  I Y=-1 W !,"No HOME Location entered!!!  PHN Visits counts to Home will be calculated",!,"using clinic 11 only!!" H 2 S CIMHOME="" G LISTS
  1.  S CIMHOME=+Y
  1. LISTS ;any lists with indicators?
  1.  W !!
  1.  S CIMLIST="" K CIMLIST
  1.  S T="INDSL" F J=1:1 S X=$T(@T+J),X=$P(X,";;",2) Q:X="END"  W !,J,")",?5,X
  1.  S DIR(0)="Y",DIR("A")="Should lists be generated for any of the above",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT)!(Y="") G DATES
  1.  I Y=0 G ZIS
  1.  K CIMLIST
  1.  S DIR(0)="L^1:16",DIR("A")="Which Ones" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G LISTS
  1.  F X=1:1 S Z=$P(Y,",",X) Q:Z=""  S CIMLIST(Z)=""
  1. ZIS ;call to XBDBQUE
  1.  ;CREATE REPORT ENTRY IN FILEMAN FILE
  1.  K DIC S X=CIMBD,DIC(0)="L",DIC="^CIMAGP(",DLAYGO=19255.01,DIADD=1,DIC("DR")=".02////"_CIMED_";.03////"_CIMPER_";.04///"_CIMQTR_";.05////"_CIMASUF_";.06////"_CIMSUC
  1.  D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S CIMQUIT=1 D EXIT Q
  1.  S CIMRPT=+Y
  1.  ;add communities to 28 multiple
  1.  K ^CIMAGP(CIMRPT,28)
  1.  S C=0,X="" F  S X=$O(CIMTAX(X)) Q:X=""  S C=C+1 S ^CIMAGP(CIMRPT,28,C,0)=X,^CIMAGP(CIMRPT,28,"B",X,C)=""
  1.  S ^CIMAGP(CIMRPT,28,0)="^19255.28A^"_C_"^"_C
  1.  D ^XBFMK
  1.  K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
  1.  W !!,"A file will be created called G",$P(^AUTTLOC(DUZ(2),0),U,10)_"."_CIMRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!!
  1.  S XBRP="PRINT^CIMGAGPP",XBRC="PROC^CIMGAGP1",XBRX="EXIT1^CIMGAGP",XBNS="CIM"
  1.  D ^XBDBQUE
  1.  D EXIT
  1.  Q
  1.  ;
  1. EXIT1 ;
  1.  D ^%ZISC
  1.  K IOPAR
  1.  D EN^XBNEW("GS^CIMGAGP","CIMRPT")
  1. EXIT ;
  1.  D EN^XBVK("CIM")
  1.  K X,X1,X2,X3,X4,X5,X6
  1.  K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
  1.  K N,N1,N2,N3,N4,N5,N6
  1.  D KILL^AUPNPAT
  1.  D ^XBFMK
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. SET6 ;
  1.  I $G(^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",3)=X3
  1.  S $P(^CIMGDATA(C),"|",4)=X4,$P(^CIMGDATA(C),"|",5)=X5,$P(^CIMGDATA(C),"|",6)=X6,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6)
  1.  Q
  1. GS ;EP called from xbnew
  1.  K ^CIMGDATA S X="",C=0 F  S X=$O(^CIMAGP(CIMRPT,X)) Q:X'=+X  D
  1.  .I $G(^CIMAGP(CIMRPT,X))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X)
  1.  .S X2="" F  S X2=$O(^CIMAGP(CIMRPT,X,X2)) Q:X2'=+X2  D
  1.  ..I $G(^CIMAGP(CIMRPT,X,X2))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2)
  1.  ..S X3="" F  S X3=$O(^CIMAGP(CIMRPT,X,X2,X3)) Q:X3'=+X3  D
  1.  ...I $G(^CIMAGP(CIMRPT,X,X2,X3))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",3)=X3,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3)
  1.  ...S X4="" F  S X4=$O(^CIMAGP(CIMRPT,X,X2,X3,X4)) Q:X4'=+X4  D
  1.  ....I $G(^CIMAGP(CIMRPT,X,X2,X3,X4))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",3)=X3,$P(^CIMGDATA(C),"|",4)=X4,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4)
  1.  ....S X5="" F  S X5=$O(^CIMAGP(CIMRPT,X,X2,X3,X4,X5)) Q:X5'=+X5  D
  1.  .....I $G(^CIMAGP(CIMRPT,X,X2,X3,X4,X5))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",3)=X3
  1.  .....S $P(^CIMGDATA(C),"|",4)=X4,$P(^CIMGDATA(C),"|",5)=X5,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4,X5)
  1.  .....S X6="" F  S X6=$O(^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6)) Q:X6'=+X6  D SET6
  1.  S XBGL="CIMGDATA"
  1.  S F="G"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_CIMRPT
  1.  S XBMED="F",XBFN=F,XBTLE="SAVE OF GPRA DATA BY - "_$P(^VA(200,DUZ,0),U),XBF=0,XBFLT=1
  1.  D ^XBGSAVE
  1.  K ^TMP($J),^CIMGDATA
  1.  Q
  1. GETTAX ;
  1.  K CIMTAX
  1.  S CIMTAX=""
  1.  D ^XBFMK
  1.  S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: " D ^DIC
  1.  I Y=-1 Q
  1.  S CIMX=+Y
  1.  D SU1^CIMGAGP0
  1.  Q
  1. Q ;which quarter
  1.  S DIR(0)="N^1:4:0",DIR("A")="Which Quarter" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT)!(Y="") S CIMQUIT="" Q
  1.  S CIMQTR=Y
  1.  I Y=1 S CIMBD=($E(CIMPER,1,3)-1)_"1001",CIMED=($E(CIMPER,1,3)-1)_"1231" Q
  1.  I Y=2 S CIMBD=$E(CIMPER,1,3)_"0101",CIMED=$E(CIMPER,1,3)_"0331" Q
  1.  I Y=3 S CIMBD=$E(CIMPER,1,3)_"0401",CIMED=$E(CIMPER,1,3)_"0630" Q
  1.  I Y=4 S CIMBD=$E(CIMPER,1,3)_"0701",CIMED=$E(CIMPER,1,3)_"0930" Q
  1.  Q
  1. Y ;fiscal year
  1.  W !
  1.  S CIMVDT=""
  1.  W !,"Enter the FY of interest.  Use a 4 digit year, e.g. 1999, 2000"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter Fiscal year (e.g. 1999)"
  1.  S DIR("?")="This report is compiled for a period.  Enter a valid date."
  1.  D ^DIR
  1.  K DIC
  1.  If $D(DUOUT) S DIRUT=1 S CIMQUIT="" Q
  1.  S CIMVDT=Y
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G Y
  1.  S CIMPER=CIMVDT,CIMBD=($E(CIMVDT,1,3)-1)_"1001",CIMED=$E(CIMVDT,1,3)_"0930"
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1.  ;
  1. INDSL ;;
  1.  ;;1/1 Diabetes Prevalance - List of Patients with a Diabetes Diagnosis
  1.  ;;1/1 Diabetes Incidence - List Patients Newly Diagnoses with Diabetes
  1.  ;;2/2 Diabetes - List Diabetics and their Glycemic Control
  1.  ;;3/3 Diabetes - List Diabetics/Hypertensives and their BP
  1.  ;;4/4 Diabetes - List Diabetics and whether they had a an LDL
  1.  ;;5/5 Diabetes - List Diabetics and whether they had a Urine Protein
  1.  ;;6/6 Women's Health - List Women over 17 and whether they had a Pap
  1.  ;;7/7 Women's Health - List women 49-64 and whether they had a Mammogram
  1.  ;;8/8 Child Health - List Patients w/ 4 Well Child Visits by 27 months of age
  1.  ;;11/12 Dental Health - List Patients with Access to Dental Services
  1.  ;;12/13 Dental Health - List Patients who Received Dental Sealants
  1.  ;;18/20 Child Health Immunization - List 2 y/o Pts w/ Immunization Status
  1.  ;;20/23 Child Health - List Obese Children
  1.  ;;21/2000 Adult Immunizations - List Patients >65 with Pneumovax Status
  1.  ;;21/2000 Adult Immunizations - List Pts >65 with Flu Shot Status in Past yr
  1.  ;;24/2000 Smoking Prevalance - List Current Tobacco Users
  1.  ;;END