source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQPXRM.m@ 789

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1YTQPXRM ; ALB/ASF - Build indexes for Mental Health MHA3 ; 3/13/07 1:43pm
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
3 ;DBIA 4113 supports PXRMSXRM entry points.
4 ;DBIA ???? supports setting and killing ^PXRMINDX(601.84)
5 ;===============================================================
6INDEX ;Build the index for MENTAL HEALTH.
7 N DAS,DAST,DATE,DFN,END,ENTRIES,GLOBAL,IND,INS,NE,NERROR
8 N START,TENP,TEXT,IFN,COMP
9 ;Dont leave any old stuff around.
10 K ^PXRMINDX(601.84)
11 S GLOBAL=$$GET1^DID(601.84,"","","GLOBAL NAME")
12 S ENTRIES=$P(^YTT(601.84,0),U,4)
13 S TENP=ENTRIES/10
14 S TENP=+$P(TENP,".",1)
15 I TENP<1 S TENP=1
16 D BMES^XPDUTL("Building indexes for MHA3 DATA")
17 S TEXT="There are "_ENTRIES_" entries to process."
18 D MES^XPDUTL(TEXT)
19 S START=$H
20 S (IFN,DFN,IND,NE,NERROR)=0
21 F S IFN=$O(^YTT(601.84,IFN)) Q:IFN'>0 D
22 . S IND=IND+1
23 . I IND#TENP=0 D
24 .. S TEXT="Processing entry "_IND
25 .. D MES^XPDUTL(TEXT)
26 . I IND#10000=0 W "."
27 . S COMP=$P($G(^YTT(601.84,IFN,0)),U,9)
28 . Q:COMP'="Y" ;index only completed admins
29 . S DFN=$P(^YTT(601.84,IFN,0),U,2)
30 . S INS=$P(^YTT(601.84,IFN,0),U,3)
31 . S DATE=$P(^YTT(601.84,IFN,0),U,4) ;date given
32 . S DAS=IFN
33 . S ^PXRMINDX(601.84,"IP",INS,DFN,DATE,DAS)=""
34 . S ^PXRMINDX(601.84,"PI",DFN,INS,DATE,DAS)=""
35 . S NE=NE+1
36 S END=$H
37 S TEXT=NE_" MHA3 results indexed."
38 D MES^XPDUTL(TEXT)
39 D DETIME^PXRMSXRM(START,END)
40 ;If there were errors send a message.
41 I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
42 ;Send a MailMan message with the results.
43 D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
44 S ^PXRMINDX(601.84,"GLOBAL NAME")=GLOBAL
45 S ^PXRMINDX(601.84,"BUILT BY")=DUZ
46 S ^PXRMINDX(601.84,"DATE BUILT")=$$NOW^XLFDT
47 Q
48 ;
49 ;===============================================================
50KMH(X,DA) ;Delete index for 601.84 MH ADMINISTRATIONS
51 ;X(1)=Patient X(2)=Instrument X(3)=Date Given
52 K ^PXRMINDX(601.84,"IP",X(2),X(1),X(3),DA)
53 K ^PXRMINDX(601.84,"PI",X(1),X(2),X(3),DA)
54 Q
55 ;
56 ;===============================================================
57SMH(X,DA) ;Set index for 601.84 MH ADMINISTRATIONS
58 ;X(1)=Patient X(2)=Instrument X(3)=Date Given
59 S ^PXRMINDX(601.84,"IP",X(2),X(1),X(3),DA)=""
60 S ^PXRMINDX(601.84,"PI",X(1),X(2),X(3),DA)=""
61 Q
62 ;
Note: See TracBrowser for help on using the repository browser.