PXRMP17U.m

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

 ;

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      ;