PXRMEXU0 ;SLC/PKR - Reminder exchange general utilities, #0. ;04/14/2015
;;2.0;CLINICAL REMINDERS;**4,12,18,26,47**;Feb 04, 2005;Build 291
;====================================
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,LABEL,LOW,MSG
K ^TMP($J,NODE)
;Brief Description
S IENS=$O(FDA(811.2,""))
I $D(FDA(811.2,IENS,.02)) S ^TMP($J,NODE,"BDES")=FDA(811.2,IENS,.02)
;
;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.
;Brief Description
S LABEL=$$GET1^DIQ(811.2,.02,"","LABEL","","MSG")
I LABEL="" S IENS=$O(FDA(811.2,"")) K FDA(811.2,IENS,.02)
;
;Dialog Header Text
S LABEL=$$GET1^DIQ(811.2,.03,"","LABEL","","MSG")
I LABEL="" K FDA(811.2,IENS,.03)
;
;ICD9 range of codes.
S LABEL=$$GET1^DIQ(811.2,2102,"","LABEL","","MSG")
I LABEL="" K FDA(811.22102)
;
;ICD0 range of codes.
S LABEL=$$GET1^DID(811.2,2103,"","LABEL","","MSG")
I LABEL="" K FDA(811.22103)
;
;CPT range of codes.
S LABEL=$$GET1^DID(811.2,2104,"","LABEL","","MSG")
I LABEL="" K FDA(811.22104)
;
;Selectable diagnosis.
S LABEL=$$GET1^DID(811.2,3102,"","LABEL","","MSG")
I LABEL="" K FDA(811.23102)
;
;Selectable procedure.
S LABEL=$$GET1^DID(811.2,3104,"","LABEL","","MSG")
I LABEL="" K FDA(811.23104)
;
;Generate dialog dx parameter
S LABEL=$$GET1^DIQ(811.2,3106,"","LABEL","","MSG")
I LABEL="" K FDA(811.2,IENS,3106)
;
;Current visit dx dialog hdr
S LABEL=$$GET1^DIQ(811.2,3107,"","LABEL","","MSG")
I LABEL="" K FDA(811.2,IENS,3107)
;
;Visit dx dialog hdr
S LABEL=$$GET1^DIQ(811.2,3108,"","LABEL","","MSG")
I LABEL="" K FDA(811.2,IENS,3108)
;
;Generate dialog pr parameter
S LABEL=$$GET1^DIQ(811.2,3110,"","LABEL","","MSG")
I LABEL="" K FDA(811.2,IENS,3110)
;
;Current visit pr dialog hdr
S LABEL=$$GET1^DIQ(811.2,3111,"","LABEL","","MSG")
I LABEL="" K FDA(811.2,IENS,3111)
;
;Historical visit pr dialog hdr
S LABEL=$$GET1^DIQ(811.2,3112,"","LABEL","","MSG")
I LABEL="" K FDA(811.2,IENS,3112)
;
;If 811.24 is present remove it so it does not get deleted and
;rebuilt when the "AUID" index is built.
K FDA(811.24)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXU0 6372 printed Apr 09, 2024@20:54:11 Page 2
PXRMEXU0 ;SLC/PKR - Reminder exchange general utilities, #0. ;04/14/2015
+1 ;;2.0;CLINICAL REMINDERS;**4,12,18,26,47**;Feb 04, 2005;Build 291
+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,LABEL,LOW,MSG
+3 KILL ^TMP($JOB,NODE)
+4 ;Brief Description
+5 SET IENS=$ORDER(FDA(811.2,""))
+6 IF $DATA(FDA(811.2,IENS,.02))
SET ^TMP($JOB,NODE,"BDES")=FDA(811.2,IENS,.02)
+7 ;
+8 ;ICD codes.
+9 SET IENS=""
+10 FOR
SET IENS=$ORDER(FDA(811.22102,IENS))
if IENS=""
QUIT
Begin DoDot:1
+11 SET LOW=FDA(811.22102,IENS,.01)
+12 SET HIGH=$GET(FDA(811.22102,IENS,1))
+13 IF HIGH=""
SET HIGH=LOW
+14 SET ^TMP($JOB,NODE,"ICD",LOW,HIGH)=""
End DoDot:1
+15 ;
+16 ;ICP codes.
+17 SET IENS=""
+18 FOR
SET IENS=$ORDER(FDA(811.22103,IENS))
if IENS=""
QUIT
Begin DoDot:1
+19 SET LOW=FDA(811.22103,IENS,.01)
+20 SET HIGH=$GET(FDA(811.22103,IENS,1))
+21 IF HIGH=""
SET HIGH=LOW
+22 SET ^TMP($JOB,NODE,"ICP",LOW,HIGH)=""
End DoDot:1
+23 ;
+24 ;CPT codes.
+25 SET IENS=""
+26 FOR
SET IENS=$ORDER(FDA(811.22104,IENS))
if IENS=""
QUIT
Begin DoDot:1
+27 SET LOW=FDA(811.22104,IENS,.01)
+28 SET HIGH=$GET(FDA(811.22104,IENS,1))
+29 IF HIGH=""
SET HIGH=LOW
+30 SET ^TMP($JOB,NODE,"CPT",LOW,HIGH)=""
End DoDot:1
+31 ;
+32 ;Selectable ICD codes.
+33 SET IENS=""
+34 FOR
SET IENS=$ORDER(FDA(811.23102,IENS))
if IENS=""
QUIT
Begin DoDot:1
+35 SET CODE=FDA(811.23102,IENS,.01)
+36 SET CODE=$TRANSLATE(CODE," ","")
+37 SET ^TMP($JOB,NODE,"SDX",CODE)=""
+38 SET CODEIEN=+$$EXISTS^PXRMEXIU(80,CODE,"BX")
+39 IF CODEIEN>0
SET FDA(811.23102,IENS,.01)="`"_CODEIEN
End DoDot:1
+40 ;
+41 ;Selectable CPT codes.
+42 SET IENS=""
+43 FOR
SET IENS=$ORDER(FDA(811.23104,IENS))
if IENS=""
QUIT
Begin DoDot:1
+44 SET CODE=FDA(811.23104,IENS,.01)
+45 SET CODE=$TRANSLATE(CODE," ","")
+46 SET FDA(811.23104,IENS,.01)=CODE
+47 SET ^TMP($JOB,NODE,"SPR",CODE)=""
End DoDot:1
+48 ;
+49 ;If these fields no longer exist in the DD remove them from the FDA.
+50 ;Brief Description
+51 SET LABEL=$$GET1^DIQ(811.2,.02,"","LABEL","","MSG")
+52 IF LABEL=""
SET IENS=$ORDER(FDA(811.2,""))
KILL FDA(811.2,IENS,.02)
+53 ;
+54 ;Dialog Header Text
+55 SET LABEL=$$GET1^DIQ(811.2,.03,"","LABEL","","MSG")
+56 IF LABEL=""
KILL FDA(811.2,IENS,.03)
+57 ;
+58 ;ICD9 range of codes.
+59 SET LABEL=$$GET1^DIQ(811.2,2102,"","LABEL","","MSG")
+60 IF LABEL=""
KILL FDA(811.22102)
+61 ;
+62 ;ICD0 range of codes.
+63 SET LABEL=$$GET1^DID(811.2,2103,"","LABEL","","MSG")
+64 IF LABEL=""
KILL FDA(811.22103)
+65 ;
+66 ;CPT range of codes.
+67 SET LABEL=$$GET1^DID(811.2,2104,"","LABEL","","MSG")
+68 IF LABEL=""
KILL FDA(811.22104)
+69 ;
+70 ;Selectable diagnosis.
+71 SET LABEL=$$GET1^DID(811.2,3102,"","LABEL","","MSG")
+72 IF LABEL=""
KILL FDA(811.23102)
+73 ;
+74 ;Selectable procedure.
+75 SET LABEL=$$GET1^DID(811.2,3104,"","LABEL","","MSG")
+76 IF LABEL=""
KILL FDA(811.23104)
+77 ;
+78 ;Generate dialog dx parameter
+79 SET LABEL=$$GET1^DIQ(811.2,3106,"","LABEL","","MSG")
+80 IF LABEL=""
KILL FDA(811.2,IENS,3106)
+81 ;
+82 ;Current visit dx dialog hdr
+83 SET LABEL=$$GET1^DIQ(811.2,3107,"","LABEL","","MSG")
+84 IF LABEL=""
KILL FDA(811.2,IENS,3107)
+85 ;
+86 ;Visit dx dialog hdr
+87 SET LABEL=$$GET1^DIQ(811.2,3108,"","LABEL","","MSG")
+88 IF LABEL=""
KILL FDA(811.2,IENS,3108)
+89 ;
+90 ;Generate dialog pr parameter
+91 SET LABEL=$$GET1^DIQ(811.2,3110,"","LABEL","","MSG")
+92 IF LABEL=""
KILL FDA(811.2,IENS,3110)
+93 ;
+94 ;Current visit pr dialog hdr
+95 SET LABEL=$$GET1^DIQ(811.2,3111,"","LABEL","","MSG")
+96 IF LABEL=""
KILL FDA(811.2,IENS,3111)
+97 ;
+98 ;Historical visit pr dialog hdr
+99 SET LABEL=$$GET1^DIQ(811.2,3112,"","LABEL","","MSG")
+100 IF LABEL=""
KILL FDA(811.2,IENS,3112)
+101 ;
+102 ;If 811.24 is present remove it so it does not get deleted and
+103 ;rebuilt when the "AUID" index is built.
+104 KILL FDA(811.24)
+105 QUIT
+106 ;
