Routine: PXRMV2IE

PXRMV2IE ; SLC/PKR - Version 2.0 init routine. ;02/3/2005

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

 ;Reminder Exchange install.

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

ARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install

 S ARRAY(1,1)="VA-ANTIPSYCHOTIC MED SIDE EFF EVAL"

 I MODE S ARRAY(1,2)="01/27/2005@10:31:11"

 S ARRAY(2,1)="VA-DEPRESSION SCREENING"

 I MODE S ARRAY(2,2)="01/27/2005@10:31:26"

 S ARRAY(3,1)="VA-POS DEPRESSION SCREEN FOLLOWUP"

 I MODE S ARRAY(3,2)="02/03/2005@14:32:26"

 S ARRAY(4,1)="VA-IHD ELEVATED LDL"

 I MODE S ARRAY(4,2)="08/25/2004@08:48:27"

 S ARRAY(5,1)="VA-IHD LIPID PROFILE"

 I MODE S ARRAY(5,2)="08/25/2004@08:48:55"

 S ARRAY(6,1)="VA-*IHD ELEVATED LDL REPORTING"

 I MODE S ARRAY(6,2)="08/25/2004@08:49:25"

 S ARRAY(7,1)="VA-*IHD LIPID PROFILE REPORTING"

 I MODE S ARRAY(7,2)="08/25/2004@08:49:59"

 S ARRAY(8,1)="VA-*IHD 412 ELEVATED LDL REPORTING"

 I MODE S ARRAY(8,2)="08/25/2004@08:50:25"

 S ARRAY(9,1)="VA-*IHD 412 LIPID PROFILE REPORTING"

 I MODE S ARRAY(9,2)="08/25/2004@08:51:13"

 S ARRAY(10,1)="VA-IHD QUERI PARAMETER"

 I MODE S ARRAY(10,2)="09/22/2004@09:49:24"

 S ARRAY(11,1)="VA-MH QUERI PARAMETER"

 I MODE S ARRAY(11,2)="09/22/2004@09:56:01"

 S ARRAY(12,1)="VA-GEC REFERRAL TERM SET (CC)"

 I MODE S ARRAY(12,2)="08/25/2004@08:51:47"

 S ARRAY(13,1)="VA-GEC REFERRAL TERM SET (CR)"

 I MODE S ARRAY(13,2)="08/25/2004@08:52:28"

 S ARRAY(14,1)="VA-GEC REFERRAL TERM SET (NA)"

 I MODE S ARRAY(14,2)="08/25/2004@08:53:27"

 S ARRAY(15,1)="VA-GEC REFERRAL TERM SET (SS)"

 I MODE S ARRAY(15,2)="08/25/2004@08:54"

 S ARRAY(16,1)="VA-GEC REFERRAL CARE COORDINATION"

 I MODE S ARRAY(16,2)="08/25/2004@08:54:33"

 S ARRAY(17,1)="VA-GEC REFERRAL CARE RECOMMENDATION"

 I MODE S ARRAY(17,2)="08/25/2004@08:55:03"

 S ARRAY(18,1)="VA-GEC REFERRAL NURSING ASSESSMENT"

 I MODE S ARRAY(18,2)="08/25/2004@08:55:30"

 S ARRAY(19,1)="VA-GEC REFERRAL SOCIAL SERVICES"

 I MODE S ARRAY(19,2)="08/25/2004@08:56:08"

 S ARRAY(20,1)="VA-IRAQ & AFGHAN POST-DEPLOY SCREEN"

 I MODE S ARRAY(20,2)="01/27/2005@10:31:41"

 S ARRAY(21,1)="BDI II RESULT GROUP"

 I MODE S ARRAY(21,2)="04/13/2004@15:53:47"

 ;additional reminders with MRD function finding changes

 S ARRAY(22,1)="VA-HTN ASSESSMENT BP >=140/90"

 I MODE S ARRAY(22,2)="09/21/2004@14:46:58"

 S ARRAY(23,1)="VA-HTN ASSESSMENT BP >=160/100"

 I MODE S ARRAY(23,2)="09/21/2004@14:47:18"

 S ARRAY(24,1)="VA-HTN LIFESTYLE EDUCATION"

 I MODE S ARRAY(24,2)="09/21/2004@14:47:35"

 S ARRAY(25,1)="VA-MST SCREENING"

 I MODE S ARRAY(25,2)="01/27/2005@10:31:56"

 ;Make sure this old one gets deleted.

 S ARRAY(26,1)="VA-IRAQ &AFGHAN POST-DEPLOY SCREEN"

 I MODE S ARRAY(26,2)="12/23/2003@22:52:03"

 S ARRAY(26,1)="GMTSMHV"

 I MODE S ARRAY(26,2)="07/06/2004@15:06:21"

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

