YTQPXRM ; ALB/ASF - Build indexes for Mental Health MHA3 ; 3/13/07 1:43pm
;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 48
;DBIA 4113 supports PXRMSXRM entry points.
;DBIA ???? supports setting and killing ^PXRMINDX(601.84)
;===============================================================
INDEX ;Build the index for MENTAL HEALTH.
N DAS,DAST,DATE,DFN,END,ENTRIES,GLOBAL,IND,INS,NE,NERROR
N START,TENP,TEXT,IFN,COMP
;Dont leave any old stuff around.
K ^PXRMINDX(601.84)
S GLOBAL=$$GET1^DID(601.84,"","","GLOBAL NAME")
S ENTRIES=$P(^YTT(601.84,0),U,4)
S TENP=ENTRIES/10
S TENP=+$P(TENP,".",1)
I TENP<1 S TENP=1
D BMES^XPDUTL("Building indexes for MHA3 DATA")
S TEXT="There are "_ENTRIES_" entries to process."
D MES^XPDUTL(TEXT)
S START=$H
S (IFN,DFN,IND,NE,NERROR)=0
F S IFN=$O(^YTT(601.84,IFN)) Q:IFN'>0 D
. S IND=IND+1
. I IND#TENP=0 D
.. S TEXT="Processing entry "_IND
.. D MES^XPDUTL(TEXT)
. I IND#10000=0 W "."
. S COMP=$P($G(^YTT(601.84,IFN,0)),U,9)
. Q:COMP'="Y" ;index only completed admins
. S DFN=$P(^YTT(601.84,IFN,0),U,2)
. S INS=$P(^YTT(601.84,IFN,0),U,3)
. S DATE=$P(^YTT(601.84,IFN,0),U,4) ;date given
. S DAS=IFN
. S ^PXRMINDX(601.84,"IP",INS,DFN,DATE,DAS)=""
. S ^PXRMINDX(601.84,"PI",DFN,INS,DATE,DAS)=""
. S NE=NE+1
S END=$H
S TEXT=NE_" MHA3 results indexed."
D MES^XPDUTL(TEXT)
D DETIME^PXRMSXRM(START,END)
;If there were errors send a message.
I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
;Send a MailMan message with the results.
D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
S ^PXRMINDX(601.84,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(601.84,"BUILT BY")=DUZ
S ^PXRMINDX(601.84,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
KMH(X,DA) ;Delete index for 601.84 MH ADMINISTRATIONS
;X(1)=Patient X(2)=Instrument X(3)=Date Given
K ^PXRMINDX(601.84,"IP",X(2),X(1),X(3),DA)
K ^PXRMINDX(601.84,"PI",X(1),X(2),X(3),DA)
Q
;
;===============================================================
SMH(X,DA) ;Set index for 601.84 MH ADMINISTRATIONS
;X(1)=Patient X(2)=Instrument X(3)=Date Given
S ^PXRMINDX(601.84,"IP",X(2),X(1),X(3),DA)=""
S ^PXRMINDX(601.84,"PI",X(1),X(2),X(3),DA)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQPXRM 2259 printed Apr 09, 2024@21:18:33 Page 2
YTQPXRM ; ALB/ASF - Build indexes for Mental Health MHA3 ; 3/13/07 1:43pm
+1 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 48
+2 ;DBIA 4113 supports PXRMSXRM entry points.
+3 ;DBIA ???? supports setting and killing ^PXRMINDX(601.84)
+4 ;===============================================================
INDEX ;Build the index for MENTAL HEALTH.
+1 NEW DAS,DAST,DATE,DFN,END,ENTRIES,GLOBAL,IND,INS,NE,NERROR
+2 NEW START,TENP,TEXT,IFN,COMP
+3 ;Dont leave any old stuff around.
+4 KILL ^PXRMINDX(601.84)
+5 SET GLOBAL=$$GET1^DID(601.84,"","","GLOBAL NAME")
+6 SET ENTRIES=$PIECE(^YTT(601.84,0),U,4)
+7 SET TENP=ENTRIES/10
+8 SET TENP=+$PIECE(TENP,".",1)
+9 IF TENP<1
SET TENP=1
+10 DO BMES^XPDUTL("Building indexes for MHA3 DATA")
+11 SET TEXT="There are "_ENTRIES_" entries to process."
+12 DO MES^XPDUTL(TEXT)
+13 SET START=$HOROLOG
+14 SET (IFN,DFN,IND,NE,NERROR)=0
+15 FOR
SET IFN=$ORDER(^YTT(601.84,IFN))
if IFN'>0
QUIT
Begin DoDot:1
+16 SET IND=IND+1
+17 IF IND#TENP=0
Begin DoDot:2
+18 SET TEXT="Processing entry "_IND
+19 DO MES^XPDUTL(TEXT)
End DoDot:2
+20 IF IND#10000=0
WRITE "."
+21 SET COMP=$PIECE($GET(^YTT(601.84,IFN,0)),U,9)
+22 ;index only completed admins
if COMP'="Y"
QUIT
+23 SET DFN=$PIECE(^YTT(601.84,IFN,0),U,2)
+24 SET INS=$PIECE(^YTT(601.84,IFN,0),U,3)
+25 ;date given
SET DATE=$PIECE(^YTT(601.84,IFN,0),U,4)
+26 SET DAS=IFN
+27 SET ^PXRMINDX(601.84,"IP",INS,DFN,DATE,DAS)=""
+28 SET ^PXRMINDX(601.84,"PI",DFN,INS,DATE,DAS)=""
+29 SET NE=NE+1
End DoDot:1
+30 SET END=$HOROLOG
+31 SET TEXT=NE_" MHA3 results indexed."
+32 DO MES^XPDUTL(TEXT)
+33 DO DETIME^PXRMSXRM(START,END)
+34 ;If there were errors send a message.
+35 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+36 ;Send a MailMan message with the results.
+37 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+38 SET ^PXRMINDX(601.84,"GLOBAL NAME")=GLOBAL
+39 SET ^PXRMINDX(601.84,"BUILT BY")=DUZ
+40 SET ^PXRMINDX(601.84,"DATE BUILT")=$$NOW^XLFDT
+41 QUIT
+42 ;
+43 ;===============================================================
KMH(X,DA) ;Delete index for 601.84 MH ADMINISTRATIONS
+1 ;X(1)=Patient X(2)=Instrument X(3)=Date Given
+2 KILL ^PXRMINDX(601.84,"IP",X(2),X(1),X(3),DA)
+3 KILL ^PXRMINDX(601.84,"PI",X(1),X(2),X(3),DA)
+4 QUIT
+5 ;
+6 ;===============================================================
SMH(X,DA) ;Set index for 601.84 MH ADMINISTRATIONS
+1 ;X(1)=Patient X(2)=Instrument X(3)=Date Given
+2 SET ^PXRMINDX(601.84,"IP",X(2),X(1),X(3),DA)=""
+3 SET ^PXRMINDX(601.84,"PI",X(1),X(2),X(3),DA)=""
+4 QUIT
+5 ;
