DGPTDDCR.m

DGPTDDCR ;SLC/PKR - Routines for setting and killing Clinical Reminder index. ;08/12/2004

 ;;5.3;Registration;**478,1015**;Aug 13, 1993;Build 21

 ;===========================================================

INDEX ;Build the indexes for PTF.

 N D1,DA,DAS,DATE,DFN,DIFF,END,ENTRIES,ETEXT,GLOBAL,HASCODES

 N ICD0,ICD9,IND,JND,KND,NE0,NE9,NERROR,NODE,START

 N TEMP0,TEMP70,TEMP71,TEMPP,TEMPS,TENP,TEXT,VISIT

 ;DBIA 4114

 ;Don't leave any old stuff around.

 K ^PXRMINDX(45)

 S GLOBAL=$$GET1^DID(45,"","","GLOBAL NAME")

 S ENTRIES=$P(^DGPT(0),U,4)

 S TENP=ENTRIES/10

 S TENP=+$P(TENP,".",1)

 I TENP<1 S TENP=1

 D BMES^XPDUTL("Building indexes for DGPT")

 S TEXT="There are "_ENTRIES_" entries to process."

 D MES^XPDUTL(TEXT)

 S START=$H

 S (DA,IND,NE0,NE9,NERROR)=0

 F  S DA=+$O(^DGPT(DA)) Q:DA=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 TEMP0=$G(^DGPT(DA,0))

 .;Cenus records are not indexed.

 . I $P(TEMP0,U,11)=2 Q

 . S DFN=$P(TEMP0,U,1)

 . I DFN="" D  Q

 .. S ETEXT=DA_" no patient"

 .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 . S D1=0

 . F  S D1=+$O(^DGPT(DA,"S",D1)) Q:D1=0  D

 .. S TEMPS=$G(^DGPT(DA,"S",D1,0))

 .. S DATE=$P(TEMPS,U,1)

 .. I DATE="" D  Q

 ... S ETEXT=DA_" S node missing date"

 ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q

 .. S DAS=DA_";S;"_D1_";0"

 .. S KND=0

 .. F JND=8,9,10,11,12 D

 ... S KND=KND+1

 ... S NODE="S"_KND

 ... S ICD0=$P(TEMPS,U,JND)

 ... I (ICD0'="") D

 .... I $D(^ICD0(ICD0)) D

 ..... S NE0=NE0+1

 ..... S ^PXRMINDX(45,"ICD0","INP",ICD0,NODE,DFN,DATE,DAS)=""

 ..... S ^PXRMINDX(45,"ICD0","PNI",DFN,NODE,ICD0,DATE,DAS)=""

 .... E  D 

 ..... S ETEXT=DAS_" node "_NODE_" invalid ICD0"

 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 .;

 . S D1=0

 . F  S D1=+$O(^DGPT(DA,"P",D1)) Q:D1=0  D

 .. S TEMPP=$G(^DGPT(DA,"P",D1,0))

 .. S DATE=$P(TEMPP,U,1)

 .. I DATE="" D  Q

 ... S ETEXT=DA_" P node missing date"

 ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q

 .. S DAS=DA_";P;"_D1_";0"

 .. S KND=0

 .. F JND=5,6,7,8,9 D

 ... S KND=KND+1

 ... S NODE="P"_KND

 ... S ICD0=$P(TEMPP,U,JND)

 ... I (ICD0'="") D

 .... I $D(^ICD0(ICD0)) D

 ..... S NE0=NE0+1

 ..... S ^PXRMINDX(45,"ICD0","INP",ICD0,NODE,DFN,DATE,DAS)=""

 ..... S ^PXRMINDX(45,"ICD0","PNI",DFN,NODE,ICD0,DATE,DAS)=""

 .... E  D

 ..... S ETEXT=DAS_" "_NODE_" invalid ICD0"

 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 .;

 .;Discharge ICD9 codes

 . I $D(^DGPT(DA,70)) D

 .. S TEMP70=$G(^DGPT(DA,70))

 .. S TEMP71=$G(^DGPT(DA,71))

 .. S DATE=$P(TEMP70,U,1)

 .. I DATE="" S DATE=$P(TEMP0,U,2)

 .. S DAS=DA_";70"

 .. S ICD9=$P(TEMP70,U,10)

 .. I (ICD9'="") D

 ... I $D(^ICD9(ICD9)) D

 .... S NE9=NE9+1

 .... S ^PXRMINDX(45,"ICD9","INP",ICD9,"DXLS",DFN,DATE,DAS)=""

 .... S ^PXRMINDX(45,"ICD9","PNI",DFN,"DXLS",ICD9,DATE,DAS)=""

 ... E  D

 .... S ETEXT=DAS_" DXLS invalid ICD9"

 .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 ..;

 .. S ICD9=$P(TEMP70,U,11)

 .. I (ICD9'="") D

 ... I $D(^ICD9(ICD9)) D

 .... S NE9=NE9+1

 .... S ^PXRMINDX(45,"ICD9","INP",ICD9,"PDX",DFN,DATE,DAS)=""

 .... S ^PXRMINDX(45,"ICD9","PNI",DFN,"PDX",ICD9,DATE,DAS)=""

 ... E  D

 .... S ETEXT=DAS_" PDX invalid ICD9"

 .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 ..;

 .. S KND=0

 .. F JND=16,17,18,19,20,21,22,23,24 D

 ... S KND=KND+1

 ... S NODE="D SD"_KND

 ... S ICD9=$P(TEMP70,U,JND)

 ... I (ICD9'="") D

 .... I $D(^ICD9(ICD9)) D

 ..... S NE9=NE9+1

 ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""

 ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""

 .... E  D

 ..... S ETEXT=DAS_" node "_NODE_" invalid ICD9"

 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 ..;

 .. S KND=9

 .. F JND=1,2,3,4 D

 ... S KND=KND+1

 ... S NODE="D SD"_KND

 ... S ICD9=$P(TEMP71,U,JND)

 ... I (ICD9'="") D

 .... I $D(^ICD9(ICD9)) D

 ..... S NE9=NE9+1

 ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""

 ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""

 .... E  D

 ..... S ETEXT=DAS_" node "_NODE_" invalid ICD9"

 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 ..;

 .;Movement ICD9 codes

 . I '$D(^DGPT(DA,"M")) Q

 . S D1=0

 . F  S D1=$O(^DGPT(DA,"M",D1)) Q:+D1=0  D

 .. S TEMPS=$G(^DGPT(DA,"M",D1,0))

 .. S DATE=$P(TEMPS,U,10)

 .. I DATE="" D  Q

 ... S HASCODES=0

 ... F JND=5,6,7,8,9,11,12,13,14,15 D

 .... S ICD9=$P(TEMPS,U,JND)

 .... I ICD9'="" S HASCODES=1

 ... I HASCODES D

 .... S ETEXT=DA_";M;"_D1_";0"_" M node missing date"

 .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 .. S DAS=DA_";M;"_D1

 .. S KND=0

 .. F JND=5,6,7,8,9,11,12,13,14,15 D

 ... S KND=KND+1

 ... S NODE="M ICD"_KND

 ... S ICD9=$P(TEMPS,U,JND)

 ... I (ICD9'="") D

 .... I $D(^ICD9(ICD9)) D

 ..... S NE9=NE9+1

 ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""

 ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""

 .... E  D

 ..... S ETEXT=DAS_" M node invalid ICD9"

 ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

 .;

 S END=$H

 S TEXT=NE0_" PTF ICD0 results indexed."

 D MES^XPDUTL(TEXT)

 S TEXT=NE9_" PTF ICD9 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,(NE0+NE9),NERROR)

 S ^PXRMINDX(45,"GLOBAL NAME")=GLOBAL

 S ^PXRMINDX(45,"BUILT BY")=DUZ

 S ^PXRMINDX(45,"DATE BUILT")=$$NOW^XLFDT

 Q

 ;

 ;===============================================================

KDGPT0(X,DA,NODE,NUM) ;Delete index for PTF ICD0 data.

 ;Census records are not indexed.

 I $P(^DGPT(DA(1),0),U,11)=2 Q

 N DAS,DFN,NNAME

 S DFN=$P(^DGPT(DA(1),0),U,1)

 S NNAME=NODE_NUM

 S DAS=DA(1)_";"_NODE_";"_DA_";0"

 ;DBIA 4114

 K ^PXRMINDX(45,"ICD0","INP",X(2),NNAME,DFN,X(1),DAS)

 K ^PXRMINDX(45,"ICD0","PNI",DFN,NNAME,X(2),X(1),DAS)

 Q

 ;

 ;===============================================================

KDGPT9D(X,DA,NODE) ;Delete index for PTF discharge ICD9 data.

 N DAS,DATE

 ;Census records are not indexed.

 I X(3)=2 Q

 ;If there is no discharge date use the admission date.

 S DATE=$S(X(5)'="":X(5),1:X(2))

 S DAS=DA_";70"

 ;DBIA 4114

 K ^PXRMINDX(45,"ICD9","INP",X(4),NODE,X(1),DATE,DAS)

 K ^PXRMINDX(45,"ICD9","PNI",X(1),NODE,X(4),DATE,DAS)

 Q

 ;

 ;===============================================================

KDGPT9M(X,DA,NODE) ;Delete index for PTF movement ICD9 data.

 ;Census records are not indexed.

 I $P(^DGPT(DA(1),0),U,11)=2 Q

 N DAS,DFN,TEMP

 S TEMP=^DGPT(DA(1),0)

 S DFN=$P(TEMP,U,1)

 S DAS=DA(1)_";M;"_DA

 ;DBIA 4114

 K ^PXRMINDX(45,"ICD9","INP",X(2),NODE,DFN,X(1),DAS)

 K ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,X(2),X(1),DAS)

 Q

 ;

 ;===============================================================

SDGPT0(X,DA,NODE,NUM) ;Set index for PTF ICD0 data.

 ;For node 401 surgery node:

 ;X(1)=SURGERY/PROCEDURE DATE, X(2)=ICD0

 ;X(2) nodes: 45.01,8; 45.01,9; 45.01,10; 45.01,11; 45.01,12

 ;For node 601, procedure node:

 ;X(1)=PROCEDURE DATE, X(2)=ICD0

 ;X(2) source nodes: 45.05,4; 45.05,5; 45.05,6; 45.05,7; 45.05,8

 ;Census records are not indexed.

 I $P(^DGPT(DA(1),0),U,11)=2 Q

 N DAS,DFN,NNAME

 S DFN=$P(^DGPT(DA(1),0),U,1)

 S NNAME=NODE_NUM

 S DAS=DA(1)_";"_NODE_";"_DA_";0"

 ;DBIA 4114

 S ^PXRMINDX(45,"ICD0","INP",X(2),NNAME,DFN,X(1),DAS)=""

 S ^PXRMINDX(45,"ICD0","PNI",DFN,NNAME,X(2),X(1),DAS)=""

 Q

 ;

 ;===============================================================

SDGPT9D(X,DA,NODE) ;Set index for PTF discharge ICD9 data.

 ;X(1)=DFN, X(2)=ADMISSION DATE, X(3)=TYPE OF RECORD, X(4)=ICD9,

 ;X(5)=DISCHARGE DATE

 ;ICD9 from nodes: 45,79; 45,80; 45,79.16 45,79.17; 45,79.18;

 ;45,79.19; 45,79.20; 45,79.21; 45,79.22; 45,79.22; 45.79.23;

 ;45.79.24.

 ;By name these nodes are: DXLS, PRINCIPAL DIAGNOSIS, SECONDARY

 ;DIAGNOSIS 1 through SECONDARY DIAGNOSIS 13.

 ;Census records are not indexed.

 I X(3)=2 Q

 N DAS,DATE

 ;If there is no discharge date use the admission date.

 S DATE=$S(X(5)'="":X(5),1:X(2))

 S DAS=DA_";70"

 ;DBIA 4114

 S ^PXRMINDX(45,"ICD9","INP",X(4),NODE,X(1),DATE,DAS)=""

 S ^PXRMINDX(45,"ICD9","PNI",X(1),NODE,X(4),DATE,DAS)=""

 Q

 ;

 ;===============================================================

SDGPT9M(X,DA,NODE) ;Set index for PTF movement ICD9 data.

 ;X(1)=MOVEMENT DATE, X(3)=TYPE OF RECORD, X(3)=ICD9

 ;ICD9 from nodes: 45.02,5 45.02,6, 45.02,7 45.02,8 45.02,9

 ;45.02,11 45.02,12 45.02,13 45.02,14 45.02,15

 ;By name these nodes are: ICD 1, through ICD 10.

 ;Census records are not indexed.

 I $P(^DGPT(DA(1),0),U,11)=2 Q

 N DAS,DFN,TEMP

 S TEMP=^DGPT(DA(1),0)

 S DFN=$P(TEMP,U,1)

 S DAS=DA(1)_";M;"_DA

 ;DBIA 4114

 S ^PXRMINDX(45,"ICD9","INP",X(2),NODE,DFN,X(1),DAS)=""

 S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,X(2),X(1),DAS)=""

 Q

 ;

DGPTDDCR  ;SLC/PKR - Routines for setting and killing Clinical Reminder index. ;08/12/2004

 +1       ;;5.3;Registration;**478,1015**;Aug 13, 1993;Build 21

 +2       ;===========================================================

INDEX     ;Build the indexes for PTF.

 +1        NEW D1,DA,DAS,DATE,DFN,DIFF,END,ENTRIES,ETEXT,GLOBAL,HASCODES

 +2        NEW ICD0,ICD9,IND,JND,KND,NE0,NE9,NERROR,NODE,START

 +3        NEW TEMP0,TEMP70,TEMP71,TEMPP,TEMPS,TENP,TEXT,VISIT

 +4       ;DBIA 4114

 +5       ;Don't leave any old stuff around.

 +6        KILL ^PXRMINDX(45)

 +7        SET GLOBAL=$$GET1^DID(45,"","","GLOBAL NAME")

 +8        SET ENTRIES=$PIECE(^DGPT(0),U,4)

 +9        SET TENP=ENTRIES/10

 +10       SET TENP=+$PIECE(TENP,".",1)

 +11       IF TENP<1

               SET TENP=1

 +12       DO BMES^XPDUTL("Building indexes for DGPT")

 +13       SET TEXT="There are "_ENTRIES_" entries to process."

 +14       DO MES^XPDUTL(TEXT)

 +15       SET START=$HOROLOG

 +16       SET (DA,IND,NE0,NE9,NERROR)=0

 +17       FOR 

               SET DA=+$ORDER(^DGPT(DA))

               IF DA=0

                   QUIT 

               Begin DoDot:1

 +18               SET IND=IND+1

 +19               IF IND#TENP=0

                       Begin DoDot:2

 +20                       SET TEXT="Processing entry "_IND

 +21                       DO MES^XPDUTL(TEXT)

                       End DoDot:2

 +22               IF IND#10000=0

                       WRITE "."

 +23               SET TEMP0=$GET(^DGPT(DA,0))

 +24      ;Cenus records are not indexed.

 +25               IF $PIECE(TEMP0,U,11)=2

                       QUIT 

 +26               SET DFN=$PIECE(TEMP0,U,1)

 +27               IF DFN=""

                       Begin DoDot:2

 +28                       SET ETEXT=DA_" no patient"

 +29                       DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                       End DoDot:2

                       QUIT 

 +30               SET D1=0

 +31               FOR 

                       SET D1=+$ORDER(^DGPT(DA,"S",D1))

                       IF D1=0

                           QUIT 

                       Begin DoDot:2

 +32                       SET TEMPS=$GET(^DGPT(DA,"S",D1,0))

 +33                       SET DATE=$PIECE(TEMPS,U,1)

 +34                       IF DATE=""

                               Begin DoDot:3

 +35                               SET ETEXT=DA_" S node missing date"

 +36                               DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                   QUIT 

                               End DoDot:3

                               QUIT 

 +37                       SET DAS=DA_";S;"_D1_";0"

 +38                       SET KND=0

 +39                       FOR JND=8,9,10,11,12

                               Begin DoDot:3

 +40                               SET KND=KND+1

 +41                               SET NODE="S"_KND

 +42                               SET ICD0=$PIECE(TEMPS,U,JND)

 +43                               IF (ICD0'="")

                                       Begin DoDot:4

 +44                                       IF $DATA(^ICD0(ICD0))

                                               Begin DoDot:5

 +45                                               SET NE0=NE0+1

 +46                                               SET ^PXRMINDX(45,"ICD0","INP",ICD0,NODE,DFN,DATE,DAS)=""

 +47                                               SET ^PXRMINDX(45,"ICD0","PNI",DFN,NODE,ICD0,DATE,DAS)=""

                                               End DoDot:5

 +48                                      IF '$TEST

                                               Begin DoDot:5

 +49                                               SET ETEXT=DAS_" node "_NODE_" invalid ICD0"

 +50                                               DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +51      ;

 +52               SET D1=0

 +53               FOR 

                       SET D1=+$ORDER(^DGPT(DA,"P",D1))

                       IF D1=0

                           QUIT 

                       Begin DoDot:2

 +54                       SET TEMPP=$GET(^DGPT(DA,"P",D1,0))

 +55                       SET DATE=$PIECE(TEMPP,U,1)

 +56                       IF DATE=""

                               Begin DoDot:3

 +57                               SET ETEXT=DA_" P node missing date"

 +58                               DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                   QUIT 

                               End DoDot:3

                               QUIT 

 +59                       SET DAS=DA_";P;"_D1_";0"

 +60                       SET KND=0

 +61                       FOR JND=5,6,7,8,9

                               Begin DoDot:3

 +62                               SET KND=KND+1

 +63                               SET NODE="P"_KND

 +64                               SET ICD0=$PIECE(TEMPP,U,JND)

 +65                               IF (ICD0'="")

                                       Begin DoDot:4

 +66                                       IF $DATA(^ICD0(ICD0))

                                               Begin DoDot:5

 +67                                               SET NE0=NE0+1

 +68                                               SET ^PXRMINDX(45,"ICD0","INP",ICD0,NODE,DFN,DATE,DAS)=""

 +69                                               SET ^PXRMINDX(45,"ICD0","PNI",DFN,NODE,ICD0,DATE,DAS)=""

                                               End DoDot:5

 +70                                      IF '$TEST

                                               Begin DoDot:5

 +71                                               SET ETEXT=DAS_" "_NODE_" invalid ICD0"

 +72                                               DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +73      ;

 +74      ;Discharge ICD9 codes

 +75               IF $DATA(^DGPT(DA,70))

                       Begin DoDot:2

 +76                       SET TEMP70=$GET(^DGPT(DA,70))

 +77                       SET TEMP71=$GET(^DGPT(DA,71))

 +78                       SET DATE=$PIECE(TEMP70,U,1)

 +79                       IF DATE=""

                               SET DATE=$PIECE(TEMP0,U,2)

 +80                       SET DAS=DA_";70"

 +81                       SET ICD9=$PIECE(TEMP70,U,10)

 +82                       IF (ICD9'="")

                               Begin DoDot:3

 +83                               IF $DATA(^ICD9(ICD9))

                                       Begin DoDot:4

 +84                                       SET NE9=NE9+1

 +85                                       SET ^PXRMINDX(45,"ICD9","INP",ICD9,"DXLS",DFN,DATE,DAS)=""

 +86                                       SET ^PXRMINDX(45,"ICD9","PNI",DFN,"DXLS",ICD9,DATE,DAS)=""

                                       End DoDot:4

 +87                              IF '$TEST

                                       Begin DoDot:4

 +88                                       SET ETEXT=DAS_" DXLS invalid ICD9"

 +89                                       DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                       End DoDot:4

                               End DoDot:3

 +90      ;

 +91                       SET ICD9=$PIECE(TEMP70,U,11)

 +92                       IF (ICD9'="")

                               Begin DoDot:3

 +93                               IF $DATA(^ICD9(ICD9))

                                       Begin DoDot:4

 +94                                       SET NE9=NE9+1

 +95                                       SET ^PXRMINDX(45,"ICD9","INP",ICD9,"PDX",DFN,DATE,DAS)=""

 +96                                       SET ^PXRMINDX(45,"ICD9","PNI",DFN,"PDX",ICD9,DATE,DAS)=""

                                       End DoDot:4

 +97                              IF '$TEST

                                       Begin DoDot:4

 +98                                       SET ETEXT=DAS_" PDX invalid ICD9"

 +99                                       DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                       End DoDot:4

                               End DoDot:3

 +100     ;

 +101                      SET KND=0

 +102                      FOR JND=16,17,18,19,20,21,22,23,24

                               Begin DoDot:3

 +103                              SET KND=KND+1

 +104                              SET NODE="D SD"_KND

 +105                              SET ICD9=$PIECE(TEMP70,U,JND)

 +106                              IF (ICD9'="")

                                       Begin DoDot:4

 +107                                      IF $DATA(^ICD9(ICD9))

                                               Begin DoDot:5

 +108                                              SET NE9=NE9+1

 +109                                              SET ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""

 +110                                              SET ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""

                                               End DoDot:5

 +111                                     IF '$TEST

                                               Begin DoDot:5

 +112                                              SET ETEXT=DAS_" node "_NODE_" invalid ICD9"

 +113                                              DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

 +114     ;

 +115                      SET KND=9

 +116                      FOR JND=1,2,3,4

                               Begin DoDot:3

 +117                              SET KND=KND+1

 +118                              SET NODE="D SD"_KND

 +119                              SET ICD9=$PIECE(TEMP71,U,JND)

 +120                              IF (ICD9'="")

                                       Begin DoDot:4

 +121                                      IF $DATA(^ICD9(ICD9))

                                               Begin DoDot:5

 +122                                              SET NE9=NE9+1

 +123                                              SET ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""

 +124                                              SET ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""

                                               End DoDot:5

 +125                                     IF '$TEST

                                               Begin DoDot:5

 +126                                              SET ETEXT=DAS_" node "_NODE_" invalid ICD9"

 +127                                              DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

 +128     ;

                       End DoDot:2

 +129     ;Movement ICD9 codes

 +130              IF '$DATA(^DGPT(DA,"M"))

                       QUIT 

 +131              SET D1=0

 +132              FOR 

                       SET D1=$ORDER(^DGPT(DA,"M",D1))

                       IF +D1=0

                           QUIT 

                       Begin DoDot:2

 +133                      SET TEMPS=$GET(^DGPT(DA,"M",D1,0))

 +134                      SET DATE=$PIECE(TEMPS,U,10)

 +135                      IF DATE=""

                               Begin DoDot:3

 +136                              SET HASCODES=0

 +137                              FOR JND=5,6,7,8,9,11,12,13,14,15

                                       Begin DoDot:4

 +138                                      SET ICD9=$PIECE(TEMPS,U,JND)

 +139                                      IF ICD9'=""

                                               SET HASCODES=1

                                       End DoDot:4

 +140                              IF HASCODES

                                       Begin DoDot:4

 +141                                      SET ETEXT=DA_";M;"_D1_";0"_" M node missing date"

 +142                                      DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                       End DoDot:4

                               End DoDot:3

                               QUIT 

 +143                      SET DAS=DA_";M;"_D1

 +144                      SET KND=0

 +145                      FOR JND=5,6,7,8,9,11,12,13,14,15

                               Begin DoDot:3

 +146                              SET KND=KND+1

 +147                              SET NODE="M ICD"_KND

 +148                              SET ICD9=$PIECE(TEMPS,U,JND)

 +149                              IF (ICD9'="")

                                       Begin DoDot:4

 +150                                      IF $DATA(^ICD9(ICD9))

                                               Begin DoDot:5

 +151                                              SET NE9=NE9+1

 +152                                              SET ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""

 +153                                              SET ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""

                                               End DoDot:5

 +154                                     IF '$TEST

                                               Begin DoDot:5

 +155                                              SET ETEXT=DAS_" M node invalid ICD9"

 +156                                              DO ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +157     ;

               End DoDot:1

 +158      SET END=$HOROLOG

 +159      SET TEXT=NE0_" PTF ICD0 results indexed."

 +160      DO MES^XPDUTL(TEXT)

 +161      SET TEXT=NE9_" PTF ICD9 results indexed."

 +162      DO MES^XPDUTL(TEXT)

 +163      DO DETIME^PXRMSXRM(START,END)

 +164     ;If there were errors send a message.

 +165      IF NERROR>0

               DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)

 +166     ;Send a MailMan message with the results.

 +167      DO COMMSG^PXRMSXRM(GLOBAL,START,END,(NE0+NE9),NERROR)

 +168      SET ^PXRMINDX(45,"GLOBAL NAME")=GLOBAL

 +169      SET ^PXRMINDX(45,"BUILT BY")=DUZ

 +170      SET ^PXRMINDX(45,"DATE BUILT")=$$NOW^XLFDT

 +171      QUIT 

 +172     ;

 +173     ;===============================================================

KDGPT0(X,DA,NODE,NUM) ;Delete index for PTF ICD0 data.

 +1       ;Census records are not indexed.

 +2        IF $PIECE(^DGPT(DA(1),0),U,11)=2

               QUIT 

 +3        NEW DAS,DFN,NNAME

 +4        SET DFN=$PIECE(^DGPT(DA(1),0),U,1)

 +5        SET NNAME=NODE_NUM

 +6        SET DAS=DA(1)_";"_NODE_";"_DA_";0"

 +7       ;DBIA 4114

 +8        KILL ^PXRMINDX(45,"ICD0","INP",X(2),NNAME,DFN,X(1),DAS)

 +9        KILL ^PXRMINDX(45,"ICD0","PNI",DFN,NNAME,X(2),X(1),DAS)

 +10       QUIT 

 +11      ;

 +12      ;===============================================================

KDGPT9D(X,DA,NODE) ;Delete index for PTF discharge ICD9 data.

 +1        NEW DAS,DATE

 +2       ;Census records are not indexed.

 +3        IF X(3)=2

               QUIT 

 +4       ;If there is no discharge date use the admission date.

 +5        SET DATE=$SELECT(X(5)'="":X(5),1:X(2))

 +6        SET DAS=DA_";70"

 +7       ;DBIA 4114

 +8        KILL ^PXRMINDX(45,"ICD9","INP",X(4),NODE,X(1),DATE,DAS)

 +9        KILL ^PXRMINDX(45,"ICD9","PNI",X(1),NODE,X(4),DATE,DAS)

 +10       QUIT 

 +11      ;

 +12      ;===============================================================

KDGPT9M(X,DA,NODE) ;Delete index for PTF movement ICD9 data.

 +1       ;Census records are not indexed.

 +2        IF $PIECE(^DGPT(DA(1),0),U,11)=2

               QUIT 

 +3        NEW DAS,DFN,TEMP

 +4        SET TEMP=^DGPT(DA(1),0)

 +5        SET DFN=$PIECE(TEMP,U,1)

 +6        SET DAS=DA(1)_";M;"_DA

 +7       ;DBIA 4114

 +8        KILL ^PXRMINDX(45,"ICD9","INP",X(2),NODE,DFN,X(1),DAS)

 +9        KILL ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,X(2),X(1),DAS)

 +10       QUIT 

 +11      ;

 +12      ;===============================================================

SDGPT0(X,DA,NODE,NUM) ;Set index for PTF ICD0 data.

 +1       ;For node 401 surgery node:

 +2       ;X(1)=SURGERY/PROCEDURE DATE, X(2)=ICD0

 +3       ;X(2) nodes: 45.01,8; 45.01,9; 45.01,10; 45.01,11; 45.01,12

 +4       ;For node 601, procedure node:

 +5       ;X(1)=PROCEDURE DATE, X(2)=ICD0

 +6       ;X(2) source nodes: 45.05,4; 45.05,5; 45.05,6; 45.05,7; 45.05,8

 +7       ;Census records are not indexed.

 +8        IF $PIECE(^DGPT(DA(1),0),U,11)=2

               QUIT 

 +9        NEW DAS,DFN,NNAME

 +10       SET DFN=$PIECE(^DGPT(DA(1),0),U,1)

 +11       SET NNAME=NODE_NUM

 +12       SET DAS=DA(1)_";"_NODE_";"_DA_";0"

 +13      ;DBIA 4114

 +14       SET ^PXRMINDX(45,"ICD0","INP",X(2),NNAME,DFN,X(1),DAS)=""

 +15       SET ^PXRMINDX(45,"ICD0","PNI",DFN,NNAME,X(2),X(1),DAS)=""

 +16       QUIT 

 +17      ;

 +18      ;===============================================================

SDGPT9D(X,DA,NODE) ;Set index for PTF discharge ICD9 data.

 +1       ;X(1)=DFN, X(2)=ADMISSION DATE, X(3)=TYPE OF RECORD, X(4)=ICD9,

 +2       ;X(5)=DISCHARGE DATE

 +3       ;ICD9 from nodes: 45,79; 45,80; 45,79.16 45,79.17; 45,79.18;

 +4       ;45,79.19; 45,79.20; 45,79.21; 45,79.22; 45,79.22; 45.79.23;

 +5       ;45.79.24.

 +6       ;By name these nodes are: DXLS, PRINCIPAL DIAGNOSIS, SECONDARY

 +7       ;DIAGNOSIS 1 through SECONDARY DIAGNOSIS 13.

 +8       ;Census records are not indexed.

 +9        IF X(3)=2

               QUIT 

 +10       NEW DAS,DATE

 +11      ;If there is no discharge date use the admission date.

 +12       SET DATE=$SELECT(X(5)'="":X(5),1:X(2))

 +13       SET DAS=DA_";70"

 +14      ;DBIA 4114

 +15       SET ^PXRMINDX(45,"ICD9","INP",X(4),NODE,X(1),DATE,DAS)=""

 +16       SET ^PXRMINDX(45,"ICD9","PNI",X(1),NODE,X(4),DATE,DAS)=""

 +17       QUIT 

 +18      ;

 +19      ;===============================================================

SDGPT9M(X,DA,NODE) ;Set index for PTF movement ICD9 data.

 +1       ;X(1)=MOVEMENT DATE, X(3)=TYPE OF RECORD, X(3)=ICD9

 +2       ;ICD9 from nodes: 45.02,5 45.02,6, 45.02,7 45.02,8 45.02,9

 +3       ;45.02,11 45.02,12 45.02,13 45.02,14 45.02,15

 +4       ;By name these nodes are: ICD 1, through ICD 10.

 +5       ;Census records are not indexed.

 +6        IF $PIECE(^DGPT(DA(1),0),U,11)=2

               QUIT 

 +7        NEW DAS,DFN,TEMP

 +8        SET TEMP=^DGPT(DA(1),0)

 +9        SET DFN=$PIECE(TEMP,U,1)

 +10       SET DAS=DA(1)_";M;"_DA

 +11      ;DBIA 4114

 +12       SET ^PXRMINDX(45,"ICD9","INP",X(2),NODE,DFN,X(1),DAS)=""

 +13       SET ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,X(2),X(1),DAS)=""

 +14       QUIT 

 +15      ;