Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOPOST.m

    r613 r623  
    1 HLOPOST ;IRMFO-ALB/CJM -Post-Install routine for HLO;03/24/2004  14:43 ;07/20/2007
    2         ;;1.6;HEALTH LEVEL SEVEN;**126,134,136,137**;Oct 13, 1995;Build 21
    3         ;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;
    5         N SYSTEM,DATA,VASITE,OLDSITE
    6         D IDXLINKS
    7         D SYSPARMS^HLOSITE(.SYSTEM)
    8         S VASITE=$$SITE^VASITE
    9         S OLDSITE=$G(^HLCS(869.3,1,0))
    10         S DATA(.01)=SYSTEM("DOMAIN")
    11         I DATA(.01)="" D
    12         .I $P(OLDSITE,"^",2) S DATA(.01)="HL7."_$P($G(^DIC(4.2,$P(OLDSITE,"^",2),0)),"^")
    13         I DATA(.01)="" D
    14         .N INST,DOMAIN
    15         .S INST=$P(VASITE,"^")
    16         .Q:'INST
    17         .S DOMAIN=$P($G(^DIC(4,INST,6)),"^")
    18         .I DOMAIN S DOMAIN=$P($G(^DIC(4.2,DOMAIN,0)),"^") I DOMAIN'="" S DATA(.01)="HL7."_DOMAIN
    19         I DATA(.01)="" D BMES^XPDUTL("Post-Install failed, system missing INSTITUTION or DOMAIN file entry") Q
    20         S DATA(.02)=SYSTEM("STATION")
    21         I DATA(.02)="",$P(OLDSITE,"^",4) S DATA(.02)=$P($G(^DIC(4,$P(OLDSITE,"^",4),99)),"^")
    22         I DATA(.02)="" S DATA(.02)=$P(VASITE,"^",3)
    23         S DATA(.03)=$P(OLDSITE,"^",3)
    24         S DATA(.04)=SYSTEM("MAXSTRING")
    25         S DATA(.05)=SYSTEM("HL7 BUFFER")
    26         S DATA(.06)=SYSTEM("USER BUFFER")
    27         S DATA(.07)=SYSTEM("NORMAL PURGE")
    28         S DATA(.08)=SYSTEM("ERROR PURGE")
    29         I $D(^HLD(779.1,1,0)) D
    30         .N ERROR
    31         .I '$$UPD^HLOASUB1(779.1,1,.DATA,.ERROR) D BMES^XPDUTL("Post-Install failed -"_$G(ERROR))
    32         E  D
    33         .N ERROR
    34         .I '$$ADD^HLOASUB1(779.1,,.DATA,.ERROR,1) D BMES^XPDUTL("Post-Install failed -"_$G(ERROR))
    35         Q
    36 IDXLINKS        ;
    37         ;set the "AC" and "AD" indicies on the HL Logical Link file
    38         N DIK
    39         S DIK="^HLCS(870,"
    40         S DIK(1)=".01^AC^AD^AD1^AD2"
    41         D ENALL^DIK
    42         Q
    43         ;
    44 P134    ;
    45         N DAILY,STARTUP,IEN,DATA
    46         S DAILY=$O(^DIC(19,"B","HLO DAILY STARTUP",0))
    47         I 'DAILY D BMES^XPDUTL("Failed to schedule the HLO DAILY STARTUP option!")
    48         S STARTUP=$O(^DIC(19,"B","HLO SYSTEM STARTUP",0))
    49         I 'STARTUP D BMES^XPDUTL("Failed to schedule the HLO SYSTEM STARTUP option!")
    50         I STARTUP D
    51         .S IEN=$O(^DIC(19.2,"B",STARTUP,0))
    52         .S DATA(.01)=STARTUP
    53         .S DATA(2)=""
    54         .S DATA(6)=""
    55         .S DATA(9)=$S($P($G(^HLD(779.1,1,0)),"^",3)="P":"S",1:"")
    56         .I IEN D
    57         ..I '$$UPD^HLOASUB1(19.2,IEN,.DATA) D BMES^XPDUTL("Failed to schedule the HLO SYSTEM STARTUP option!")
    58         .E  D
    59         ..I '$$ADD^HLOASUB1(19.2,,.DATA) D BMES^XPDUTL("Failed to schedule the HLO SYSTEM STARTUP option!")
    60         I DAILY D
    61         .S IEN=$O(^DIC(19.2,"B",DAILY,0))
    62         .S DATA(.01)=DAILY
    63         .S DATA(2)=$$NOW^XLFDT
    64         .S DATA(6)="1D"
    65         .S DATA(9)=""
    66         .I IEN D
    67         ..I '$$UPD^HLOASUB1(19.2,IEN,.DATA) D BMES^XPDUTL("Failed to schedule the HLO DAILY STARTUP option!")
    68         .E  D
    69         ..I '$$ADD^HLOASUB1(19.2,,.DATA) D BMES^XPDUTL("Failed to schedule the HLO DAILY STARTUP option!")
    70         Q
    71         ;
    72 P136    ;post-install routine for HL*1.6*136
    73         N ERROR,DIFROM,IEN
    74         I $P($G(^HLD(779.1,1,0)),"^",3)="P" D
    75         .D RESCH^XUTMOPT("HLO DAILY STARTUP",$$FMADD^XLFDT($$NOW^XLFDT,,1),,"1D","L",.ERROR)
    76         .I $G(ERROR)<0 D BMES^XPDUTL("Failed to schedule the HLO DAILY STARTUP option! Please do so manually")
    77         ;
    78         S IEN=$O(^HLD(779.3,"B","PURGE OLD MESSAGES",0))
    79         Q:'IEN
    80         S ^HLD(779.3,IEN,0)="PURGE OLD MESSAGES^1^0^2^20^^5^GETWORK^HLOPURGE^DOWORK^HLOPURGE^1^0"
    81         Q
    82         ;
    83 P137    ;
    84         ;move the existing errros to the new structure
    85         N TYPE
    86         K ^TMP($J,"HLO ERRORS")
    87         F TYPE="TF","SE","AE" D
    88         .M ^TMP($J,"HLO ERRORS",TYPE)=^HLB("ERRORS",TYPE)
    89         .M ^HLB("ERRORS")=^TMP($J,"HLO ERRORS",TYPE)
    90         .K ^TMP($J,"HLO ERRORS",TYPE)
    91         .K ^HLB("ERRORS",TYPE)
    92         Q
     1HLOPOST ;IRMFO-ALB/CJM -Post-Install routine for HLO;03/24/2004  14:43 ;05/03/2007
     2 ;;1.6;HEALTH LEVEL SEVEN;**126,134,136**;Oct 13, 1995;Build 9
     3 ;
     4 N SYSTEM,DATA,VASITE,OLDSITE
     5 D IDXLINKS
     6 D SYSPARMS^HLOSITE(.SYSTEM)
     7 S VASITE=$$SITE^VASITE
     8 S OLDSITE=$G(^HLCS(869.3,1,0))
     9 S DATA(.01)=SYSTEM("DOMAIN")
     10 I DATA(.01)="" D
     11 .I $P(OLDSITE,"^",2) S DATA(.01)="HL7."_$P($G(^DIC(4.2,$P(OLDSITE,"^",2),0)),"^")
     12 I DATA(.01)="" D
     13 .N INST,DOMAIN
     14 .S INST=$P(VASITE,"^")
     15 .Q:'INST
     16 .S DOMAIN=$P($G(^DIC(4,INST,6)),"^")
     17 .I DOMAIN S DOMAIN=$P($G(^DIC(4.2,DOMAIN,0)),"^") I DOMAIN'="" S DATA(.01)="HL7."_DOMAIN
     18 I DATA(.01)="" D BMES^XPDUTL("Post-Install failed, system missing INSTITUTION or DOMAIN file entry") Q
     19 S DATA(.02)=SYSTEM("STATION")
     20 I DATA(.02)="",$P(OLDSITE,"^",4) S DATA(.02)=$P($G(^DIC(4,$P(OLDSITE,"^",4),99)),"^")
     21 I DATA(.02)="" S DATA(.02)=$P(VASITE,"^",3)
     22 S DATA(.03)=$P(OLDSITE,"^",3)
     23 S DATA(.04)=SYSTEM("MAXSTRING")
     24 S DATA(.05)=SYSTEM("HL7 BUFFER")
     25 S DATA(.06)=SYSTEM("USER BUFFER")
     26 S DATA(.07)=SYSTEM("NORMAL PURGE")
     27 S DATA(.08)=SYSTEM("ERROR PURGE")
     28 I $D(^HLD(779.1,1,0)) D
     29 .N ERROR
     30 .I '$$UPD^HLOASUB1(779.1,1,.DATA,.ERROR) D BMES^XPDUTL("Post-Install failed -"_$G(ERROR))
     31 E  D
     32 .N ERROR
     33 .I '$$ADD^HLOASUB1(779.1,,.DATA,.ERROR,1) D BMES^XPDUTL("Post-Install failed -"_$G(ERROR))
     34 Q
     35IDXLINKS ;
     36 ;set the "AC" and "AD" indicies on the HL Logical Link file
     37 N DIK
     38 S DIK="^HLCS(870,"
     39 S DIK(1)=".01^AC^AD^AD1^AD2"
     40 D ENALL^DIK
     41 Q
     42 ;
     43P134 ;
     44 N DAILY,STARTUP,IEN,DATA
     45 S DAILY=$O(^DIC(19,"B","HLO DAILY STARTUP",0))
     46 I 'DAILY D BMES^XPDUTL("Failed to schedule the HLO DAILY STARTUP option!")
     47 S STARTUP=$O(^DIC(19,"B","HLO SYSTEM STARTUP",0))
     48 I 'STARTUP D BMES^XPDUTL("Failed to schedule the HLO SYSTEM STARTUP option!")
     49 I STARTUP D
     50 .S IEN=$O(^DIC(19.2,"B",STARTUP,0))
     51 .S DATA(.01)=STARTUP
     52 .S DATA(2)=""
     53 .S DATA(6)=""
     54 .S DATA(9)=$S($P($G(^HLD(779.1,1,0)),"^",3)="P":"S",1:"")
     55 .I IEN D
     56 ..I '$$UPD^HLOASUB1(19.2,IEN,.DATA) D BMES^XPDUTL("Failed to schedule the HLO SYSTEM STARTUP option!")
     57 .E  D
     58 ..I '$$ADD^HLOASUB1(19.2,,.DATA) D BMES^XPDUTL("Failed to schedule the HLO SYSTEM STARTUP option!")
     59 I DAILY D
     60 .S IEN=$O(^DIC(19.2,"B",DAILY,0))
     61 .S DATA(.01)=DAILY
     62 .S DATA(2)=$$NOW^XLFDT
     63 .S DATA(6)="1D"
     64 .S DATA(9)=""
     65 .I IEN D
     66 ..I '$$UPD^HLOASUB1(19.2,IEN,.DATA) D BMES^XPDUTL("Failed to schedule the HLO DAILY STARTUP option!")
     67 .E  D
     68 ..I '$$ADD^HLOASUB1(19.2,,.DATA) D BMES^XPDUTL("Failed to schedule the HLO DAILY STARTUP option!")
     69 Q
     70 ;
     71P136 ;post-install routine for HL*1.6*136
     72 N ERROR,DIFROM,IEN
     73 I $P($G(^HLD(779.1,1,0)),"^",3)="P" D
     74 .D RESCH^XUTMOPT("HLO DAILY STARTUP",$$FMADD^XLFDT($$NOW^XLFDT,,1),,"1D","L",.ERROR)
     75 .I $G(ERROR)<0 D BMES^XPDUTL("Failed to schedule the HLO DAILY STARTUP option! Please do so manually")
     76 ;
     77 S IEN=$O(^HLD(779.3,"B","PURGE OLD MESSAGES",0))
     78 Q:'IEN
     79 S ^HLD(779.3,IEN,0)="PURGE OLD MESSAGES^1^0^2^20^^5^GETWORK^HLOPURGE^DOWORK^HLOPURGE^1^0"
     80 Q
Note: See TracChangeset for help on using the changeset viewer.