- PXRMP8I ; SLC/AGP - Patch 8 init routine. ;03/07/2007
- ;;2.0;CLINICAL REMINDERS;**8**;Feb 04, 2005;Build 28
- ;Reminder Exchange install.
- Q
- ;
- ;===============================================================
- ARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
- ;
- S ARRAY(1,1)="VA-TBI SCREENING"
- I MODE S ARRAY(1,2)="03/07/2007@12:29:10"
- Q
- ;
- ;===============================================================
- 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
- Q
- ;
- ;===============================================================
- 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
- ;
- PRE ;
- D DELEI
- Q
- POST ;
- ;D SMEXINS
- Q
- ;===============================================================
- 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)
- .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)
- Q
- ;
- PXRMP8I ; SLC/AGP - Patch 8 init routine. ;03/07/2007
- +1 ;;2.0;CLINICAL REMINDERS;**8**;Feb 04, 2005;Build 28
- +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-TBI SCREENING"
- +3 IF MODE
- SET ARRAY(1,2)="03/07/2007@12:29:10"
- +4 QUIT
- +5 ;
- +6 ;===============================================================
- 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 ;===============================================================
- 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 ;
- PRE ;
- +1 DO DELEI
- +2 QUIT
- POST ;
- +1 ;D SMEXINS
- +2 QUIT
- +3 ;===============================================================
- 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 SET IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
- +8 IF IEN'=0
- Begin DoDot:2
- +9 NEW TEXT
- +10 IF LUVALUE(1)["PARAMETER"
- SET TEXT="Installing entry "_LUVALUE(1)
- +11 IF '$TEST
- SET TEXT="Installing reminder "_LUVALUE(1)
- +12 DO BMES^XPDUTL(TEXT)
- +13 DO INSTALL^PXRMEXSI(IEN,1)
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
