- ADEXCOD2 ; IHS/HQT/MJL - UPDATE ADA CODE FILE PART 3 ;08:45 PM [ 03/24/1999 9:04 AM ]
- ;;6.0;ADE;;APRIL 1999
- ;CHECK FOR DUPES IN AUTTADA
- D DUPE
- ;KILL AND REBUILD ALL XREFS
- D REBLD
- ;
- END K ^ADEUTIL("ADEXCOD") ;^ADEUTIL("ADEXCOD") transient global
- Q
- ;
- DUPE N ADEX,ADECOD,ADE,ADEXFRM
- K ^ADEUTIL("ADEXCOD")
- S ADEX=0 F S ADEX=$O(^AUTTADA(ADEX)) Q:'+ADEX D D1
- Q
- D1 W "." ;***TEST FOR INTERACTIVE MODE
- Q:$P(^AUTTADA(ADEX,0),U,8)]"" ;FHL 9/9/98;IHS/HMW P2
- S ADECOD=$P(^AUTTADA(ADEX,0),U)
- I $D(^ADEUTIL("ADEXCOD",ADECOD)) D FIX
- S ^ADEUTIL("ADEXCOD",ADECOD)=ADEX ;transient working global
- Q
- FIX ;IF DUPES ARE LOCATED, SET EARLIEST ONE(S) (BY DFN) TO INACTIVE
- ; (IF IT'S NOT INACTIVE ALREADY)
- S ADE("FIRST")=^ADEUTIL("ADEXCOD",ADECOD)
- W !,"Duplicate Code ",ADECOD," at DFN ",ADE("FIRST")," and ",ADEX,".",!,"Code at DFN ",ADE("FIRST")," inactive. Inactivation date: "
- I $P(^AUTTADA(ADE("FIRST"),0),U,8)="" D Q
- . S X=DT
- . S ADEXFRM=$P(^DD(9999999.31,.08,0),U,5,99) ;Input Transform
- . W "TODAY"
- . X ADEXFRM
- . S:$D(X) $P(^AUTTADA(ADE("FIRST"),0),U,8)=X
- S Y=$P(^AUTTADA(ADE("FIRST"),0),U,8) X ^DD("DD") W Y,!
- Q
- ;
- REBLD ;
- N ADEX
- ;Kill cross-references prior to reindex:
- F ADEX="B","BA","C","D","AC" K ^AUTTADA(ADEX)
- S DIK="^AUTTADA("
- D IXALL^DIK
- Q
- ADEXCOD2 ; IHS/HQT/MJL - UPDATE ADA CODE FILE PART 3 ;08:45 PM [ 03/24/1999 9:04 AM ]
- +1 ;;6.0;ADE;;APRIL 1999
- +2 ;CHECK FOR DUPES IN AUTTADA
- +3 DO DUPE
- +4 ;KILL AND REBUILD ALL XREFS
- +5 DO REBLD
- +6 ;
- END ;^ADEUTIL("ADEXCOD") transient global
- KILL ^ADEUTIL("ADEXCOD")
- +1 QUIT
- +2 ;
- DUPE NEW ADEX,ADECOD,ADE,ADEXFRM
- +1 KILL ^ADEUTIL("ADEXCOD")
- +2 SET ADEX=0
- FOR
- SET ADEX=$ORDER(^AUTTADA(ADEX))
- IF '+ADEX
- QUIT
- DO D1
- +3 QUIT
- D1 ;***TEST FOR INTERACTIVE MODE
- WRITE "."
- +1 ;FHL 9/9/98;IHS/HMW P2
- IF $PIECE(^AUTTADA(ADEX,0),U,8)]""
- QUIT
- +2 SET ADECOD=$PIECE(^AUTTADA(ADEX,0),U)
- +3 IF $DATA(^ADEUTIL("ADEXCOD",ADECOD))
- DO FIX
- +4 ;transient working global
- SET ^ADEUTIL("ADEXCOD",ADECOD)=ADEX
- +5 QUIT
- FIX ;IF DUPES ARE LOCATED, SET EARLIEST ONE(S) (BY DFN) TO INACTIVE
- +1 ; (IF IT'S NOT INACTIVE ALREADY)
- +2 SET ADE("FIRST")=^ADEUTIL("ADEXCOD",ADECOD)
- +3 WRITE !,"Duplicate Code ",ADECOD," at DFN ",ADE("FIRST")," and ",ADEX,".",!,"Code at DFN ",ADE("FIRST")," inactive. Inactivation date: "
- +4 IF $PIECE(^AUTTADA(ADE("FIRST"),0),U,8)=""
- Begin DoDot:1
- +5 SET X=DT
- +6 ;Input Transform
- SET ADEXFRM=$PIECE(^DD(9999999.31,.08,0),U,5,99)
- +7 WRITE "TODAY"
- +8 XECUTE ADEXFRM
- +9 IF $DATA(X)
- SET $PIECE(^AUTTADA(ADE("FIRST"),0),U,8)=X
- End DoDot:1
- QUIT
- +10 SET Y=$PIECE(^AUTTADA(ADE("FIRST"),0),U,8)
- XECUTE ^DD("DD")
- WRITE Y,!
- +11 QUIT
- +12 ;
- REBLD ;
- +1 NEW ADEX
- +2 ;Kill cross-references prior to reindex:
- +3 FOR ADEX="B","BA","C","D","AC"
- KILL ^AUTTADA(ADEX)
- +4 SET DIK="^AUTTADA("
- +5 DO IXALL^DIK
- +6 QUIT