Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTDDCR

DGPTDDCR.m

Go to the documentation of this file.
  1. 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
  1. ;===========================================================
  1. INDEX ;Build the indexes for PTF.
  1. N D1,DA,DAS,DATE,DFN,DIFF,END,ENTRIES,ETEXT,GLOBAL,HASCODES
  1. N ICD0,ICD9,IND,JND,KND,NE0,NE9,NERROR,NODE,START
  1. N TEMP0,TEMP70,TEMP71,TEMPP,TEMPS,TENP,TEXT,VISIT
  1. ;DBIA 4114
  1. ;Don't leave any old stuff around.
  1. K ^PXRMINDX(45)
  1. S GLOBAL=$$GET1^DID(45,"","","GLOBAL NAME")
  1. S ENTRIES=$P(^DGPT(0),U,4)
  1. S TENP=ENTRIES/10
  1. S TENP=+$P(TENP,".",1)
  1. I TENP<1 S TENP=1
  1. D BMES^XPDUTL("Building indexes for DGPT")
  1. S TEXT="There are "_ENTRIES_" entries to process."
  1. D MES^XPDUTL(TEXT)
  1. S START=$H
  1. S (DA,IND,NE0,NE9,NERROR)=0
  1. F S DA=+$O(^DGPT(DA)) Q:DA=0 D
  1. . S IND=IND+1
  1. . I IND#TENP=0 D
  1. .. S TEXT="Processing entry "_IND
  1. .. D MES^XPDUTL(TEXT)
  1. . I IND#10000=0 W "."
  1. . S TEMP0=$G(^DGPT(DA,0))
  1. .;Cenus records are not indexed.
  1. . I $P(TEMP0,U,11)=2 Q
  1. . S DFN=$P(TEMP0,U,1)
  1. . I DFN="" D Q
  1. .. S ETEXT=DA_" no patient"
  1. .. D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. . S D1=0
  1. . F S D1=+$O(^DGPT(DA,"S",D1)) Q:D1=0 D
  1. .. S TEMPS=$G(^DGPT(DA,"S",D1,0))
  1. .. S DATE=$P(TEMPS,U,1)
  1. .. I DATE="" D Q
  1. ... S ETEXT=DA_" S node missing date"
  1. ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
  1. .. S DAS=DA_";S;"_D1_";0"
  1. .. S KND=0
  1. .. F JND=8,9,10,11,12 D
  1. ... S KND=KND+1
  1. ... S NODE="S"_KND
  1. ... S ICD0=$P(TEMPS,U,JND)
  1. ... I (ICD0'="") D
  1. .... I $D(^ICD0(ICD0)) D
  1. ..... S NE0=NE0+1
  1. ..... S ^PXRMINDX(45,"ICD0","INP",ICD0,NODE,DFN,DATE,DAS)=""
  1. ..... S ^PXRMINDX(45,"ICD0","PNI",DFN,NODE,ICD0,DATE,DAS)=""
  1. .... E D
  1. ..... S ETEXT=DAS_" node "_NODE_" invalid ICD0"
  1. ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. .;
  1. . S D1=0
  1. . F S D1=+$O(^DGPT(DA,"P",D1)) Q:D1=0 D
  1. .. S TEMPP=$G(^DGPT(DA,"P",D1,0))
  1. .. S DATE=$P(TEMPP,U,1)
  1. .. I DATE="" D Q
  1. ... S ETEXT=DA_" P node missing date"
  1. ... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR) Q
  1. .. S DAS=DA_";P;"_D1_";0"
  1. .. S KND=0
  1. .. F JND=5,6,7,8,9 D
  1. ... S KND=KND+1
  1. ... S NODE="P"_KND
  1. ... S ICD0=$P(TEMPP,U,JND)
  1. ... I (ICD0'="") D
  1. .... I $D(^ICD0(ICD0)) D
  1. ..... S NE0=NE0+1
  1. ..... S ^PXRMINDX(45,"ICD0","INP",ICD0,NODE,DFN,DATE,DAS)=""
  1. ..... S ^PXRMINDX(45,"ICD0","PNI",DFN,NODE,ICD0,DATE,DAS)=""
  1. .... E D
  1. ..... S ETEXT=DAS_" "_NODE_" invalid ICD0"
  1. ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. .;
  1. .;Discharge ICD9 codes
  1. . I $D(^DGPT(DA,70)) D
  1. .. S TEMP70=$G(^DGPT(DA,70))
  1. .. S TEMP71=$G(^DGPT(DA,71))
  1. .. S DATE=$P(TEMP70,U,1)
  1. .. I DATE="" S DATE=$P(TEMP0,U,2)
  1. .. S DAS=DA_";70"
  1. .. S ICD9=$P(TEMP70,U,10)
  1. .. I (ICD9'="") D
  1. ... I $D(^ICD9(ICD9)) D
  1. .... S NE9=NE9+1
  1. .... S ^PXRMINDX(45,"ICD9","INP",ICD9,"DXLS",DFN,DATE,DAS)=""
  1. .... S ^PXRMINDX(45,"ICD9","PNI",DFN,"DXLS",ICD9,DATE,DAS)=""
  1. ... E D
  1. .... S ETEXT=DAS_" DXLS invalid ICD9"
  1. .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. ..;
  1. .. S ICD9=$P(TEMP70,U,11)
  1. .. I (ICD9'="") D
  1. ... I $D(^ICD9(ICD9)) D
  1. .... S NE9=NE9+1
  1. .... S ^PXRMINDX(45,"ICD9","INP",ICD9,"PDX",DFN,DATE,DAS)=""
  1. .... S ^PXRMINDX(45,"ICD9","PNI",DFN,"PDX",ICD9,DATE,DAS)=""
  1. ... E D
  1. .... S ETEXT=DAS_" PDX invalid ICD9"
  1. .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. ..;
  1. .. S KND=0
  1. .. F JND=16,17,18,19,20,21,22,23,24 D
  1. ... S KND=KND+1
  1. ... S NODE="D SD"_KND
  1. ... S ICD9=$P(TEMP70,U,JND)
  1. ... I (ICD9'="") D
  1. .... I $D(^ICD9(ICD9)) D
  1. ..... S NE9=NE9+1
  1. ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""
  1. ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""
  1. .... E D
  1. ..... S ETEXT=DAS_" node "_NODE_" invalid ICD9"
  1. ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. ..;
  1. .. S KND=9
  1. .. F JND=1,2,3,4 D
  1. ... S KND=KND+1
  1. ... S NODE="D SD"_KND
  1. ... S ICD9=$P(TEMP71,U,JND)
  1. ... I (ICD9'="") D
  1. .... I $D(^ICD9(ICD9)) D
  1. ..... S NE9=NE9+1
  1. ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""
  1. ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""
  1. .... E D
  1. ..... S ETEXT=DAS_" node "_NODE_" invalid ICD9"
  1. ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. ..;
  1. .;Movement ICD9 codes
  1. . I '$D(^DGPT(DA,"M")) Q
  1. . S D1=0
  1. . F S D1=$O(^DGPT(DA,"M",D1)) Q:+D1=0 D
  1. .. S TEMPS=$G(^DGPT(DA,"M",D1,0))
  1. .. S DATE=$P(TEMPS,U,10)
  1. .. I DATE="" D Q
  1. ... S HASCODES=0
  1. ... F JND=5,6,7,8,9,11,12,13,14,15 D
  1. .... S ICD9=$P(TEMPS,U,JND)
  1. .... I ICD9'="" S HASCODES=1
  1. ... I HASCODES D
  1. .... S ETEXT=DA_";M;"_D1_";0"_" M node missing date"
  1. .... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. .. S DAS=DA_";M;"_D1
  1. .. S KND=0
  1. .. F JND=5,6,7,8,9,11,12,13,14,15 D
  1. ... S KND=KND+1
  1. ... S NODE="M ICD"_KND
  1. ... S ICD9=$P(TEMPS,U,JND)
  1. ... I (ICD9'="") D
  1. .... I $D(^ICD9(ICD9)) D
  1. ..... S NE9=NE9+1
  1. ..... S ^PXRMINDX(45,"ICD9","INP",ICD9,NODE,DFN,DATE,DAS)=""
  1. ..... S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,ICD9,DATE,DAS)=""
  1. .... E D
  1. ..... S ETEXT=DAS_" M node invalid ICD9"
  1. ..... D ADDERROR^PXRMSXRM(GLOBAL,ETEXT,.NERROR)
  1. .;
  1. S END=$H
  1. S TEXT=NE0_" PTF ICD0 results indexed."
  1. D MES^XPDUTL(TEXT)
  1. S TEXT=NE9_" PTF ICD9 results indexed."
  1. D MES^XPDUTL(TEXT)
  1. D DETIME^PXRMSXRM(START,END)
  1. ;If there were errors send a message.
  1. I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL)
  1. ;Send a MailMan message with the results.
  1. D COMMSG^PXRMSXRM(GLOBAL,START,END,(NE0+NE9),NERROR)
  1. S ^PXRMINDX(45,"GLOBAL NAME")=GLOBAL
  1. S ^PXRMINDX(45,"BUILT BY")=DUZ
  1. S ^PXRMINDX(45,"DATE BUILT")=$$NOW^XLFDT
  1. Q
  1. ;
  1. ;===============================================================
  1. KDGPT0(X,DA,NODE,NUM) ;Delete index for PTF ICD0 data.
  1. ;Census records are not indexed.
  1. I $P(^DGPT(DA(1),0),U,11)=2 Q
  1. N DAS,DFN,NNAME
  1. S DFN=$P(^DGPT(DA(1),0),U,1)
  1. S NNAME=NODE_NUM
  1. S DAS=DA(1)_";"_NODE_";"_DA_";0"
  1. ;DBIA 4114
  1. K ^PXRMINDX(45,"ICD0","INP",X(2),NNAME,DFN,X(1),DAS)
  1. K ^PXRMINDX(45,"ICD0","PNI",DFN,NNAME,X(2),X(1),DAS)
  1. Q
  1. ;
  1. ;===============================================================
  1. KDGPT9D(X,DA,NODE) ;Delete index for PTF discharge ICD9 data.
  1. N DAS,DATE
  1. ;Census records are not indexed.
  1. I X(3)=2 Q
  1. ;If there is no discharge date use the admission date.
  1. S DATE=$S(X(5)'="":X(5),1:X(2))
  1. S DAS=DA_";70"
  1. ;DBIA 4114
  1. K ^PXRMINDX(45,"ICD9","INP",X(4),NODE,X(1),DATE,DAS)
  1. K ^PXRMINDX(45,"ICD9","PNI",X(1),NODE,X(4),DATE,DAS)
  1. Q
  1. ;
  1. ;===============================================================
  1. KDGPT9M(X,DA,NODE) ;Delete index for PTF movement ICD9 data.
  1. ;Census records are not indexed.
  1. I $P(^DGPT(DA(1),0),U,11)=2 Q
  1. N DAS,DFN,TEMP
  1. S TEMP=^DGPT(DA(1),0)
  1. S DFN=$P(TEMP,U,1)
  1. S DAS=DA(1)_";M;"_DA
  1. ;DBIA 4114
  1. K ^PXRMINDX(45,"ICD9","INP",X(2),NODE,DFN,X(1),DAS)
  1. K ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,X(2),X(1),DAS)
  1. Q
  1. ;
  1. ;===============================================================
  1. SDGPT0(X,DA,NODE,NUM) ;Set index for PTF ICD0 data.
  1. ;For node 401 surgery node:
  1. ;X(1)=SURGERY/PROCEDURE DATE, X(2)=ICD0
  1. ;X(2) nodes: 45.01,8; 45.01,9; 45.01,10; 45.01,11; 45.01,12
  1. ;For node 601, procedure node:
  1. ;X(1)=PROCEDURE DATE, X(2)=ICD0
  1. ;X(2) source nodes: 45.05,4; 45.05,5; 45.05,6; 45.05,7; 45.05,8
  1. ;Census records are not indexed.
  1. I $P(^DGPT(DA(1),0),U,11)=2 Q
  1. N DAS,DFN,NNAME
  1. S DFN=$P(^DGPT(DA(1),0),U,1)
  1. S NNAME=NODE_NUM
  1. S DAS=DA(1)_";"_NODE_";"_DA_";0"
  1. ;DBIA 4114
  1. S ^PXRMINDX(45,"ICD0","INP",X(2),NNAME,DFN,X(1),DAS)=""
  1. S ^PXRMINDX(45,"ICD0","PNI",DFN,NNAME,X(2),X(1),DAS)=""
  1. Q
  1. ;
  1. ;===============================================================
  1. 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,
  1. ;X(5)=DISCHARGE DATE
  1. ;ICD9 from nodes: 45,79; 45,80; 45,79.16 45,79.17; 45,79.18;
  1. ;45,79.19; 45,79.20; 45,79.21; 45,79.22; 45,79.22; 45.79.23;
  1. ;45.79.24.
  1. ;By name these nodes are: DXLS, PRINCIPAL DIAGNOSIS, SECONDARY
  1. ;DIAGNOSIS 1 through SECONDARY DIAGNOSIS 13.
  1. ;Census records are not indexed.
  1. I X(3)=2 Q
  1. N DAS,DATE
  1. ;If there is no discharge date use the admission date.
  1. S DATE=$S(X(5)'="":X(5),1:X(2))
  1. S DAS=DA_";70"
  1. ;DBIA 4114
  1. S ^PXRMINDX(45,"ICD9","INP",X(4),NODE,X(1),DATE,DAS)=""
  1. S ^PXRMINDX(45,"ICD9","PNI",X(1),NODE,X(4),DATE,DAS)=""
  1. Q
  1. ;
  1. ;===============================================================
  1. SDGPT9M(X,DA,NODE) ;Set index for PTF movement ICD9 data.
  1. ;X(1)=MOVEMENT DATE, X(3)=TYPE OF RECORD, X(3)=ICD9
  1. ;ICD9 from nodes: 45.02,5 45.02,6, 45.02,7 45.02,8 45.02,9
  1. ;45.02,11 45.02,12 45.02,13 45.02,14 45.02,15
  1. ;By name these nodes are: ICD 1, through ICD 10.
  1. ;Census records are not indexed.
  1. I $P(^DGPT(DA(1),0),U,11)=2 Q
  1. N DAS,DFN,TEMP
  1. S TEMP=^DGPT(DA(1),0)
  1. S DFN=$P(TEMP,U,1)
  1. S DAS=DA(1)_";M;"_DA
  1. ;DBIA 4114
  1. S ^PXRMINDX(45,"ICD9","INP",X(2),NODE,DFN,X(1),DAS)=""
  1. S ^PXRMINDX(45,"ICD9","PNI",DFN,NODE,X(2),X(1),DAS)=""
  1. Q
  1. ;