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

BGP3XTEL.m

Go to the documentation of this file. 
  1. BGP3XTEL ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 CRS REPORT ;
  1.  ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
  1.  ;
  1.  ;
  1.  D HOME^%ZIS
  1.  W:$D(IOF) @IOF
  1.  W !!,"Checking for Taxonomies to support the 2013 Elder Care Report. ",!,"Please enter the device for printing.",!
  1. ZIS ;
  1.  S XBRC="",XBRP="TAXCHK^BGP3XTEL",XBNS="",XBRX="XIT^BGP3XTEL"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. TAXCHK ;EP
  1.  ;D HOME^%ZIS
  1.  K BGPQUIT
  1. GUICHK ;EP
  1.  W !,"Checking for Taxonomies to support the Elder Care CRS Report...",!
  1.  NEW A,BGPX,I,Y,Z,J,BGPY,BGPT
  1.  K A
  1.  ;S T="TAXS" F J=1:1 S Z=$T(@T+J),BGPX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BGPX=""  D
  1.  S BGPT="" F  S BGPT=$O(^BGPTAXH("B",BGPT)) Q:BGPT=""  D
  1.  .S BGPY=$O(^BGPTAXH("B",BGPT,0))
  1.  .Q:'$D(^BGPTAXH(BGPY,12,"B",4))
  1.  .;I $P(^BGPTAXH(BGPY,0),U,2)'="L" S BGPX=$O(^ATXAX("B",BGPT,0))
  1.  .;I $P(^BGPTAXH(BGPY,0),U,2)="L" S BGPX=$O(^ATXLAB("B",BGPT,0))
  1.  .S BGPTYPE=$P(^BGPTAXH(BGPY,0),U,2),Y=$G(^BGPTAXH(BGPY,11,1,0))
  1.  .I BGPTYPE'="L" D
  1.  ..I '$D(^ATXAX("B",BGPT)) S A(BGPT)=Y_"^is Missing" Q
  1.  ..S I=$O(^ATXAX("B",BGPT,0))
  1.  ..I '$D(^ATXAX(I,21,"B")) S A(BGPT)=Y_"^has no entries "
  1.  .I BGPTYPE="L" D
  1.  ..I '$D(^ATXLAB("B",BGPT)) S A(BGPT)=Y_"^is Missing " Q
  1.  ..S I=$O(^ATXLAB("B",BGPT,0))
  1.  ..I '$D(^ATXLAB(I,21,"B")) S A(BGPT)=Y_"^has no entries "
  1.  I '$D(A) W !,"All taxonomies are present.",! K A,BGPX,Y,I,Z D DONE Q
  1.  W !!,"In order for the Elder Care CRS Report to find all necessary data, several",!,"taxonomies must be established.  The following taxonomies are missing or have",!,"no entries:"
  1.  S BGPX="" F  S BGPX=$O(A(BGPX)) Q:BGPX=""!($D(BGPQUIT))  D
  1.  .I $Y>(IOSL-2) D PAGE Q:$D(BGPQUIT)
  1.  .W !,$P(A(BGPX),U)," [",BGPX,"] ",$P(A(BGPX),U,2)
  1.  .Q
  1. DONE ;
  1.  K BGPQUIT
  1.  Q:$D(ZTQUEUED)
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of taxonomy check.  PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. XIT ;EP
  1.  K BGP,BGPX,BGPQUIT,BGPLINE,BGPJ,BGPX,BGPTEXT,BGP
  1.  K X,Y,J
  1.  Q
  1. PAGE ;
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT="" Q
  1.  Q
  1. TAXS ;
  1.  ;;BGP DEPRESSIVE DISORDERS;;Depressive Disorders ICD9 Diagnosis Taxonomy
  1.  ;;BGP PRIMARY CARE CLINICS
  1.  ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes
  1.  ;;BGP HGBA1C LOINC CODES
  1.  ;;BGP LIPID PROFILE LOINC CODES
  1.  ;;BGP LDL LOINC CODES
  1.  ;;BGP TRIGLYCERIDE LOINC CODES
  1.  ;;BGP HDL LOINC CODES
  1.  ;;BGP URINE PROTEIN LOINC CODES
  1.  ;;BGP MICROALBUM LOINC CODES
  1.  ;;BGP CPT FLU;;Flu CPTs Taxonomy
  1.  ;;BGP UNI MASTECTOMY PROCEDURES
  1.  ;;BGP CPT MAMMOGRAM
  1.  ;;BGP COLORECTAL CANCER DXS
  1.  ;;BGP FOBT LOINC CODES
  1.  ;;BGP RECTAL PROCEDURE CODES
  1.  ;;BGP SIG CPTS
  1.  ;;BGP BE CPTS
  1.  ;;BGP COLO CPTS
  1.  ;;BGP DV DXS
  1.  ;;BGP GPRA SMOKING DXS
  1.  ;;BGP ASTHMA DXS
  1.  ;;BGP TOTAL CHOLESTEROL LOINC
  1.  ;;BGP FRACTURE DXS
  1.  ;;BGP FRACTURE CPTS
  1.  ;;BGP FRACTURE PROCEDURES
  1.  ;;BGP HEDIS OSTEOPOROSIS DRUGS
  1.  ;;
  1. LAB ;
  1.  ;;DM AUDIT CREATININE TAX;;CREATININE test lab taxonomy
  1.  ;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Taxonomy
  1.  ;;DM AUDIT LIPID PROFILE TAX;;Lipid Profile Lab Taxonomy
  1.  ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
  1.  ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy
  1.  ;;DM AUDIT HDL TAX;;HDL Lab Taxonomy
  1.  ;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Taxonomy
  1.  ;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Taxonomy
  1.  ;;BGP GPRA ESTIMATED GFR TAX;;Estimated GFR Taxonomy
  1.  ;;BGP GPRA FOB TESTS;;Fecal Occult Blood Tests taxonomy
  1.  ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Taxonomy
  1.  ;;