YTPXRM.m

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 ---YTPXRM   2292     printed  Mar 13, 2025@21:22:54                                                                                                                                                                                                      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       ;