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

APCLP12.m

Go to the documentation of this file. 
  1. APCLP12 ; IHS/CMI/LAB - Routine to create bulletin ; [ 09/16/02 7:37 AM ]
  1.  ;;3.0;IHS PCC REPORTS;**10**;FEB 15, 1997
  1.  ;;
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  Q
  1.  ;
  1. POST ;EP
  1.  ;*** REMEMBER TO SEND APCLVSTS GLOBAL AS GLOBAL OR AS KIDS
  1. OPT ;add 2 new options (supplement, report)
  1.  NEW X
  1.  S X=$$ADD^XPDMENU("APCL M MAN RESOURCE ALLOCATION","APCL P PROVIDER PRACTICE DESC","PPDS")
  1.  I 'X W "Attempt to new provider practice description report failed.." H 3
  1.  S X=$$ADD^XPDMENU("APCL M MAN ALL REPORTS","APCL CALIFORNIA STATE REPORT","CSAR")
  1.  I 'X W "Attempt to new california state report report failed.." H 3
  1.  D POST^APCLCART
  1.  D DMADA
  1.  ;;Here's how to make this work:
  1.  ;;
  1.  ;;1. Create your message in subroutine WRITEMSG
  1.  ;;2. Identify recipients in GETRECIP by setting APCLKEY
  1.  ;;3. Make changes in SUBJECT and SENDER as desired
  1.  ;;4. Rename this routine in appropriate namespace and 
  1.  ;;   call on completion of patch or upgrade
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR ZERO.",! Q
  1.  D HOME^%ZIS,DT^DICRW
  1.  ;
  1.  NEW XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
  1.  KILL ^TMP($J,"APCLBUL")
  1.  D WRITEMSG,GETRECIP
  1.  ;Change following lines as desired
  1. SUBJECT S XMSUB="* * * IMPORTANT RPMS INFORMATION * * *"
  1. SENDER S XMDUZ="Cimarron Medical Informatics"
  1.  S XMTEXT="^TMP($J,""APCLBUL"",",XMY(1)="",XMY(DUZ)=""
  1.  I $E(IOST)="C" W !,"Sending Mailman message to holders of the"_" "_APCLKEY_" "_"security key."
  1.  D ^XMD
  1.  KILL ^TMP($J,"APCLBUL"),APCLKEY
  1.  Q
  1.  ;
  1. WRITEMSG ;
  1.  F %=3:1 S X=$P($T(WRITEMSG+%),";",3) Q:X="###"  S ^TMP($J,"APCLBUL",%)=X
  1.  Q
  1.  ;;  
  1.  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1.  ;;+     This message is intended to advise you of changes,        +
  1.  ;;+     upgrades or other important RPMS information
  1.  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1.  ;;  
  1.  ;;PCC Management Reports Patch 12 has recently been installed.  This patch
  1.  ;;includes the following modifications/enhancements:
  1.  ;;   
  1.  ;;This patch contains the following:
  1.  ;;
  1.  ;;- NEW REPORTS:
  1.  ;;  Under Resource Allocation Reports:
  1.  ;;  * PPDS   Provider Practice Description Report
  1.  ;;    This report provides a description of patients served and visits
  1.  ;;    by a particular provider
  1.  ;;  Under PCC Ambulatory Visit Counts
  1.  ;; * CSAR   California State Annual Utilization Report
  1.  ;;    This report was requested by the California Area to satisfy a State
  1.  ;;    report requirement.  The data includes a tally of visits by CPT and 
  1.  ;;    diagnoses which other sites may find useful.
  1.  ;;  
  1.  ;; - New VGEN/PGEN items:
  1.  ;; * Veteran Status Y/N
  1.  ;; * PCC Plus Form?
  1.  ;; * Primary Provider IEN
  1.  ;; * Prim/Sec Prov IEN
  1.  ;; * Visit IEN
  1.  ;; * HRN Record Status
  1.  ;; * HRN Disposition
  1.  ;; * 3rd Party Billed Status
  1.  ;; 
  1.  ;; Report Modifications:
  1.  ;;1. 1A Report:  modified the logic to match the logic used by NPIRS in their
  1.  ;; 1A report, modified the display to be in discipline code order.
  1.  ;;2. List APC-1A Visits Not Exported:  modified definition of workload
  1.  ;; (APC  visit) per new logic.
  1.  ;;3. APC Visit Counts by Provider Discipline, APC Visit Counts by Clinic,
  1.  ;;    APC Visit Counts by Individual Provider, APC Visit Counts by Date
  1.  ;;    Of Visit, APC Visit Counts by Primary Diagnosis (APC CODE), 
  1.  ;;    APC Visit Counts by Location of Service, APC Visit Counts by 
  1.  ;;    APC Major Diagnosis Category:  Modified definition of workload (APC
  1.  ;;Visit) per new logic.
  1.  ;;4. Average Number of APC Visits per Day: Modified definition of
  1.  ;;    workload (APC Visit) per new logic.
  1.  ;;5. Average Number of Visits by Day of  Week and Clinic:  Modified
  1.  ;;    definition of workload (APC Visit) per new logic.
  1.  ;;6. PCC Data Analysis Report: Modified definition of workload
  1.  ;;    (APC Visit) per new logic.
  1.  ;;7. Patients w/no Diagnosis of DM on Problem List:  Added a check
  1.  ;;for inactive or missing chart.
  1.  ;;8. DM Register Pts w/no recorded DM Date of Onset:  Added a check
  1.  ;;for inactive or missing chart.
  1.  ;;9. Operations Summary:  fixed an UNDEF error.
  1.  ;;10. Registered Patients and Visit Count reports under Resource Allocation:
  1.  ;;Modified definition of workload (APC visit) per new logic.
  1.  ;;11. Taxonomy Setup:  Made several fixes to this.  Added a check for 
  1.  ;;An ADA code taxonomy, fixed ADA code taxonomy display.
  1.  ;;12. Dis-continued rounding height to the nearest inch on BMI calculation.
  1.  ;;13. OOPT - Risk for Overweight Prevalance Report:  Added selection of a
  1.  ;;Case Management register as the set of patients to run the report for.
  1.  ;;14. Diabetes Audit:  Added Clinic code A2 as a clinic to trigger that a 
  1.  ;;Diabetic eye exam was done.
  1.  ;;Exam was done.
  1.  ;;15. Frequency of Diagnoses Report:  Added a selection of a patient search
  1.  ;;Template so that the report can be run for a selected set of patients.
  1.  ;;(e.g a template of all veterans created by QMAN).
  1.  ;;
  1.  ;;For additional information contact your RPMS site manager, Area Office RPMS
  1.  ;;support staff or any of the following Cimarron staff members:
  1.  ;;
  1.  ;;Dorothy Russell *  Gary Lawless    *  Bill Mason       *  Lori Butcher
  1.  ;;(520)-743-3275     (715)-358-3763     (520)-615-0689      (520)-577-2146
  1.  ;;  
  1.  ;;+++++++++++++++++++++ end of announcement +++++++++++++++++++++++
  1.  ;;###
  1.  ;
  1. GETRECIP ;
  1.  ;* * * Define key below to identify recipients * * *
  1.  ;
  1.  S CTR=0,APCLKEY="APCLZMENU"
  1.  F  S CTR=$O(^XUSEC(APCLKEY,CTR)) Q:'CTR  S Y=CTR S XMY(Y)=""
  1.  Q
  1. DMADA ;
  1.  S ATXFLG=1
  1.  W !,"Updating APCH ADA Codes Taxonomy..."
  1.  S APCLTX=0 S APCLTX=$O(^ATXAX("B","APCH DM ADA EXAMS",APCLTX))
  1.  I APCLTX G TX1
  1.  S X="APCH DM ADA EXAMS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I I Y=-1 W !!,"ERROR IN CREATING APCH DM ADA EXAMS TAXONOMY" Q
  1.  S APCLTX=+Y,$P(^ATXAX(APCLTX,0),U,2)="ADA CODES FOR DM EXAM",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=174,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.31,^ATXAX(APCLTX,21,0)="^9002226.02101A^0^0"
  1. TX1 S APCLTEXT="ADA" F APCLX=1:1:5 S X=$P($T(@APCLTEXT+APCLX),";;",2),DIC="^AUTTADA(",DIC(0)="M" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0 I $P(Y,U)>0 D
  1.  .S Y=+Y Q:$D(^ATXAX(APCLTX,21,"B",Y))  ;this code is already there.
  1.  .S (APCLY,APCLL)=0 F  S APCLY=$O(^ATXAX(APCLTX,21,APCLY)) Q:APCLY'=+APCLY  S APCLL=APCLY
  1.  .S APCLL=APCLL+1,^ATXAX(APCLTX,21,APCLL,0)=Y,$P(^ATXAX(APCLTX,21,APCLL,0),U,2)=Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLL,$P(^(0),U,4)=APCLL,^ATXAX(APCLTX,21,"AA",Y,Y)="",^ATXAX(APCLTX,21,"B",Y,APCLL)=""
  1.  .Q
  1.  S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
  1.  K APCLTX,APCLDA,APCLTEXT,ATXFLG
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. ADA ;
  1.  ;;0120
  1.  ;;0150
  1.  ;;0114
  1.  ;;9320
  1.  ;;9321
  1.  ;;