YTQPXRM.m

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 ---YTQPXRM   2259     printed  Mar 13, 2025@21:23:23                                                                                                                                                                                                     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       ;