PXRMV2IC.m

PXRMV2IC ; SLC/PKR - Version 2.0 init routine. ;02/18/2004

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;

 Q

 ;

 ;===============================================================

COND ;Put "~" back to space in condition and store the internal condition

 ;and v list

 N COND,DA,IEN,IND,TEXT

 D BMES^XPDUTL("Converting conditions")

 S IEN=0

 F  S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0  D

 . S TEXT=" Working on reminder "_IEN

 . D BMES^XPDUTL(TEXT)

 . S IND=0

 . F  S IND=+$O(^PXD(811.9,IEN,20,IND)) Q:IND=0  D

 .. S COND=$P($G(^PXD(811.9,IEN,20,IND,3)),U,1)

 .. I COND="" Q

 .. S COND=$TR(COND,"~"," ")

 .. S $P(^PXD(811.9,IEN,20,IND,3),U,1)=COND

 .. S DA(1)=IEN,DA=IND

 .. D KICOND^PXRMCOND(COND,.DA,811.9)

 .. D SICOND^PXRMCOND(COND,.DA,811.9)

 . D USAGE(IEN)

 ;

 S IEN=0

 F  S IEN=+$O(^PXRMD(811.5,IEN)) Q:IEN=0  D

 . S TEXT=" Working on term "_IEN

 . D BMES^XPDUTL(TEXT)

 . S IND=0

 . F  S IND=+$O(^PXRMD(811.5,IEN,20,IND)) Q:IND=0  D

 .. S COND=$P($G(^PXRMD(811.5,IEN,20,IND,3)),U,1)

 .. I COND="" Q

 .. S COND=$TR(COND,"~"," ")

 .. S $P(^PXRMD(811.5,IEN,20,IND,3),U,1)=COND

 .. S DA(1)=IEN,DA=IND

 .. D KICOND^PXRMCOND(COND,.DA,811.5)

 .. D SICOND^PXRMCOND(COND,.DA,811.5)

 Q

 ;

 ;===============================================================

USAGE(IEN) ;Make sure the Usage field is uppercase.

 N USAGE

 S USAGE=$P($G(^PXD(811.9,IEN,100)),U,4)

 S USAGE=$$UP^XLFSTR(USAGE)

 S $P(^PXD(811.9,IEN,100),U,4)=USAGE

 Q

 ;

PXRMV2IC  ; SLC/PKR - Version 2.0 init routine. ;02/18/2004

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ;===============================================================

COND      ;Put "~" back to space in condition and store the internal condition

 +1       ;and v list

 +2        NEW COND,DA,IEN,IND,TEXT

 +3        DO BMES^XPDUTL("Converting conditions")

 +4        SET IEN=0

 +5        FOR 

               SET IEN=+$ORDER(^PXD(811.9,IEN))

               IF IEN=0

                   QUIT 

               Begin DoDot:1

 +6                SET TEXT=" Working on reminder "_IEN

 +7                DO BMES^XPDUTL(TEXT)

 +8                SET IND=0

 +9                FOR 

                       SET IND=+$ORDER(^PXD(811.9,IEN,20,IND))

                       IF IND=0

                           QUIT 

                       Begin DoDot:2

 +10                       SET COND=$PIECE($GET(^PXD(811.9,IEN,20,IND,3)),U,1)

 +11                       IF COND=""

                               QUIT 

 +12                       SET COND=$TRANSLATE(COND,"~"," ")

 +13                       SET $PIECE(^PXD(811.9,IEN,20,IND,3),U,1)=COND

 +14                       SET DA(1)=IEN

                           SET DA=IND

 +15                       DO KICOND^PXRMCOND(COND,.DA,811.9)

 +16                       DO SICOND^PXRMCOND(COND,.DA,811.9)

                       End DoDot:2

 +17               DO USAGE(IEN)

               End DoDot:1

 +18      ;

 +19       SET IEN=0

 +20       FOR 

               SET IEN=+$ORDER(^PXRMD(811.5,IEN))

               IF IEN=0

                   QUIT 

               Begin DoDot:1

 +21               SET TEXT=" Working on term "_IEN

 +22               DO BMES^XPDUTL(TEXT)

 +23               SET IND=0

 +24               FOR 

                       SET IND=+$ORDER(^PXRMD(811.5,IEN,20,IND))

                       IF IND=0

                           QUIT 

                       Begin DoDot:2

 +25                       SET COND=$PIECE($GET(^PXRMD(811.5,IEN,20,IND,3)),U,1)

 +26                       IF COND=""

                               QUIT 

 +27                       SET COND=$TRANSLATE(COND,"~"," ")

 +28                       SET $PIECE(^PXRMD(811.5,IEN,20,IND,3),U,1)=COND

 +29                       SET DA(1)=IEN

                           SET DA=IND

 +30                       DO KICOND^PXRMCOND(COND,.DA,811.5)

 +31                       DO SICOND^PXRMCOND(COND,.DA,811.5)

                       End DoDot:2

               End DoDot:1

 +32       QUIT 

 +33      ;

 +34      ;===============================================================

USAGE(IEN) ;Make sure the Usage field is uppercase.

 +1        NEW USAGE

 +2        SET USAGE=$PIECE($GET(^PXD(811.9,IEN,100)),U,4)

 +3        SET USAGE=$$UP^XLFSTR(USAGE)

 +4        SET $PIECE(^PXD(811.9,IEN,100),U,4)=USAGE

 +5        QUIT 

 +6       ;