CNAK ;Make sure all "NAK" characters are converted back to "^" in

 ;the Exchange File.

 N IEN,TEXT

 D BMES^XPDUTL("Clean up Exchange File entries")

 S IEN=0

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

 . S TEXT=" Working on Exchange File entry "_IEN

 . D BMES^XPDUTL(TEXT)

 . D POSTKIDS^PXRMEXU5(IEN)

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

DELEI ;If the Exchange File entry already exists delete it.

 N ARRAY,IC,IND,LIST,LUVALUE,NUM

 D ARRAY(1,.ARRAY)

 S IC=0

 F  S IC=$O(ARRAY(IC)) Q:'IC  D

 .S LUVALUE(1)=ARRAY(IC,1)

 .D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")

 .I '$D(LIST) Q

 .S NUM=$P(LIST("DILIST",0),U,1)

 .I NUM'=0 D

 ..F IND=1:1:NUM D

 ... N DA,DIK

 ... S DIK="^PXD(811.8,"

 ... S DA=LIST("DILIST",2,IND)

 ... D ^DIK

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

DELEXB ;Delete the "B" index entries on the XML data in the Exchange File.

 N IEN

 D BMES^XPDUTL("Cleaning up Exchange File.")

 S IEN=0

 F  S IEN=+$O(^PXD(811.8,IEN)) Q:IEN=0  K ^PXD(811.8,IEN,100,"B")

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

DELGEC ;Delete the GEC Referal Term sets from the Reminder Definition file

 N DA,DIK,GECREM,REMIEN

 S GECREM="VA-GEC REFERRAL TERM SET (CC)"

 S REMIEN=+$O(^PXD(811.9,"B",GECREM,0)) I REMIEN>0 D

 . S DIK="^PXD(811.9,",DA=REMIEN D ^DIK

 S GECREM="VA-GEC REFERRAL TERM SET (CR)"

 S REMIEN=+$O(^PXD(811.9,"B",GECREM,0)) I REMIEN>0 D

 . S DIK="^PXD(811.9,",DA=REMIEN D ^DIK

 S GECREM="VA-GEC REFERRAL TERM SET (NA)"

 S REMIEN=+$O(^PXD(811.9,"B",GECREM,0)) I REMIEN>0 D

 . S DIK="^PXD(811.9,",DA=REMIEN D ^DIK

 S GECREM="VA-GEC REFERRAL TERM SET (SS)"

 S REMIEN=+$O(^PXD(811.9,"B",GECREM,0)) I REMIEN>0 D

 . S DIK="^PXD(811.9,",DA=REMIEN D ^DIK

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

EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to

 ;include in the build. This is used in the build to determine which

 ;entries to include.

 N ARRAY,FOUND,IEN,IC,LUVALUE

 D ARRAY(1,.ARRAY)

 S FOUND=0

 S IC=0

 F  S IC=+$O(ARRAY(IC)) Q:(IC=0)!(FOUND)  D

 . M LUVALUE=ARRAY(IC)

 . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)

 . I IEN=Y S FOUND=1 Q

 Q FOUND

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

