| 1 | YTQPXRM ; 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 | ;===============================================================
|
|---|
| 6 | INDEX ;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 | ;===============================================================
|
|---|
| 50 | KMH(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 | ;===============================================================
|
|---|
| 57 | SMH(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 | ;
|
|---|
