PXRMEXU0 ;SLC/PKR - Reminder exchange general utilities, #0. ;08/05/2013
;;2.0;CLINICAL REMINDERS;**4,12,18,26**;Feb 04, 2005;Build 404
;====================================
CFOKTI(IEN,START,STOP) ;Check a computed finding to see if it can be
;installed. Called from IOKTI^PXRMEXFI.
N INDICES,LN,OK,TEMP
S OK=1
F LN=STOP:-1:START D
. S TEMP=^PXD(811.8,IEN,100,LN,0)
. S INDICES=$P(TEMP,"~",1)
. I $P(INDICES,";",1)'=811.4 Q
.;Check for the Class field, if the value is NATIONAL then set OK=0.
. I ($P(INDICES,";",3)=100) S LN=START,OK=$S($P(TEMP,"~",2)="NATIONAL":0,1:1)
Q OK
;
;====================================
LOC(FDA) ;Process the FDA for location lists.
;Direct reads of ^DIC(40.7) covered by DBIA #537.
N AMIS,IEN,IENS,SFN,STOP,TEMP,TEXT
;Stop Codes may not have a unique name, use the AMIS Reporting Stop
;code to determine which one to use.
F SFN=810.9001,810.90011 D
. S IENS=""
. F S IENS=$O(FDA(SFN,IENS)) Q:IENS="" D
.. S STOP=FDA(SFN,IENS,.01)
.. S AMIS=FDA(SFN,IENS,.02)
.. S IEN=$O(^DIC(40.7,"C",AMIS,""))
.. S TEMP=$P(^DIC(40.7,IEN,0),U,1)
.. I TEMP'=STOP D Q
... S TEXT(1)="Name associated with AMIS stop code does not match the one in the"
... S TEXT(2)="packed reminder:"
... S TEXT(3)=" AMIS="_AMIS
... S TEXT(4)=" Site Name="_TEMP
... S TEXT(5)=" Name in packed reminder="_STOP
... D EN^DDIOL(.TEXT)
.. S FDA(SFN,IENS,.01)="`"_IEN
Q
;
;====================================
GETIEN(NFOUND,LIST) ;FIND^DIC has found multiple entries with the same name.
;NFOUND is the number found, LIST is the array returned by FIND^DIC.
;Ask the user which one they want to use.
N DIR,FN,IND,NC,X,Y
S DIR(0)="S^"
F IND=1:1:NFOUND D
. S DIR(0)=DIR(0)_IND_":"_LIST("DILIST",2,IND)_";"
S DIR("L",1)="Select one of the following to use:"
S NC=1
F IND=1:1:NFOUND D
. S NC=NC+1
. S DIR("L",NC)=IND_"- "_LIST("DILIST",1,IND)_" IEN="_LIST("DILIST",2,IND)
. S FN=$O(LIST("DILIST","ID",IND,""))
. I FN="" Q
. S NC=NC+1
. S DIR("L",NC)=" "_LIST("DILIST","ID",IND,FN)
. F S FN=$O(LIST("DILIST","ID",IND,FN)) Q:FN="" D
.. I $L(LIST("DILIST","ID",IND,FN))=0 Q
.. S NC=NC+1
.. S DIR("L",NC)=" "_LIST("DILIST","ID",IND,FN)
;Truncate DIR("L") as required.
S DIR("L")=DIR("L",NC) K DIR("L",NC)
D ^DIR
I Y="^" D
. N TEXT
. S TEXT(1)="Entering ""^"" tells Reminder Exchange the entry does not exist. You will be"
. S TEXT(2)="ask for a replacement."
. D EN^DDIOL(.TEXT)
Q $S($D(Y(0)):Y(0),1:0)
;
;====================================
ISPCEFIL(FILENUM) ;Return true if FILENUM is a PCE file.
I FILENUM=9999999.09 Q 1 ;EDUCATION TOPICS
I FILENUM=9999999.15 Q 1 ;EXAM
I FILENUM=9999999.64 Q 1 ;HEALTH FACTORS
I FILENUM=9999999.14 Q 1 ;IMMUNIZATION
I FILENUM=9999999.28 Q 1 ;SKIN TEST
I FILENUM=9999999.17 Q 1 ;TREATMENT
Q 0
;
;====================================
SFNFTC(IEN) ;Set the found/not found text line counts in the reminder
;definition.
D SNMLA^PXRMFNFT(IEN)
D SNMLF^PXRMFNFT(IEN,20)
D SNMLF^PXRMFNFT(IEN,25)
D SNMLL^PXRMFNFT(IEN)
Q
;
;====================================
TAX(FDA,NODE) ;Process the FDA for taxonomies. This is for the conversion from
;the pointer based structure to Lexicon based structure.
N CODE,CODEIEN,HIGH,IENS,LOW
K ^TMP($J,NODE)
;ICD codes.
S IENS=""
F S IENS=$O(FDA(811.22102,IENS)) Q:IENS="" D
. S LOW=FDA(811.22102,IENS,.01)
. S HIGH=$G(FDA(811.22102,IENS,1))
. I HIGH="" S HIGH=LOW
. S ^TMP($J,NODE,"ICD",LOW,HIGH)=""
;
;ICP codes.
S IENS=""
F S IENS=$O(FDA(811.22103,IENS)) Q:IENS="" D
. S LOW=FDA(811.22103,IENS,.01)
. S HIGH=$G(FDA(811.22103,IENS,1))
. I HIGH="" S HIGH=LOW
. S ^TMP($J,NODE,"ICP",LOW,HIGH)=""
;
;CPT codes.
S IENS=""
F S IENS=$O(FDA(811.22104,IENS)) Q:IENS="" D
. S LOW=FDA(811.22104,IENS,.01)
. S HIGH=$G(FDA(811.22104,IENS,1))
. I HIGH="" S HIGH=LOW
. S ^TMP($J,NODE,"CPT",LOW,HIGH)=""
;
;Selectable ICD codes.
S IENS=""
F S IENS=$O(FDA(811.23102,IENS)) Q:IENS="" D
. S CODE=FDA(811.23102,IENS,.01)
. S CODE=$TR(CODE," ","")
. S ^TMP($J,NODE,"SDX",CODE)=""
. S CODEIEN=+$$EXISTS^PXRMEXIU(80,CODE,"BX")
. I CODEIEN>0 S FDA(811.23102,IENS,.01)="`"_CODEIEN
;
;Selectable CPT codes.
S IENS=""
F S IENS=$O(FDA(811.23104,IENS)) Q:IENS="" D
. S CODE=FDA(811.23104,IENS,.01)
. S CODE=$TR(CODE," ","")
. S FDA(811.23104,IENS,.01)=CODE
. S ^TMP($J,NODE,"SPR",CODE)=""
;
;If these fields no longer exist in the DD remove them from the FDA.
;ICD9 range of codes.
S LABEL=$$GET1^DIQ(811.2,2103,"","LABEL")
I LABEL="" K ^FDA(811.22102)
;
;ICD0 range of codes.
S LABEL=$$GET1^DID(811.2,2103,"","LABEL")
I LABEL="" K ^FDA(811.22103)
;
;CPT range of codes.
S LABEL=$$GET1^DID(811.2,2104,"","LABEL")
I LABEL="" K ^FDA(811.22104)
;
;Selectable diagnosis.
S LABEL=$$GET1^DID(811.2,3102,"","LABEL")
I LABEL="" K ^FDA(811.23102)
;
;Selectable procedure.
S LABEL=$$GET1^DID(811.2,3104,"","LABEL")
I LABEL="" K ^FDA(811.23104)
Q
;
;====================================
TAX30(IEN) ;Make sure the Use in Dialog Codes multiple is built during
;a Reminder Exchange Install.
I $D(^PXD(811.2,IEN,30)) Q
I '$D(^PXD(811.2,IEN,20,"AUID")) Q
N CODE,CODESYS
S CODESYS=""
F S CODESYS=$O(^PXD(811.2,IEN,20,"AUID",CODESYS)) Q:CODESYS="" D
. S CODE=""
. F S CODE=$O(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE)) Q:CODE="" D
.. D SAVEUIDC^PXRMTAXD(IEN,CODESYS,CODE)
Q
;
PXRMEXU0 ;SLC/PKR - Reminder exchange general utilities, #0. ;08/05/2013
+1 ;;2.0;CLINICAL REMINDERS;**4,12,18,26**;Feb 04, 2005;Build 404
+2 ;====================================
CFOKTI(IEN,START,STOP) ;Check a computed finding to see if it can be
+1 ;installed. Called from IOKTI^PXRMEXFI.
+2 NEW INDICES,LN,OK,TEMP
+3 SET OK=1
+4 FOR LN=STOP:-1:START
Begin DoDot:1
+5 SET TEMP=^PXD(811.8,IEN,100,LN,0)
+6 SET INDICES=$PIECE(TEMP,"~",1)
+7 IF $PIECE(INDICES,";",1)'=811.4
QUIT
+8 ;Check for the Class field, if the value is NATIONAL then set OK=0.
+9 IF ($PIECE(INDICES,";",3)=100)
SET LN=START
SET OK=$SELECT($PIECE(TEMP,"~",2)="NATIONAL":0,1:1)
End DoDot:1
+10 QUIT OK
+11 ;
+12 ;====================================
LOC(FDA) ;Process the FDA for location lists.
+1 ;Direct reads of ^DIC(40.7) covered by DBIA #537.
+2 NEW AMIS,IEN,IENS,SFN,STOP,TEMP,TEXT
+3 ;Stop Codes may not have a unique name, use the AMIS Reporting Stop
+4 ;code to determine which one to use.
+5 FOR SFN=810.9001,810.90011
Begin DoDot:1
+6 SET IENS=""
+7 FOR
SET IENS=$ORDER(FDA(SFN,IENS))
IF IENS=""
QUIT
Begin DoDot:2
+8 SET STOP=FDA(SFN,IENS,.01)
+9 SET AMIS=FDA(SFN,IENS,.02)
+10 SET IEN=$ORDER(^DIC(40.7,"C",AMIS,""))
+11 SET TEMP=$PIECE(^DIC(40.7,IEN,0),U,1)
+12 IF TEMP'=STOP
Begin DoDot:3
+13 SET TEXT(1)="Name associated with AMIS stop code does not match the one in the"
+14 SET TEXT(2)="packed reminder:"
+15 SET TEXT(3)=" AMIS="_AMIS
+16 SET TEXT(4)=" Site Name="_TEMP
+17 SET TEXT(5)=" Name in packed reminder="_STOP
+18 DO EN^DDIOL(.TEXT)
End DoDot:3
QUIT
+19 SET FDA(SFN,IENS,.01)="`"_IEN
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
+22 ;====================================
GETIEN(NFOUND,LIST) ;FIND^DIC has found multiple entries with the same name.
+1 ;NFOUND is the number found, LIST is the array returned by FIND^DIC.
+2 ;Ask the user which one they want to use.
+3 NEW DIR,FN,IND,NC,X,Y
+4 SET DIR(0)="S^"
+5 FOR IND=1:1:NFOUND
Begin DoDot:1
+6 SET DIR(0)=DIR(0)_IND_":"_LIST("DILIST",2,IND)_";"
End DoDot:1
+7 SET DIR("L",1)="Select one of the following to use:"
+8 SET NC=1
+9 FOR IND=1:1:NFOUND
Begin DoDot:1
+10 SET NC=NC+1
+11 SET DIR("L",NC)=IND_"- "_LIST("DILIST",1,IND)_" IEN="_LIST("DILIST",2,IND)
+12 SET FN=$ORDER(LIST("DILIST","ID",IND,""))
+13 IF FN=""
QUIT
+14 SET NC=NC+1
+15 SET DIR("L",NC)=" "_LIST("DILIST","ID",IND,FN)
+16 FOR
SET FN=$ORDER(LIST("DILIST","ID",IND,FN))
IF FN=""
QUIT
Begin DoDot:2
+17 IF $LENGTH(LIST("DILIST","ID",IND,FN))=0
QUIT
+18 SET NC=NC+1
+19 SET DIR("L",NC)=" "_LIST("DILIST","ID",IND,FN)
End DoDot:2
End DoDot:1
+20 ;Truncate DIR("L") as required.
+21 SET DIR("L")=DIR("L",NC)
KILL DIR("L",NC)
+22 DO ^DIR
+23 IF Y="^"
Begin DoDot:1
+24 NEW TEXT
+25 SET TEXT(1)="Entering ""^"" tells Reminder Exchange the entry does not exist. You will be"
+26 SET TEXT(2)="ask for a replacement."
+27 DO EN^DDIOL(.TEXT)
End DoDot:1
+28 QUIT $SELECT($DATA(Y(0)):Y(0),1:0)
+29 ;
+30 ;====================================
ISPCEFIL(FILENUM) ;Return true if FILENUM is a PCE file.
+1 ;EDUCATION TOPICS
IF FILENUM=9999999.09
QUIT 1
+2 ;EXAM
IF FILENUM=9999999.15
QUIT 1
+3 ;HEALTH FACTORS
IF FILENUM=9999999.64
QUIT 1
+4 ;IMMUNIZATION
IF FILENUM=9999999.14
QUIT 1
+5 ;SKIN TEST
IF FILENUM=9999999.28
QUIT 1
+6 ;TREATMENT
IF FILENUM=9999999.17
QUIT 1
+7 QUIT 0
+8 ;
+9 ;====================================
SFNFTC(IEN) ;Set the found/not found text line counts in the reminder
+1 ;definition.
+2 DO SNMLA^PXRMFNFT(IEN)
+3 DO SNMLF^PXRMFNFT(IEN,20)
+4 DO SNMLF^PXRMFNFT(IEN,25)
+5 DO SNMLL^PXRMFNFT(IEN)
+6 QUIT
+7 ;
+8 ;====================================
TAX(FDA,NODE) ;Process the FDA for taxonomies. This is for the conversion from
+1 ;the pointer based structure to Lexicon based structure.
+2 NEW CODE,CODEIEN,HIGH,IENS,LOW
+3 KILL ^TMP($JOB,NODE)
+4 ;ICD codes.
+5 SET IENS=""
+6 FOR
SET IENS=$ORDER(FDA(811.22102,IENS))
IF IENS=""
QUIT
Begin DoDot:1
+7 SET LOW=FDA(811.22102,IENS,.01)
+8 SET HIGH=$GET(FDA(811.22102,IENS,1))
+9 IF HIGH=""
SET HIGH=LOW
+10 SET ^TMP($JOB,NODE,"ICD",LOW,HIGH)=""
End DoDot:1
+11 ;
+12 ;ICP codes.
+13 SET IENS=""
+14 FOR
SET IENS=$ORDER(FDA(811.22103,IENS))
IF IENS=""
QUIT
Begin DoDot:1
+15 SET LOW=FDA(811.22103,IENS,.01)
+16 SET HIGH=$GET(FDA(811.22103,IENS,1))
+17 IF HIGH=""
SET HIGH=LOW
+18 SET ^TMP($JOB,NODE,"ICP",LOW,HIGH)=""
End DoDot:1
+19 ;
+20 ;CPT codes.
+21 SET IENS=""
+22 FOR
SET IENS=$ORDER(FDA(811.22104,IENS))
IF IENS=""
QUIT
Begin DoDot:1
+23 SET LOW=FDA(811.22104,IENS,.01)
+24 SET HIGH=$GET(FDA(811.22104,IENS,1))
+25 IF HIGH=""
SET HIGH=LOW
+26 SET ^TMP($JOB,NODE,"CPT",LOW,HIGH)=""
End DoDot:1
+27 ;
+28 ;Selectable ICD codes.
+29 SET IENS=""
+30 FOR
SET IENS=$ORDER(FDA(811.23102,IENS))
IF IENS=""
QUIT
Begin DoDot:1
+31 SET CODE=FDA(811.23102,IENS,.01)
+32 SET CODE=$TRANSLATE(CODE," ","")
+33 SET ^TMP($JOB,NODE,"SDX",CODE)=""
+34 SET CODEIEN=+$$EXISTS^PXRMEXIU(80,CODE,"BX")
+35 IF CODEIEN>0
SET FDA(811.23102,IENS,.01)="`"_CODEIEN
End DoDot:1
+36 ;
+37 ;Selectable CPT codes.
+38 SET IENS=""
+39 FOR
SET IENS=$ORDER(FDA(811.23104,IENS))
IF IENS=""
QUIT
Begin DoDot:1
+40 SET CODE=FDA(811.23104,IENS,.01)
+41 SET CODE=$TRANSLATE(CODE," ","")
+42 SET FDA(811.23104,IENS,.01)=CODE
+43 SET ^TMP($JOB,NODE,"SPR",CODE)=""
End DoDot:1
+44 ;
+45 ;If these fields no longer exist in the DD remove them from the FDA.
+46 ;ICD9 range of codes.
+47 SET LABEL=$$GET1^DIQ(811.2,2103,"","LABEL")
+48 IF LABEL=""
KILL ^FDA(811.22102)
+49 ;
+50 ;ICD0 range of codes.
+51 SET LABEL=$$GET1^DID(811.2,2103,"","LABEL")
+52 IF LABEL=""
KILL ^FDA(811.22103)
+53 ;
+54 ;CPT range of codes.
+55 SET LABEL=$$GET1^DID(811.2,2104,"","LABEL")
+56 IF LABEL=""
KILL ^FDA(811.22104)
+57 ;
+58 ;Selectable diagnosis.
+59 SET LABEL=$$GET1^DID(811.2,3102,"","LABEL")
+60 IF LABEL=""
KILL ^FDA(811.23102)
+61 ;
+62 ;Selectable procedure.
+63 SET LABEL=$$GET1^DID(811.2,3104,"","LABEL")
+64 IF LABEL=""
KILL ^FDA(811.23104)
+65 QUIT
+66 ;
+67 ;====================================
TAX30(IEN) ;Make sure the Use in Dialog Codes multiple is built during
+1 ;a Reminder Exchange Install.
+2 IF $DATA(^PXD(811.2,IEN,30))
QUIT
+3 IF '$DATA(^PXD(811.2,IEN,20,"AUID"))
QUIT
+4 NEW CODE,CODESYS
+5 SET CODESYS=""
+6 FOR
SET CODESYS=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS))
IF CODESYS=""
QUIT
Begin DoDot:1
+7 SET CODE=""
+8 FOR
SET CODE=$ORDER(^PXD(811.2,IEN,20,"AUID",CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:2
+9 DO SAVEUIDC^PXRMTAXD(IEN,CODESYS,CODE)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