SMEXINS ;Silent mode install.

 N ARRAY,IC,IEN,LUVALUE,PXRMINST

 S PXRMINST=1

 D ARRAY(1,.ARRAY)

 S IC=0

 F  S IC=$O(ARRAY(IC)) Q:'IC  D

 .M LUVALUE=ARRAY(IC)

 .I LUVALUE(1)="GMTSMHV" Q

 .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)

 .I IEN'=0 D

 .. N TEXT

 .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)

 .. E  S TEXT="Installing reminder "_LUVALUE(1)

 .. D BMES^XPDUTL(TEXT)

 .. D INSTALL^PXRMEXSI(IEN,1)

PXRMV2IE  ; SLC/PKR - Version 2.0 init routine. ;02/3/2005

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

 +2       ;Reminder Exchange install.

 +3        QUIT

 +4       ;

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

ARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install

 +1       ;

 +2        SET ARRAY(1,1)="VA-ANTIPSYCHOTIC MED SIDE EFF EVAL"

 +3        IF MODE

               SET ARRAY(1,2)="01/27/2005@10:31:11"

 +4        SET ARRAY(2,1)="VA-DEPRESSION SCREENING"

 +5        IF MODE

               SET ARRAY(2,2)="01/27/2005@10:31:26"

 +6        SET ARRAY(3,1)="VA-POS DEPRESSION SCREEN FOLLOWUP"

 +7        IF MODE

               SET ARRAY(3,2)="02/03/2005@14:32:26"

 +8       ;

 +9        SET ARRAY(4,1)="VA-IHD ELEVATED LDL"

 +10       IF MODE

               SET ARRAY(4,2)="08/25/2004@08:48:27"

 +11       SET ARRAY(5,1)="VA-IHD LIPID PROFILE"

 +12       IF MODE

               SET ARRAY(5,2)="08/25/2004@08:48:55"

 +13       SET ARRAY(6,1)="VA-*IHD ELEVATED LDL REPORTING"

 +14       IF MODE

               SET ARRAY(6,2)="08/25/2004@08:49:25"

 +15       SET ARRAY(7,1)="VA-*IHD LIPID PROFILE REPORTING"

 +16       IF MODE

               SET ARRAY(7,2)="08/25/2004@08:49:59"

 +17       SET ARRAY(8,1)="VA-*IHD 412 ELEVATED LDL REPORTING"

 +18       IF MODE

               SET ARRAY(8,2)="08/25/2004@08:50:25"

 +19       SET ARRAY(9,1)="VA-*IHD 412 LIPID PROFILE REPORTING"

 +20       IF MODE

               SET ARRAY(9,2)="08/25/2004@08:51:13"

 +21      ;

 +22       SET ARRAY(10,1)="VA-IHD QUERI PARAMETER"

 +23       IF MODE

               SET ARRAY(10,2)="09/22/2004@09:49:24"

 +24       SET ARRAY(11,1)="VA-MH QUERI PARAMETER"

 +25       IF MODE

               SET ARRAY(11,2)="09/22/2004@09:56:01"

 +26      ;

 +27       SET ARRAY(12,1)="VA-GEC REFERRAL TERM SET (CC)"

 +28       IF MODE

               SET ARRAY(12,2)="08/25/2004@08:51:47"

 +29       SET ARRAY(13,1)="VA-GEC REFERRAL TERM SET (CR)"

 +30       IF MODE

               SET ARRAY(13,2)="08/25/2004@08:52:28"

 +31       SET ARRAY(14,1)="VA-GEC REFERRAL TERM SET (NA)"

 +32       IF MODE

               SET ARRAY(14,2)="08/25/2004@08:53:27"

 +33       SET ARRAY(15,1)="VA-GEC REFERRAL TERM SET (SS)"

 +34       IF MODE

               SET ARRAY(15,2)="08/25/2004@08:54"

 +35      ;

 +36       SET ARRAY(16,1)="VA-GEC REFERRAL CARE COORDINATION"

 +37       IF MODE

               SET ARRAY(16,2)="08/25/2004@08:54:33"

 +38       SET ARRAY(17,1)="VA-GEC REFERRAL CARE RECOMMENDATION"

 +39       IF MODE

               SET ARRAY(17,2)="08/25/2004@08:55:03"

 +40       SET ARRAY(18,1)="VA-GEC REFERRAL NURSING ASSESSMENT"

 +41       IF MODE

               SET ARRAY(18,2)="08/25/2004@08:55:30"

 +42       SET ARRAY(19,1)="VA-GEC REFERRAL SOCIAL SERVICES"

 +43       IF MODE

               SET ARRAY(19,2)="08/25/2004@08:56:08"

 +44      ;

 +45       SET ARRAY(20,1)="VA-IRAQ & AFGHAN POST-DEPLOY SCREEN"

 +46       IF MODE

               SET ARRAY(20,2)="01/27/2005@10:31:41"

 +47      ;

 +48       SET ARRAY(21,1)="BDI II RESULT GROUP"

 +49       IF MODE

               SET ARRAY(21,2)="04/13/2004@15:53:47"

 +50      ;

 +51      ;additional reminders with MRD function finding changes

 +52       SET ARRAY(22,1)="VA-HTN ASSESSMENT BP >=140/90"

 +53       IF MODE

               SET ARRAY(22,2)="09/21/2004@14:46:58"

 +54       SET ARRAY(23,1)="VA-HTN ASSESSMENT BP >=160/100"

 +55       IF MODE

               SET ARRAY(23,2)="09/21/2004@14:47:18"

 +56       SET ARRAY(24,1)="VA-HTN LIFESTYLE EDUCATION"

 +57       IF MODE

               SET ARRAY(24,2)="09/21/2004@14:47:35"

 +58       SET ARRAY(25,1)="VA-MST SCREENING"

 +59       IF MODE

               SET ARRAY(25,2)="01/27/2005@10:31:56"

 +60      ;

 +61      ;Make sure this old one gets deleted.

 +62       SET ARRAY(26,1)="VA-IRAQ &AFGHAN POST-DEPLOY SCREEN"

 +63       IF MODE

               SET ARRAY(26,2)="12/23/2003@22:52:03"

 +64      ;

 +65       SET ARRAY(26,1)="GMTSMHV"

 +66       IF MODE

               SET ARRAY(26,2)="07/06/2004@15:06:21"

 +67       QUIT

 +68      ;

 +69      ;===============================================================

