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