YTPXRM ; SLC/PKR - Build indexes for Mental Health. ;10/28/2003
;;5.01;MENTAL HEALTH;**77**;Dec 30, 1994
;DBIA 4113 supports PXRMSXRM entry points.
;DBIA 4114 supports setting and killing ^PXRMINDX(601.2)
;===============================================================
INDEX ;Build the index for MENTAL HEALTH.
N DAS,DAST,DATE,DFN,END,ENTRIES,GLOBAL,IND,INS,NE,NERROR
N START,TENP,TEXT
;Dont leave any old stuff around.
K ^PXRMINDX(601.2)
S GLOBAL=$$GET1^DID(601.2,"","","GLOBAL NAME")
S ENTRIES=$P(^YTD(601.2,0),U,4)
S TENP=ENTRIES/10
S TENP=+$P(TENP,".",1)
I TENP<1 S TENP=1
D BMES^XPDUTL("Building indexes for MENTAL HEALTH DATA")
S TEXT="There are "_ENTRIES_" entries to process."
D MES^XPDUTL(TEXT)
S START=$H
S (DFN,IND,NE,NERROR)=0
F S DFN=+$O(^YTD(601.2,DFN)) Q:DFN=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 INS=0
. F S INS=$O(^YTD(601.2,DFN,1,INS)) Q:+INS=0 D
.. S DAST=DFN_";1;"_INS_";1;"
.. S DATE=0
.. F S DATE=$O(^YTD(601.2,DFN,1,INS,1,DATE)) Q:DATE="" D
... S DAS=DAST_DATE
... S ^PXRMINDX(601.2,"IP",INS,DFN,DATE,DAS)=""
... S ^PXRMINDX(601.2,"PI",DFN,INS,DATE,DAS)=""
... S NE=NE+1
S END=$H
S TEXT=NE_" MENTAL HEALTH 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.2,"GLOBAL NAME")=GLOBAL
S ^PXRMINDX(601.2,"BUILT BY")=DUZ
S ^PXRMINDX(601.2,"DATE BUILT")=$$NOW^XLFDT
Q
;
;===============================================================
KMH(X,DA) ;Delete index for Psych Instrument Patient File
N DAS
S DAS=DA(2)_";1;"_DA(1)_";1;"_X(1)
K ^PXRMINDX(601.2,"IP",DA(1),DA(2),X(1),DAS)
K ^PXRMINDX(601.2,"PI",DA(2),DA(1),X(1),DAS)
Q
;
;===============================================================
SMH(X,DA) ;Set index for Psych Instrument Patient File
;DA=COMPLETION DATE, DA(1)=INSTRUMENT, DA(2)=DFN
;X(1)=COMPLETION DATE
N DAS
S DAS=DA(2)_";1;"_DA(1)_";1;"_X(1)
S ^PXRMINDX(601.2,"IP",DA(1),DA(2),X(1),DAS)=""
S ^PXRMINDX(601.2,"PI",DA(2),DA(1),X(1),DAS)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTPXRM 2292 printed Sep 23, 2025@19:54:08 Page 2
YTPXRM ; SLC/PKR - Build indexes for Mental Health. ;10/28/2003
+1 ;;5.01;MENTAL HEALTH;**77**;Dec 30, 1994
+2 ;DBIA 4113 supports PXRMSXRM entry points.
+3 ;DBIA 4114 supports setting and killing ^PXRMINDX(601.2)
+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
+3 ;Dont leave any old stuff around.
+4 KILL ^PXRMINDX(601.2)
+5 SET GLOBAL=$$GET1^DID(601.2,"","","GLOBAL NAME")
+6 SET ENTRIES=$PIECE(^YTD(601.2,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 MENTAL HEALTH DATA")
+11 SET TEXT="There are "_ENTRIES_" entries to process."
+12 DO MES^XPDUTL(TEXT)
+13 SET START=$HOROLOG
+14 SET (DFN,IND,NE,NERROR)=0
+15 FOR
SET DFN=+$ORDER(^YTD(601.2,DFN))
if DFN=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 INS=0
+22 FOR
SET INS=$ORDER(^YTD(601.2,DFN,1,INS))
if +INS=0
QUIT
Begin DoDot:2
+23 SET DAST=DFN_";1;"_INS_";1;"
+24 SET DATE=0
+25 FOR
SET DATE=$ORDER(^YTD(601.2,DFN,1,INS,1,DATE))
if DATE=""
QUIT
Begin DoDot:3
+26 SET DAS=DAST_DATE
+27 SET ^PXRMINDX(601.2,"IP",INS,DFN,DATE,DAS)=""
+28 SET ^PXRMINDX(601.2,"PI",DFN,INS,DATE,DAS)=""
+29 SET NE=NE+1
End DoDot:3
End DoDot:2
End DoDot:1
+30 SET END=$HOROLOG
+31 SET TEXT=NE_" MENTAL HEALTH 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.2,"GLOBAL NAME")=GLOBAL
+39 SET ^PXRMINDX(601.2,"BUILT BY")=DUZ
+40 SET ^PXRMINDX(601.2,"DATE BUILT")=$$NOW^XLFDT
+41 QUIT
+42 ;
+43 ;===============================================================
KMH(X,DA) ;Delete index for Psych Instrument Patient File
+1 NEW DAS
+2 SET DAS=DA(2)_";1;"_DA(1)_";1;"_X(1)
+3 KILL ^PXRMINDX(601.2,"IP",DA(1),DA(2),X(1),DAS)
+4 KILL ^PXRMINDX(601.2,"PI",DA(2),DA(1),X(1),DAS)
+5 QUIT
+6 ;
+7 ;===============================================================
SMH(X,DA) ;Set index for Psych Instrument Patient File
+1 ;DA=COMPLETION DATE, DA(1)=INSTRUMENT, DA(2)=DFN
+2 ;X(1)=COMPLETION DATE
+3 NEW DAS
+4 SET DAS=DA(2)_";1;"_DA(1)_";1;"_X(1)
+5 SET ^PXRMINDX(601.2,"IP",DA(1),DA(2),X(1),DAS)=""
+6 SET ^PXRMINDX(601.2,"PI",DA(2),DA(1),X(1),DAS)=""
+7 QUIT
+8 ;