CNAK      ;Make sure all "NAK" characters are converted back to "^" in

 +1       ;the Exchange File.

 +2        NEW IEN,TEXT

 +3        DO BMES^XPDUTL("Clean up Exchange File entries")

 +4        SET IEN=0

 +5        FOR

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

               IF IEN=0

                   QUIT

               Begin DoDot:1

 +6                SET TEXT=" Working on Exchange File entry "_IEN

 +7                DO BMES^XPDUTL(TEXT)

 +8                DO POSTKIDS^PXRMEXU5(IEN)

               End DoDot:1

 +9        QUIT

 +10      ;

 +11      ;===============================================================

DELEI     ;If the Exchange File entry already exists delete it.

 +1        NEW ARRAY,IC,IND,LIST,LUVALUE,NUM

 +2        DO ARRAY(1,.ARRAY)

 +3        SET IC=0

 +4        FOR

               SET IC=$ORDER(ARRAY(IC))

               IF 'IC

                   QUIT

               Begin DoDot:1

 +5                SET LUVALUE(1)=ARRAY(IC,1)

 +6                DO FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")

 +7                IF '$DATA(LIST)

                       QUIT

 +8                SET NUM=$PIECE(LIST("DILIST",0),U,1)

 +9                IF NUM'=0

                       Begin DoDot:2

 +10                       FOR IND=1:1:NUM

                               Begin DoDot:3

 +11                               NEW DA,DIK

 +12                               SET DIK="^PXD(811.8,"

 +13                               SET DA=LIST("DILIST",2,IND)

 +14                               DO ^DIK

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15       QUIT

 +16      ;

 +17      ;===============================================================

