PXRMP17U ;SLC/DAN - Undo updates from patch 17 ;2/1/10 12:54
;;2.0;CLINICAL REMINDERS;**17**;Feb 04, 2005;Build 102
;
ALLERGY ;Reset computed finding parameter for new version of VA-ALLERGY
;computed finding.
N CFIEN,CFPARAM,IEN,FINDING
S CFIEN=$O(^PXRMD(811.4,"B","VA-ALLERGY",""))
I CFIEN="" Q
K ^TMP($J,"LIST")
D BLDLIST^PXRMFRPT(811.4,"PXRMD(811.4,",CFIEN,"LIST")
;Process definitions
S IEN=""
F S IEN=$O(^TMP($J,"LIST",811.4,CFIEN,"DEF",IEN)) Q:IEN="" D
. S FINDING=""
. F S FINDING=$O(^TMP($J,"LIST",811.4,CFIEN,"DEF",IEN,FINDING)) Q:FINDING="" D
.. S CFPARAM=$G(^PXD(811.9,IEN,20,FINDING,15)) Q:$L(CFPARAM,":")=2 ;already converted if equal to 2
.. S ^PXD(811.9,IEN,20,FINDING,15)=$P(CFPARAM,":",1,2) ;use only first two parameters
;Process terms
S IEN=""
F S IEN=$O(^TMP($J,"LIST",811.4,CFIEN,"TERM",IEN)) Q:IEN="" D
. S FINDING=""
. F S FINDING=$O(^TMP($J,"LIST",811.4,CFIEN,"TERM",IEN,FINDING)) Q:FINDING="" D
.. S CFPARAM=$G(^PXRMD(811.5,IEN,20,FINDING,15)) Q:$L(CFPARAM,":")=2 ;already converted if equal to 2
.. S ^PXRMD(811.5,IEN,20,FINDING,15)=$P(CFPARAM,":",1,2) ;use only first two parameters
K ^TMP($J,"LIST")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP17U 1195 printed Nov 22, 2024@16:57:20 Page 2
PXRMP17U ;SLC/DAN - Undo updates from patch 17 ;2/1/10 12:54
+1 ;;2.0;CLINICAL REMINDERS;**17**;Feb 04, 2005;Build 102
+2 ;
ALLERGY ;Reset computed finding parameter for new version of VA-ALLERGY
+1 ;computed finding.
+2 NEW CFIEN,CFPARAM,IEN,FINDING
+3 SET CFIEN=$ORDER(^PXRMD(811.4,"B","VA-ALLERGY",""))
+4 IF CFIEN=""
QUIT
+5 KILL ^TMP($JOB,"LIST")
+6 DO BLDLIST^PXRMFRPT(811.4,"PXRMD(811.4,",CFIEN,"LIST")
+7 ;Process definitions
+8 SET IEN=""
+9 FOR
SET IEN=$ORDER(^TMP($JOB,"LIST",811.4,CFIEN,"DEF",IEN))
if IEN=""
QUIT
Begin DoDot:1
+10 SET FINDING=""
+11 FOR
SET FINDING=$ORDER(^TMP($JOB,"LIST",811.4,CFIEN,"DEF",IEN,FINDING))
if FINDING=""
QUIT
Begin DoDot:2
+12 ;already converted if equal to 2
SET CFPARAM=$GET(^PXD(811.9,IEN,20,FINDING,15))
if $LENGTH(CFPARAM,"
QUIT
+13 ;use only first two parameters
SET ^PXD(811.9,IEN,20,FINDING,15)=$PIECE(CFPARAM,":",1,2)
End DoDot:2
End DoDot:1
+14 ;Process terms
+15 SET IEN=""
+16 FOR
SET IEN=$ORDER(^TMP($JOB,"LIST",811.4,CFIEN,"TERM",IEN))
if IEN=""
QUIT
Begin DoDot:1
+17 SET FINDING=""
+18 FOR
SET FINDING=$ORDER(^TMP($JOB,"LIST",811.4,CFIEN,"TERM",IEN,FINDING))
if FINDING=""
QUIT
Begin DoDot:2
+19 ;already converted if equal to 2
SET CFPARAM=$GET(^PXRMD(811.5,IEN,20,FINDING,15))
if $LENGTH(CFPARAM,"
QUIT
+20 ;use only first two parameters
SET ^PXRMD(811.5,IEN,20,FINDING,15)=$PIECE(CFPARAM,":",1,2)
End DoDot:2
End DoDot:1
+21 KILL ^TMP($JOB,"LIST")
+22 QUIT
+23 ;
