PXRMPDS ; SLC/PKR - Routines for patient data source. ;16-Jun-2015 03:56;du
;;2.0;CLINICAL REMINDERS;**1003,12,26,1005**;Feb 04, 2005;Build 23
;
;====================================
HTEXT ;Taxonomy field Patient Data Source executable help text.
;;Taxonomy matching looks for all codes in the taxonomy. It searches for
;;ICD diagnosis codes in Problem List, PTF, and V POV. It searches for ICD
;;procedure codes in PTF. It searches for CPT-4 procedure codes in V CPT and
;;Radiology. It searches for SNOMED CT codes in Problem List.
;;
;;This comma separated list of patient data sources is used to refine the
;;taxonomy search by specifying exactly which patient data sources are searched.
;;You may use any combination of valid entries. The valid entries are:
;;
;; ALL - all sources
;; EN - All PCE encounter data (CPT-4 & ICD diagnosis)
;; ENPP - PCE encounter data, principal procedure (CPT-4) only
;; ENPD - PCE encounter data primary diagnosis (ICD) only
;; IN - All PTF inpatient data (ICD diagnosis and procedures)
;; INDXLS - PTF inpatient DXLS diagnosis (ICD) only
;; INM - PTF inpatient diagnosis (ICD) movement only
;; INPD - PTF inpatient principal diagnosis (ICD) only
;; INPR - PTF inpatient procedure (ICD) only
;; PL - Problem List (ICD diagnosis and SNOMED CT)
;; RA - Radiology (CPT-4 procedures) only
;;
;;You may also use a minus sign to remove a particular source from the list.
;;For example: IN,-INM would search for all inpatient diagnoses, except those
;;associated with a movement, and all inpatient procedures.
;;
;;The default is ALL, search all sources for all codes in the taxonomy.
;;
;;**End Text**
Q
;
;====================================
PDSXHELP ;Taxonomy field Patient Data Source executable help.
N DONE,DIR0,IND,TEXT
S DONE=0
F IND=1:1 Q:DONE D
. S TEXT(IND)=$P($T(HTEXT+IND),";",3)
. I TEXT(IND)="**End Text**" K TEXT(IND) S DONE=1 Q
D BROWSE^DDBR("TEXT","NR","Patient Data Source Help")
I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
Q
;
;====================================
SPDS(DA,X2) ;Build the patient data source list.
;Called from cross-reference on Patient Data Source.
;X2 is the new value for PDS.
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q
N IND,NNODES,NODE,NSOURCE,PDS,PDSL,PDSTMP
N ALL,EN,ENPP,ENPD,IN,INDXLS,INM,INPDX,INPR,PL,RA
;Build the list of patient data sources.
S NSOURCE=$L(X2,",")
F IND=1:1:NSOURCE D
. S PDS=$P(X2,",",IND)
. I PDS'="" S PDSL(PDS)=""
S ALL=$S($D(PDSL("ALL")):1,X2="":1,1:0)
S EN=$S($D(PDSL("-EN")):0,$D(PDSL("EN")):1,ALL:1,1:0)
S ENPD=$S($D(PDSL("-ENPD")):0,$D(PDSL("ENPD")):1,EN:1,1:0)
S ENPP=$S($D(PDSL("-ENPP")):0,$D(PDSL("ENPP")):1,EN:1,1:0)
S IN=$S($D(PDSL("-IN")):0,$D(PDSL("IN")):1,ALL:1,1:0)
S INDXLS=$S($D(PDSL("-INDXLS")):0,$D(PDSL("INDXLS")):1,IN:1,1:0)
S INM=$S($D(PDSL("-INM")):0,$D(PDSL("INM")):1,IN:1,1:0)
S INPDX=$S($D(PDSL("-INPDX")):0,$D(PDSL("INPDX")):1,IN:1,1:0)
S INPR=$S($D(PDSL("-INPR")):0,$D(PDSL("INPR")):1,IN:1,1:0)
S PL=$S($D(PDSL("-PL")):0,$D(PDSL("PL")):1,ALL:1,1:0)
S RA=$S($D(PDSL("-RA")):0,$D(PDSL("RA")):1,ALL:1,1:0)
;PROBLEM LIST
I PL S PDSTMP(9000011,1)=.01,PDSTMP(9000011,"NNODES")=1
E S PDSTMP(9000011,"NNODES")=0
;PTF
S NNODES=0
I IN F NODE=1:1:13 D
. S NNODES=NNODES+1,PDSTMP(45,NNODES)="D SD"_NODE
I INDXLS S NNODES=NNODES+1,PDSTMP(45,NNODES)="DXLS"
I INM F NODE=1:1:10 D
. S NNODES=NNODES+1,PDSTMP(45,NNODES)="M ICD"_NODE
I INPDX S NNODES=NNODES+1,PDSTMP(45,NNODES)="PDX"
I INPR D
. F NODE=1:1:5 S NNODES=NNODES+1,PDSTMP(45,NNODES)="P"_NODE
. F NODE=1:1:5 S NNODES=NNODES+1,PDSTMP(45,NNODES)="S"_NODE
S PDSTMP(45,"NNODES")=NNODES
;V CPT
S NNODES=0
I EN D
.S NNODES=NNODES+1,PDSTMP(9000010.18,NNODES)="U"
.S NNODES=NNODES+1,PDSTMP(9000010.18,NNODES)="N"
I ENPP S NNODES=NNODES+1,PDSTMP(9000010.18,NNODES)="Y"
S PDSTMP(9000010.18,"NNODES")=NNODES
;V POV
S NNODES=0
I EN D
. S NNODES=NNODES+1,PDSTMP(9000010.07,NNODES)="S"
. S NNODES=NNODES+1,PDSTMP(9000010.07,NNODES)="U"
I ENPD S NNODES=NNODES+1,PDSTMP(9000010.07,NNODES)="P"
S PDSTMP(9000010.07,"NNODES")=NNODES
;V PROCEDURE IHS/MSC/MGH
S NNODES=0
I EN S NNODES=NNODES+1 S PDSTMP(9000010.08,NNODES)="N"
I ENPP S NNODES=NNODES+1 S PDSTMP(9000010.08,NNODES)="Y"
S PDSTMP(9000010.08,"NNODES")=NNODES
;Radiology procedures
S PDSTMP(71,"NNODES")=$S(RA:1,1:0)
K ^PXD(811.2,DA,"APDS")
M ^PXD(811.2,DA,"APDS")=PDSTMP
Q
;
;====================================
VPDS(X) ;Taxonomy field Patient Data Source input transform. Check for valid
;patient data sources.
N IND,NSOURCE,PDS,PDSL,TEXT,VALID
;Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q 1
;Do not execute as part of exchange.
I $G(PXRMEXCH) Q 1
S VALID=1
S NSOURCE=$L(X,",")
F IND=1:1:NSOURCE D
. S PDS=$P(X,",",IND),PDSL(PDS)=""
.;Check for valid source abbreviations.
. I PDS="ALL" Q
. I (PDS="EN")!(PDS="-EN") Q
. I (PDS="ENPD")!(PDS="-ENPD") Q
. I (PDS="ENPP")!(PDS="-ENPP") Q
. I (PDS="IN")!(PDS="-IN") Q
. I (PDS="INDXLS")!(PDS="-INDXLS") Q
. I (PDS="INM")!(PDS="-INM") Q
. I (PDS="INPD")!(PDS="-INPD") Q
. I (PDS="INPR")!(PDS="-INPR") Q
. I (PDS="PL")!(PDS="-PL") Q
. I (PDS="RA")!(PDS="-RA") Q
. S VALID=0
. S TEXT=PDS_" is not a valid Patient Data Source"
. D EN^DDIOL(TEXT)
;Check for invalid combinations.
I $D(PDSL("EN")),$D(PDSL("-EN")) S TEXT="EN and -EN is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("ENPD")),$D(PDSL("-ENPD")) S TEXT="ENPD and -ENPD is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("ENPP")),$D(PDSL("-ENPP")) S TEXT="ENPP and -ENPP is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("IN")),$D(PDSL("-IN")) S TEXT="IN and -IN is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("INDXLS")),$D(PDSL("-INDXLS")) S TEXT="INDXLS and -INDXLS is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("INM")),$D(PDSL("-INM")) S TEXT="INM and -INM is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("INPD")),$D(PDSL("-INPD")) S TEXT="INPD and -INPD is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("INPR")),$D(PDSL("-INPR")) S TEXT="INPR and -INPR is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("PL")),$D(PDSL("-PL")) S TEXT="PL and -PL is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
I $D(PDSL("RA")),$D(PDSL("-RA")) S TEXT="RA and -RA is an invalid combination",VALID=0 D EN^DDIOL(TEXT)
Q VALID
;
PXRMPDS ; SLC/PKR - Routines for patient data source. ;16-Jun-2015 03:56;du
+1 ;;2.0;CLINICAL REMINDERS;**1003,12,26,1005**;Feb 04, 2005;Build 23
+2 ;
+3 ;====================================
HTEXT ;Taxonomy field Patient Data Source executable help text.
+1 ;;Taxonomy matching looks for all codes in the taxonomy. It searches for
+2 ;;ICD diagnosis codes in Problem List, PTF, and V POV. It searches for ICD
+3 ;;procedure codes in PTF. It searches for CPT-4 procedure codes in V CPT and
+4 ;;Radiology. It searches for SNOMED CT codes in Problem List.
+5 ;;
+6 ;;This comma separated list of patient data sources is used to refine the
+7 ;;taxonomy search by specifying exactly which patient data sources are searched.
+8 ;;You may use any combination of valid entries. The valid entries are:
+9 ;;
+10 ;; ALL - all sources
+11 ;; EN - All PCE encounter data (CPT-4 & ICD diagnosis)
+12 ;; ENPP - PCE encounter data, principal procedure (CPT-4) only
+13 ;; ENPD - PCE encounter data primary diagnosis (ICD) only
+14 ;; IN - All PTF inpatient data (ICD diagnosis and procedures)
+15 ;; INDXLS - PTF inpatient DXLS diagnosis (ICD) only
+16 ;; INM - PTF inpatient diagnosis (ICD) movement only
+17 ;; INPD - PTF inpatient principal diagnosis (ICD) only
+18 ;; INPR - PTF inpatient procedure (ICD) only
+19 ;; PL - Problem List (ICD diagnosis and SNOMED CT)
+20 ;; RA - Radiology (CPT-4 procedures) only
+21 ;;
+22 ;;You may also use a minus sign to remove a particular source from the list.
+23 ;;For example: IN,-INM would search for all inpatient diagnoses, except those
+24 ;;associated with a movement, and all inpatient procedures.
+25 ;;
+26 ;;The default is ALL, search all sources for all codes in the taxonomy.
+27 ;;
+28 ;;**End Text**
+29 QUIT
+30 ;
+31 ;====================================
PDSXHELP ;Taxonomy field Patient Data Source executable help.
+1 NEW DONE,DIR0,IND,TEXT
+2 SET DONE=0
+3 FOR IND=1:1
IF DONE
QUIT
Begin DoDot:1
+4 SET TEXT(IND)=$PIECE($TEXT(HTEXT+IND),";",3)
+5 IF TEXT(IND)="**End Text**"
KILL TEXT(IND)
SET DONE=1
QUIT
End DoDot:1
+6 DO BROWSE^DDBR("TEXT","NR","Patient Data Source Help")
+7 IF $DATA(DDS)
DO REFRESH^DDSUTL
SET DY=IOSL-7
SET DX=0
XECUTE IOXY
SET $Y=DY
SET $X=DX
+8 QUIT
+9 ;
+10 ;====================================
SPDS(DA,X2) ;Build the patient data source list.
+1 ;Called from cross-reference on Patient Data Source.
+2 ;X2 is the new value for PDS.
+3 ;Do not execute as part of a verify fields.
+4 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT
+5 NEW IND,NNODES,NODE,NSOURCE,PDS,PDSL,PDSTMP
+6 NEW ALL,EN,ENPP,ENPD,IN,INDXLS,INM,INPDX,INPR,PL,RA
+7 ;Build the list of patient data sources.
+8 SET NSOURCE=$LENGTH(X2,",")
+9 FOR IND=1:1:NSOURCE
Begin DoDot:1
+10 SET PDS=$PIECE(X2,",",IND)
+11 IF PDS'=""
SET PDSL(PDS)=""
End DoDot:1
+12 SET ALL=$SELECT($DATA(PDSL("ALL")):1,X2="":1,1:0)
+13 SET EN=$SELECT($DATA(PDSL("-EN")):0,$DATA(PDSL("EN")):1,ALL:1,1:0)
+14 SET ENPD=$SELECT($DATA(PDSL("-ENPD")):0,$DATA(PDSL("ENPD")):1,EN:1,1:0)
+15 SET ENPP=$SELECT($DATA(PDSL("-ENPP")):0,$DATA(PDSL("ENPP")):1,EN:1,1:0)
+16 SET IN=$SELECT($DATA(PDSL("-IN")):0,$DATA(PDSL("IN")):1,ALL:1,1:0)
+17 SET INDXLS=$SELECT($DATA(PDSL("-INDXLS")):0,$DATA(PDSL("INDXLS")):1,IN:1,1:0)
+18 SET INM=$SELECT($DATA(PDSL("-INM")):0,$DATA(PDSL("INM")):1,IN:1,1:0)
+19 SET INPDX=$SELECT($DATA(PDSL("-INPDX")):0,$DATA(PDSL("INPDX")):1,IN:1,1:0)
+20 SET INPR=$SELECT($DATA(PDSL("-INPR")):0,$DATA(PDSL("INPR")):1,IN:1,1:0)
+21 SET PL=$SELECT($DATA(PDSL("-PL")):0,$DATA(PDSL("PL")):1,ALL:1,1:0)
+22 SET RA=$SELECT($DATA(PDSL("-RA")):0,$DATA(PDSL("RA")):1,ALL:1,1:0)
+23 ;PROBLEM LIST
+24 IF PL
SET PDSTMP(9000011,1)=.01
SET PDSTMP(9000011,"NNODES")=1
+25 IF '$TEST
SET PDSTMP(9000011,"NNODES")=0
+26 ;PTF
+27 SET NNODES=0
+28 IF IN
FOR NODE=1:1:13
Begin DoDot:1
+29 SET NNODES=NNODES+1
SET PDSTMP(45,NNODES)="D SD"_NODE
End DoDot:1
+30 IF INDXLS
SET NNODES=NNODES+1
SET PDSTMP(45,NNODES)="DXLS"
+31 IF INM
FOR NODE=1:1:10
Begin DoDot:1
+32 SET NNODES=NNODES+1
SET PDSTMP(45,NNODES)="M ICD"_NODE
End DoDot:1
+33 IF INPDX
SET NNODES=NNODES+1
SET PDSTMP(45,NNODES)="PDX"
+34 IF INPR
Begin DoDot:1
+35 FOR NODE=1:1:5
SET NNODES=NNODES+1
SET PDSTMP(45,NNODES)="P"_NODE
+36 FOR NODE=1:1:5
SET NNODES=NNODES+1
SET PDSTMP(45,NNODES)="S"_NODE
End DoDot:1
+37 SET PDSTMP(45,"NNODES")=NNODES
+38 ;V CPT
+39 SET NNODES=0
+40 IF EN
Begin DoDot:1
+41 SET NNODES=NNODES+1
SET PDSTMP(9000010.18,NNODES)="U"
+42 SET NNODES=NNODES+1
SET PDSTMP(9000010.18,NNODES)="N"
End DoDot:1
+43 IF ENPP
SET NNODES=NNODES+1
SET PDSTMP(9000010.18,NNODES)="Y"
+44 SET PDSTMP(9000010.18,"NNODES")=NNODES
+45 ;V POV
+46 SET NNODES=0
+47 IF EN
Begin DoDot:1
+48 SET NNODES=NNODES+1
SET PDSTMP(9000010.07,NNODES)="S"
+49 SET NNODES=NNODES+1
SET PDSTMP(9000010.07,NNODES)="U"
End DoDot:1
+50 IF ENPD
SET NNODES=NNODES+1
SET PDSTMP(9000010.07,NNODES)="P"
+51 SET PDSTMP(9000010.07,"NNODES")=NNODES
+52 ;V PROCEDURE IHS/MSC/MGH
+53 SET NNODES=0
+54 IF EN
SET NNODES=NNODES+1
SET PDSTMP(9000010.08,NNODES)="N"
+55 IF ENPP
SET NNODES=NNODES+1
SET PDSTMP(9000010.08,NNODES)="Y"
+56 SET PDSTMP(9000010.08,"NNODES")=NNODES
+57 ;Radiology procedures
+58 SET PDSTMP(71,"NNODES")=$SELECT(RA:1,1:0)
+59 KILL ^PXD(811.2,DA,"APDS")
+60 MERGE ^PXD(811.2,DA,"APDS")=PDSTMP
+61 QUIT
+62 ;
+63 ;====================================
VPDS(X) ;Taxonomy field Patient Data Source input transform. Check for valid
+1 ;patient data sources.
+2 NEW IND,NSOURCE,PDS,PDSL,TEXT,VALID
+3 ;Do not execute as part of a verify fields.
+4 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT 1
+5 ;Do not execute as part of exchange.
+6 IF $GET(PXRMEXCH)
QUIT 1
+7 SET VALID=1
+8 SET NSOURCE=$LENGTH(X,",")
+9 FOR IND=1:1:NSOURCE
Begin DoDot:1
+10 SET PDS=$PIECE(X,",",IND)
SET PDSL(PDS)=""
+11 ;Check for valid source abbreviations.
+12 IF PDS="ALL"
QUIT
+13 IF (PDS="EN")!(PDS="-EN")
QUIT
+14 IF (PDS="ENPD")!(PDS="-ENPD")
QUIT
+15 IF (PDS="ENPP")!(PDS="-ENPP")
QUIT
+16 IF (PDS="IN")!(PDS="-IN")
QUIT
+17 IF (PDS="INDXLS")!(PDS="-INDXLS")
QUIT
+18 IF (PDS="INM")!(PDS="-INM")
QUIT
+19 IF (PDS="INPD")!(PDS="-INPD")
QUIT
+20 IF (PDS="INPR")!(PDS="-INPR")
QUIT
+21 IF (PDS="PL")!(PDS="-PL")
QUIT
+22 IF (PDS="RA")!(PDS="-RA")
QUIT
+23 SET VALID=0
+24 SET TEXT=PDS_" is not a valid Patient Data Source"
+25 DO EN^DDIOL(TEXT)
End DoDot:1
+26 ;Check for invalid combinations.
+27 IF $DATA(PDSL("EN"))
IF $DATA(PDSL("-EN"))
SET TEXT="EN and -EN is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+28 IF $DATA(PDSL("ENPD"))
IF $DATA(PDSL("-ENPD"))
SET TEXT="ENPD and -ENPD is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+29 IF $DATA(PDSL("ENPP"))
IF $DATA(PDSL("-ENPP"))
SET TEXT="ENPP and -ENPP is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+30 IF $DATA(PDSL("IN"))
IF $DATA(PDSL("-IN"))
SET TEXT="IN and -IN is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+31 IF $DATA(PDSL("INDXLS"))
IF $DATA(PDSL("-INDXLS"))
SET TEXT="INDXLS and -INDXLS is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+32 IF $DATA(PDSL("INM"))
IF $DATA(PDSL("-INM"))
SET TEXT="INM and -INM is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+33 IF $DATA(PDSL("INPD"))
IF $DATA(PDSL("-INPD"))
SET TEXT="INPD and -INPD is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+34 IF $DATA(PDSL("INPR"))
IF $DATA(PDSL("-INPR"))
SET TEXT="INPR and -INPR is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+35 IF $DATA(PDSL("PL"))
IF $DATA(PDSL("-PL"))
SET TEXT="PL and -PL is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+36 IF $DATA(PDSL("RA"))
IF $DATA(PDSL("-RA"))
SET TEXT="RA and -RA is an invalid combination"
SET VALID=0
DO EN^DDIOL(TEXT)
+37 QUIT VALID
+38 ;
