- 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 ;