DELEXB    ;Delete the "B" index entries on the XML data in the Exchange File.

 +1        NEW IEN

 +2        DO BMES^XPDUTL("Cleaning up Exchange File.")

 +3        SET IEN=0

 +4        FOR

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

               IF IEN=0

                   QUIT

               KILL ^PXD(811.8,IEN,100,"B")

 +5        QUIT

 +6       ;

 +7       ;===============================================================

DELGEC    ;Delete the GEC Referal Term sets from the Reminder Definition file

 +1        NEW DA,DIK,GECREM,REMIEN

 +2        SET GECREM="VA-GEC REFERRAL TERM SET (CC)"

 +3        SET REMIEN=+$ORDER(^PXD(811.9,"B",GECREM,0))

           IF REMIEN>0

               Begin DoDot:1

 +4                SET DIK="^PXD(811.9,"

                   SET DA=REMIEN

                   DO ^DIK

               End DoDot:1

 +5        SET GECREM="VA-GEC REFERRAL TERM SET (CR)"

 +6        SET REMIEN=+$ORDER(^PXD(811.9,"B",GECREM,0))

           IF REMIEN>0

               Begin DoDot:1

 +7                SET DIK="^PXD(811.9,"

                   SET DA=REMIEN

                   DO ^DIK

               End DoDot:1

 +8        SET GECREM="VA-GEC REFERRAL TERM SET (NA)"

 +9        SET REMIEN=+$ORDER(^PXD(811.9,"B",GECREM,0))

           IF REMIEN>0

               Begin DoDot:1

 +10               SET DIK="^PXD(811.9,"

                   SET DA=REMIEN

                   DO ^DIK

               End DoDot:1

 +11       SET GECREM="VA-GEC REFERRAL TERM SET (SS)"

 +12       SET REMIEN=+$ORDER(^PXD(811.9,"B",GECREM,0))

           IF REMIEN>0

               Begin DoDot:1

 +13               SET DIK="^PXD(811.9,"

                   SET DA=REMIEN

                   DO ^DIK

               End DoDot:1

 +14       QUIT

 +15      ;

 +16      ;===============================================================

EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to

 +1       ;include in the build. This is used in the build to determine which

 +2       ;entries to include.

 +3        NEW ARRAY,FOUND,IEN,IC,LUVALUE

 +4        DO ARRAY(1,.ARRAY)

 +5        SET FOUND=0

 +6        SET IC=0

 +7        FOR

               SET IC=+$ORDER(ARRAY(IC))

               IF (IC=0)!(FOUND)

                   QUIT

               Begin DoDot:1

 +8                MERGE LUVALUE=ARRAY(IC)

 +9                SET IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)

 +10               IF IEN=Y

                       SET FOUND=1

                       QUIT

               End DoDot:1

 +11       QUIT FOUND

 +12      ;

 +13      ;===============================================================

SMEXINS   ;Silent mode install.

 +1        NEW ARRAY,IC,IEN,LUVALUE,PXRMINST

 +2        SET PXRMINST=1

 +3        DO ARRAY(1,.ARRAY)

 +4        SET IC=0

 +5        FOR

               SET IC=$ORDER(ARRAY(IC))

               IF 'IC

                   QUIT

               Begin DoDot:1

 +6                MERGE LUVALUE=ARRAY(IC)

 +7                IF LUVALUE(1)="GMTSMHV"

                       QUIT

 +8                SET IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)

 +9                IF IEN'=0

                       Begin DoDot:2

 +10                       NEW TEXT

 +11                       IF LUVALUE(1)["PARAMETER"

                               SET TEXT="Installing entry "_LUVALUE(1)

 +12                      IF '$TEST

                               SET TEXT="Installing reminder "_LUVALUE(1)

 +13                       DO BMES^XPDUTL(TEXT)

 +14                       DO INSTALL^PXRMEXSI(IEN,1)

                       End DoDot:2

               End DoDot:1

 +15       QUIT

 +16      ;

PXRMV2IE.m