source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGSYSTAT.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1RGSYSTAT ;BAY/ALS-MPI/PD STATUS DISPLAY ;01/05/01
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**16,19,23,25,20,43,45**;30 Apr 99;Build 9
3 ;Reference to ^DGCN(391.98,"AST" supported by IA #3303
4 ;Reference to ^DGCN(391.984 supported by IA #3304
5 ;Reference to ^MPIF(984.9 supported by IA #3298
6 ;Reference to OPTSTAT^XUTMOPT supported by IA #1472
7 ;Reference to ^DPT("ACMORS", ^DPT("AICN", and ^DPT("AICNL" supported by IA #2070
8 ;Reference to ^VAT(391.71 supported by IA #3422
9EN ;
10 ; Count exceptions on hand
11EXC ;
12 W @IOF,"Exception Handler Entries:",!,"--------------------------"
13 S CNT=0,EXCTYP="",NTYP="",TOTL=0,PCNT=0
14 N STAT,DFN,ICN
15 S HOME=$$SITE^VASITE()
16 F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D
17 . I (EXCTYP=234)!(EXCTYP=227)!((EXCTYP>214)&(EXCTYP<219)) D ;**45
18 .. I (EXCTYP'=NTYP)&(CNT>0) D
19 ... S ETEXT=$P($G(^RGHL7(991.11,NTYP,10)),"^",1)
20 ... W !,$E(ETEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
21 .. S IEN=0,NTYP=EXCTYP
22 .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D
23 ... S IEN2=0
24 ... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D
25 .... S STAT=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",5) I STAT<1 D
26 ..... S DFN=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",4) Q:'DFN
27 ..... S ^XTMP("RGEXC",0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"MPI/PD Status Display"
28 ..... S ^XTMP("RGEXC",DFN)=DFN
29 ..... S ICN=+$$GETICN^MPIF001(DFN)
30 ..... I $E(ICN,1,3)=$E($P(HOME,"^",3),1,3)!(ICN<0)!(EXCTYP=234)!((EXCTYP>214)&(EXCTYP<219)) D ;**43,45
31 ...... S CNT=CNT+1
32 I CNT>0 D
33 .S ETEXT=$P($G(^RGHL7(991.11,NTYP,10)),"^",1)
34 .W !,$E(ETEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT
35 I TOTL=0 W !,"There are no entries in the Exception Handler."
36 I TOTL>0 D
37 . W !!,"Total number of exceptions: ",?55,$J(TOTL,6)
38 . S PDFN=""
39 . F S PDFN=$O(^XTMP("RGEXC",PDFN)) Q:'PDFN D
40 .. S PCNT=PCNT+1
41 . W !,"Total unique patient exceptions: ",?55,$J(PCNT,6)
42 S STDT=$P($G(^RGSITE(991.8,1,"EXCPRG")),"^",1)
43 I $D(^RGSITE(991.8,1,"EXCPRG")) D
44 . S STDT=$$FMTE^XLFDT(STDT,1)
45 . W !!,"The MPI/PD Exception Purge process last ran "_STDT_"."
46 K CNT,EXCTYP,NTYP,ETEXT,TOTL,IEN,IEN2,HOME,PCNT,^XTMP("RGEXC"),PDFN,STDT
47 I $Y>21 D QUIT Q:X="^"
48PDR ;Count entries in Patient Data Review
49 W !!,"Patient Data Review Entries:",!,"----------------------------"
50 S CNT=0,PDRTYP="",NTYP="",TOTL=0
51 F S PDRTYP=$O(^DGCN(391.98,"AST",PDRTYP)) Q:'PDRTYP D
52 . I (PDRTYP'=NTYP)&(CNT>0) D
53 .. S DIC="^DGCN(391.984,",DR=".01",DA=NTYP,DIQ(0)="E",DIQ="RGPDR"
54 .. D EN^DIQ1 K DIC,DA,DR,DIQ
55 .. S PTEXT=$G(RGPDR(391.984,NTYP,.01,"E"))
56 .. W !,$E(PTEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
57 . I (PDRTYP=1)!(PDRTYP=2)!(PDRTYP=5) D
58 .. S IEN=0,NTYP=PDRTYP
59 .. F S IEN=$O(^DGCN(391.98,"AST",PDRTYP,IEN)) Q:'IEN D
60 ... S CNT=CNT+1
61 I CNT>0 D
62 . S DIC="^DGCN(391.984,",DR=".01",DA=NTYP,DIQ(0)="E",DIQ="RGPDR"
63 . D EN^DIQ1 K DIC,DA,DR,DIQ
64 . S PTEXT=$G(RGPDR(391.984,NTYP,.01,"E"))
65 .W !,$E(PTEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT
66 I TOTL=0 W !,"There are no entries in Patient Data Review."
67 K CNT,PDRTYP,NTYP,TOTL,IEN,PTEXT,RGPDR
68 ;Q
69 I $Y>20 D QUIT Q:X="^"
70 ;
71CMOR ;CMOR Requests Status
72 W !!,"CMOR Requests Status:",!,"---------------------"
73 S CNT=0,STAT="",NSTAT="",TOTL=0
74 F S STAT=$O(^MPIF(984.9,"AC",STAT)) Q:'STAT D
75 . I (STAT'=NSTAT)&(CNT>0) D
76 .. S TEXT=$$EXTERNAL^DILFD(984.9,.06,,NSTAT)
77 .. W !,$E(TEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
78 . S IEN=0,NSTAT=STAT
79 . F S IEN=$O(^MPIF(984.9,"AC",STAT,IEN)) Q:'IEN D
80 .. S CNT=CNT+1 S TOTL=TOTL+CNT
81 I CNT>0 S TEXT=$$EXTERNAL^DILFD(984.9,.06,,NSTAT) W !,$E(TEXT,1,47),?55,$J(CNT,6) S TOTL=TOTL+CNT,CNT=0
82 I TOTL=0 W !,"There are no outstanding CMOR Requests."
83 K CNT,STAT,NSTAT,TEXT,TOTL,IEN
84 I $Y>20 D QUIT Q:X="^"
85 ;
86 S HOME=$P($$SITE^VASITE(),"^",3)
87 S ICN=0,CNT=0
88 F S ICN=$O(^DPT("AICN",ICN)) Q:'ICN D
89 .Q:$E(ICN,1,3)=HOME
90 .S CNT=CNT+1
91 W !,"Current total number of National ICNs = ",CNT
92 S ICN=0,CNT=0
93 F S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN S CNT=CNT+1
94 W !,"Current total number of Local ICNs = ",CNT
95 K CNT,DFN,ICN
96 Q
97QUIT S DIR(0)="E" D D ^DIR K DIR
98 .S SS=21-$Y F JJ=1:1:SS W !
99 S $Y=0
100 K JJ,SS
101 Q
Note: See TracBrowser for help on using the repository browser.