PXRMPDS ; SLC/PKR - Routines for patient data source. ;08/16/2017
 ;;2.0;CLINICAL REMINDERS;**12,26,42**;Feb 04, 2005;Build 245
 ;
 ;====================================
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 (V CPT, V POV, and V Standard Codes)
 ;;  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 S NNODES=NNODES+1,PDSTMP(9000010.18,NNODES)="U"
 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 Standard Codes
 I EN S PDSTMP(9000010.71,"NNODES")=1
 E  S PDSTMP(9000010.71,"NNODES")=0
 ;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
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPDS   6468     printed  Sep 23, 2025@19:24:30                                                                                                                                                                                                     Page 2
PXRMPDS   ; SLC/PKR - Routines for patient data source. ;08/16/2017
 +1       ;;2.0;CLINICAL REMINDERS;**12,26,42**;Feb 04, 2005;Build 245
 +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 (V CPT, V POV, and V Standard Codes)
 +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
               SET NNODES=NNODES+1
               SET PDSTMP(9000010.18,NNODES)="U"
 +41       IF ENPP
               SET NNODES=NNODES+1
               SET PDSTMP(9000010.18,NNODES)="Y"
 +42       SET PDSTMP(9000010.18,"NNODES")=NNODES
 +43      ;V POV
 +44       SET NNODES=0
 +45       IF EN
               Begin DoDot:1
 +46               SET NNODES=NNODES+1
                   SET PDSTMP(9000010.07,NNODES)="S"
 +47               SET NNODES=NNODES+1
                   SET PDSTMP(9000010.07,NNODES)="U"
               End DoDot:1
 +48       IF ENPD
               SET NNODES=NNODES+1
               SET PDSTMP(9000010.07,NNODES)="P"
 +49       SET PDSTMP(9000010.07,"NNODES")=NNODES
 +50      ;V Standard Codes
 +51       IF EN
               SET PDSTMP(9000010.71,"NNODES")=1
 +52      IF '$TEST
               SET PDSTMP(9000010.71,"NNODES")=0
 +53      ;Radiology procedures
 +54       SET PDSTMP(71,"NNODES")=$SELECT(RA:1,1:0)
 +55       KILL ^PXD(811.2,DA,"APDS")
 +56       MERGE ^PXD(811.2,DA,"APDS")=PDSTMP
 +57       QUIT 
 +58      ;
 +59      ;====================================
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      ;