source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTPXRM.m@ 1437

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1YTPXRM ; SLC/PKR - Build indexes for Mental Health. ;10/28/2003
2 ;;5.01;MENTAL HEALTH;**77**;Dec 30, 1994
3 ;DBIA 4113 supports PXRMSXRM entry points.
4 ;DBIA 4114 supports setting and killing ^PXRMINDX(601.2)
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
9 ;Dont leave any old stuff around.
10 K ^PXRMINDX(601.2)
11 S GLOBAL=$$GET1^DID(601.2,"","","GLOBAL NAME")
12 S ENTRIES=$P(^YTD(601.2,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 MENTAL HEALTH DATA")
17 S TEXT="There are "_ENTRIES_" entries to process."
18 D MES^XPDUTL(TEXT)
19 S START=$H
20 S (DFN,IND,NE,NERROR)=0
21 F S DFN=+$O(^YTD(601.2,DFN)) Q:DFN=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 INS=0
28 . F S INS=$O(^YTD(601.2,DFN,1,INS)) Q:+INS=0 D
29 .. S DAST=DFN_";1;"_INS_";1;"
30 .. S DATE=0
31 .. F S DATE=$O(^YTD(601.2,DFN,1,INS,1,DATE)) Q:DATE="" D
32 ... S DAS=DAST_DATE
33 ... S ^PXRMINDX(601.2,"IP",INS,DFN,DATE,DAS)=""
34 ... S ^PXRMINDX(601.2,"PI",DFN,INS,DATE,DAS)=""
35 ... S NE=NE+1
36 S END=$H
37 S TEXT=NE_" MENTAL HEALTH 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.2,"GLOBAL NAME")=GLOBAL
45 S ^PXRMINDX(601.2,"BUILT BY")=DUZ
46 S ^PXRMINDX(601.2,"DATE BUILT")=$$NOW^XLFDT
47 Q
48 ;
49 ;===============================================================
50KMH(X,DA) ;Delete index for Psych Instrument Patient File
51 N DAS
52 S DAS=DA(2)_";1;"_DA(1)_";1;"_X(1)
53 K ^PXRMINDX(601.2,"IP",DA(1),DA(2),X(1),DAS)
54 K ^PXRMINDX(601.2,"PI",DA(2),DA(1),X(1),DAS)
55 Q
56 ;
57 ;===============================================================
58SMH(X,DA) ;Set index for Psych Instrument Patient File
59 ;DA=COMPLETION DATE, DA(1)=INSTRUMENT, DA(2)=DFN
60 ;X(1)=COMPLETION DATE
61 N DAS
62 S DAS=DA(2)_";1;"_DA(1)_";1;"_X(1)
63 S ^PXRMINDX(601.2,"IP",DA(1),DA(2),X(1),DAS)=""
64 S ^PXRMINDX(601.2,"PI",DA(2),DA(1),X(1),DAS)=""
65 Q
66 ;
Note: See TracBrowser for help on using the repository browser.