- HLPAT96B ;CIOFO-SF/RJH - HL7 PATCH 96 PRE&POST-INIT ;02/06/03 14:49
- ;;1.6;HEALTH LEVEL SEVEN;**96**;Oct 13, 1995
- ;
- ; Part III of Pre-install and Post-install
- ; Entries: EVN, MSG, SEG, DELETE, and IDOFF, are called from HLPAT96
- Q
- EVN ; find duplicate entries in file #779.001(Event Type)
- N HLEVN,HLIEN,SUB
- S HLEVN=""
- F S HLEVN=$O(^HL(779.001,"B",HLEVN)) Q:HLEVN="" D
- . S HLIEN=0,SUB=0
- . F S HLIEN=$O(^HL(779.001,"B",HLEVN,HLIEN)) Q:'HLIEN D
- .. I $D(^HL(779.001,HLIEN,0)),$P(^HL(779.001,HLIEN,0),"^")=HLEVN D
- ... S SUB=SUB+1
- ... S HLEVNARY(HLEVN,SUB)=HLIEN
- . I SUB=1 K HLEVNARY(HLEVN)
- Q
- MSG ; find duplicate entries in file #771.2(Message Type)
- N HLMSG,HLIEN,SUB
- S HLMSG=""
- F S HLMSG=$O(^HL(771.2,"B",HLMSG)) Q:HLMSG="" D
- . S HLIEN=0,SUB=0
- . F S HLIEN=$O(^HL(771.2,"B",HLMSG,HLIEN)) Q:'HLIEN D
- .. I $D(^HL(771.2,HLIEN,0)),$P(^HL(771.2,HLIEN,0),"^")=HLMSG D
- ... S SUB=SUB+1
- ... S HLMSGARY(HLMSG,SUB)=HLIEN
- . I SUB=1 K HLMSGARY(HLMSG)
- Q
- SEG ; find duplicate entries in file #771.3(Segment Type)
- N HLSEG,HLIEN,SUB
- S HLSEG=""
- F S HLSEG=$O(^HL(771.3,"B",HLSEG)) Q:HLSEG="" D
- . S HLIEN=0,SUB=0
- . F S HLIEN=$O(^HL(771.3,"B",HLSEG,HLIEN)) Q:'HLIEN D
- .. I $D(^HL(771.3,HLIEN,0)),$P(^HL(771.3,HLIEN,0),"^")=HLSEG D
- ... S SUB=SUB+1
- ... S HLSEGARY(HLSEG,SUB)=HLIEN
- . I SUB=1 K HLSEGARY(HLSEG)
- Q
- DELETE ; delete duplicate entries in file #779.001, #771.2 and #771.3
- N HLEVN,HLMSG,HLSEG,HLSUB,DIK,DA
- ; delete duplicate entries in file #779.001
- S HLEVN="",DIK="^HL(779.001,"
- F S HLEVN=$O(HLEVNARY(HLEVN)) Q:HLEVN="" D
- . S HLSUB=1
- . F S HLSUB=$O(HLEVNARY(HLEVN,HLSUB)) Q:'HLSUB D
- .. S DA=HLEVNARY(HLEVN,HLSUB)
- .. D ^DIK
- ;
- ; delete duplicate entries in file #771.2
- S HLMSG="",DIK="^HL(771.2,"
- F S HLMSG=$O(HLMSGARY(HLMSG)) Q:HLMSG="" D
- . S HLSUB=1
- . F S HLSUB=$O(HLMSGARY(HLMSG,HLSUB)) Q:'HLSUB D
- .. S DA=HLMSGARY(HLMSG,HLSUB)
- .. D ^DIK
- ;
- ; delete duplicate entries in file #771.3
- S HLSEG="",DIK="^HL(771.3,"
- F S HLSEG=$O(HLSEGARY(HLSEG)) Q:HLSEG="" D
- . S HLSUB=1
- . F S HLSUB=$O(HLSEGARY(HLSEG,HLSUB)) Q:'HLSUB D
- .. S DA=HLSEGARY(HLSEG,HLSUB)
- .. D ^DIK
- ;
- Q
- IDOFF ; disable identifier for file #779.001 and #771.2
- K ^DD(779.001,0,"ID")
- K ^DD(771.2,0,"ID")
- K ^DD(771.3,0,"ID")
- Q
- POST ;enable identifier for file #779.001 and #771.2
- S ^DD(779.001,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
- S ^DD(771.2,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
- S ^DD(771.3,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLPAT96B 2562 printed Feb 18, 2025@23:26:07 Page 2
- HLPAT96B ;CIOFO-SF/RJH - HL7 PATCH 96 PRE&POST-INIT ;02/06/03 14:49
- +1 ;;1.6;HEALTH LEVEL SEVEN;**96**;Oct 13, 1995
- +2 ;
- +3 ; Part III of Pre-install and Post-install
- +4 ; Entries: EVN, MSG, SEG, DELETE, and IDOFF, are called from HLPAT96
- +5 QUIT
- EVN ; find duplicate entries in file #779.001(Event Type)
- +1 NEW HLEVN,HLIEN,SUB
- +2 SET HLEVN=""
- +3 FOR
- SET HLEVN=$ORDER(^HL(779.001,"B",HLEVN))
- if HLEVN=""
- QUIT
- Begin DoDot:1
- +4 SET HLIEN=0
- SET SUB=0
- +5 FOR
- SET HLIEN=$ORDER(^HL(779.001,"B",HLEVN,HLIEN))
- if 'HLIEN
- QUIT
- Begin DoDot:2
- +6 IF $DATA(^HL(779.001,HLIEN,0))
- IF $PIECE(^HL(779.001,HLIEN,0),"^")=HLEVN
- Begin DoDot:3
- +7 SET SUB=SUB+1
- +8 SET HLEVNARY(HLEVN,SUB)=HLIEN
- End DoDot:3
- End DoDot:2
- +9 IF SUB=1
- KILL HLEVNARY(HLEVN)
- End DoDot:1
- +10 QUIT
- MSG ; find duplicate entries in file #771.2(Message Type)
- +1 NEW HLMSG,HLIEN,SUB
- +2 SET HLMSG=""
- +3 FOR
- SET HLMSG=$ORDER(^HL(771.2,"B",HLMSG))
- if HLMSG=""
- QUIT
- Begin DoDot:1
- +4 SET HLIEN=0
- SET SUB=0
- +5 FOR
- SET HLIEN=$ORDER(^HL(771.2,"B",HLMSG,HLIEN))
- if 'HLIEN
- QUIT
- Begin DoDot:2
- +6 IF $DATA(^HL(771.2,HLIEN,0))
- IF $PIECE(^HL(771.2,HLIEN,0),"^")=HLMSG
- Begin DoDot:3
- +7 SET SUB=SUB+1
- +8 SET HLMSGARY(HLMSG,SUB)=HLIEN
- End DoDot:3
- End DoDot:2
- +9 IF SUB=1
- KILL HLMSGARY(HLMSG)
- End DoDot:1
- +10 QUIT
- SEG ; find duplicate entries in file #771.3(Segment Type)
- +1 NEW HLSEG,HLIEN,SUB
- +2 SET HLSEG=""
- +3 FOR
- SET HLSEG=$ORDER(^HL(771.3,"B",HLSEG))
- if HLSEG=""
- QUIT
- Begin DoDot:1
- +4 SET HLIEN=0
- SET SUB=0
- +5 FOR
- SET HLIEN=$ORDER(^HL(771.3,"B",HLSEG,HLIEN))
- if 'HLIEN
- QUIT
- Begin DoDot:2
- +6 IF $DATA(^HL(771.3,HLIEN,0))
- IF $PIECE(^HL(771.3,HLIEN,0),"^")=HLSEG
- Begin DoDot:3
- +7 SET SUB=SUB+1
- +8 SET HLSEGARY(HLSEG,SUB)=HLIEN
- End DoDot:3
- End DoDot:2
- +9 IF SUB=1
- KILL HLSEGARY(HLSEG)
- End DoDot:1
- +10 QUIT
- DELETE ; delete duplicate entries in file #779.001, #771.2 and #771.3
- +1 NEW HLEVN,HLMSG,HLSEG,HLSUB,DIK,DA
- +2 ; delete duplicate entries in file #779.001
- +3 SET HLEVN=""
- SET DIK="^HL(779.001,"
- +4 FOR
- SET HLEVN=$ORDER(HLEVNARY(HLEVN))
- if HLEVN=""
- QUIT
- Begin DoDot:1
- +5 SET HLSUB=1
- +6 FOR
- SET HLSUB=$ORDER(HLEVNARY(HLEVN,HLSUB))
- if 'HLSUB
- QUIT
- Begin DoDot:2
- +7 SET DA=HLEVNARY(HLEVN,HLSUB)
- +8 DO ^DIK
- End DoDot:2
- End DoDot:1
- +9 ;
- +10 ; delete duplicate entries in file #771.2
- +11 SET HLMSG=""
- SET DIK="^HL(771.2,"
- +12 FOR
- SET HLMSG=$ORDER(HLMSGARY(HLMSG))
- if HLMSG=""
- QUIT
- Begin DoDot:1
- +13 SET HLSUB=1
- +14 FOR
- SET HLSUB=$ORDER(HLMSGARY(HLMSG,HLSUB))
- if 'HLSUB
- QUIT
- Begin DoDot:2
- +15 SET DA=HLMSGARY(HLMSG,HLSUB)
- +16 DO ^DIK
- End DoDot:2
- End DoDot:1
- +17 ;
- +18 ; delete duplicate entries in file #771.3
- +19 SET HLSEG=""
- SET DIK="^HL(771.3,"
- +20 FOR
- SET HLSEG=$ORDER(HLSEGARY(HLSEG))
- if HLSEG=""
- QUIT
- Begin DoDot:1
- +21 SET HLSUB=1
- +22 FOR
- SET HLSUB=$ORDER(HLSEGARY(HLSEG,HLSUB))
- if 'HLSUB
- QUIT
- Begin DoDot:2
- +23 SET DA=HLSEGARY(HLSEG,HLSUB)
- +24 DO ^DIK
- End DoDot:2
- End DoDot:1
- +25 ;
- +26 QUIT
- IDOFF ; disable identifier for file #779.001 and #771.2
- +1 KILL ^DD(779.001,0,"ID")
- +2 KILL ^DD(771.2,0,"ID")
- +3 KILL ^DD(771.3,0,"ID")
- +4 QUIT
- POST ;enable identifier for file #779.001 and #771.2
- +1 SET ^DD(779.001,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
- +2 SET ^DD(771.2,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
- +3 SET ^DD(771.3,0,"ID",2)="W "_""""_" "_""""_",$P(^(0),U,2)"
- +4 QUIT