ACHSREV.m

ACHSREV ; IHS/ITSC/PMF - STANDALONE TO CLEAN AUTTREVN CROSS-REFERENCES ;   [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 ;NOTE: Currently, the diag lines are in effect

 ;It is recommended that this routine be run with diag lines in effect

 ;

 ;When it is determined that the nodes that display on the screen are

 ;the correct nodes to be killed, disable the 3 diag lines and then run

 ;

 ;EP

 D REV,ADA,CPT

 Q

REV S (REV,TOT)=0

 F  S REV=$O(^AUTTREVN(REV)) Q:'REV  D

 .S TMP=$G(^AUTTREVN(REV,0))

 .D CK

 Q

CK ; Find unknown description in 0 node and kill X-references

 ; Leave 0 node in case of pointers in other files

 ; REVN=The real revenue code in the .01 field

 ; REV will be the bogus code set by chs

 Q:TMP'["unknown"

DIAG ;

 W !,REV,?10,TMP S TOT=TOT+1 Q

 S REVN=$P(TMP,"^",1),DESC=$P(TMP,"^",2)

 K ^AUTTREVN("B",REVN,REV)

 K ^AUTTREVN("C",DESC,REV)

 K ^AUTTREVN("E",DESC,REV)

 S TOT=TOT+1

 Q

ADA S (ADA,TOT)=0

 F  S ADA=$O(^AUTTADA(ADA)) Q:'ADA  D

 .S TMP=$G(^AUTTADA(ADA,0))

 .D CK2

 Q

CK2 ; Find unknown description in 0 node and kill X-references

 Q:$P(TMP,"^",2)'="unknown"

DIAG2 ;

 W !,ADA,?10,TMP S TOT=TOT+1 Q

 S ADAN=$P(TMP,"^",1),DESC=$P(TMP,"^",2)

 K ^AUTTADA("B",ADAN,ADA)

 K ^AUTTADA("C",DESC,ADA)

 S TOT=TOT+1

 Q

CPT ;

 S (CPT,TOT)=0

 F  S CPT=$O(^ICPT(CPT)) Q:'CPT  D

 .S TMP=$G(^ICPT(CPT,0))

 .D CK3

 Q

CK3 ; Find unknown description in 0 node and kill X-references

 ; Leave 0 node in case of pointers in other files

 ; CPTN=The real revenue code in the .01 field

 ; CPT will be the bogus code set by chs

 Q:TMP'["unknown"

DIAG3 ;

 W !,CPT,?10,TMP S TOT=TOT+1 Q

 S CPTN=$P(TMP,"^",1),DESC=$P(TMP,"^",2)

 K ^ICPT("B",CPTN,CPT)

 K ^ICPT("C",DESC,CPT)

 K ^ICPT("E",DESC,CPT)

 S TOT=TOT+1

 Q

ACHSREV   ; IHS/ITSC/PMF - STANDALONE TO CLEAN AUTTREVN CROSS-REFERENCES ;   [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3       ;NOTE: Currently, the diag lines are in effect

 +4       ;It is recommended that this routine be run with diag lines in effect

 +5       ;

 +6       ;When it is determined that the nodes that display on the screen are

 +7       ;the correct nodes to be killed, disable the 3 diag lines and then run

 +8       ;

 +9       ;EP

 +10       DO REV

           DO ADA

           DO CPT

 +11       QUIT 

REV        SET (REV,TOT)=0

 +1        FOR 

               SET REV=$ORDER(^AUTTREVN(REV))

               IF 'REV

                   QUIT 

               Begin DoDot:1

 +2                SET TMP=$GET(^AUTTREVN(REV,0))

 +3                DO CK

               End DoDot:1

 +4        QUIT 

CK        ; Find unknown description in 0 node and kill X-references

 +1       ; Leave 0 node in case of pointers in other files

 +2       ; REVN=The real revenue code in the .01 field

 +3       ; REV will be the bogus code set by chs

 +4        IF TMP'["unknown"

               QUIT 

DIAG      ;

 +1        WRITE !,REV,?10,TMP

           SET TOT=TOT+1

           QUIT 

 +2        SET REVN=$PIECE(TMP,"^",1)

           SET DESC=$PIECE(TMP,"^",2)

 +3        KILL ^AUTTREVN("B",REVN,REV)

 +4        KILL ^AUTTREVN("C",DESC,REV)

 +5        KILL ^AUTTREVN("E",DESC,REV)

 +6        SET TOT=TOT+1

 +7        QUIT 

ADA        SET (ADA,TOT)=0

 +1        FOR 

               SET ADA=$ORDER(^AUTTADA(ADA))

               IF 'ADA

                   QUIT 

               Begin DoDot:1

 +2                SET TMP=$GET(^AUTTADA(ADA,0))

 +3                DO CK2

               End DoDot:1

 +4        QUIT 

CK2       ; Find unknown description in 0 node and kill X-references

 +1        IF $PIECE(TMP,"^",2)'="unknown"

               QUIT 

DIAG2     ;

 +1        WRITE !,ADA,?10,TMP

           SET TOT=TOT+1

           QUIT 

 +2        SET ADAN=$PIECE(TMP,"^",1)

           SET DESC=$PIECE(TMP,"^",2)

 +3        KILL ^AUTTADA("B",ADAN,ADA)

 +4        KILL ^AUTTADA("C",DESC,ADA)

 +5        SET TOT=TOT+1

 +6        QUIT 

CPT       ;

 +1        SET (CPT,TOT)=0

 +2        FOR 

               SET CPT=$ORDER(^ICPT(CPT))

               IF 'CPT

                   QUIT 

               Begin DoDot:1

 +3                SET TMP=$GET(^ICPT(CPT,0))

 +4                DO CK3

               End DoDot:1

 +5        QUIT 

CK3       ; Find unknown description in 0 node and kill X-references

 +1       ; Leave 0 node in case of pointers in other files

 +2       ; CPTN=The real revenue code in the .01 field

 +3       ; CPT will be the bogus code set by chs

 +4        IF TMP'["unknown"

               QUIT 

DIAG3     ;

 +1        WRITE !,CPT,?10,TMP

           SET TOT=TOT+1

           QUIT 

 +2        SET CPTN=$PIECE(TMP,"^",1)

           SET DESC=$PIECE(TMP,"^",2)

 +3        KILL ^ICPT("B",CPTN,CPT)

 +4        KILL ^ICPT("C",DESC,CPT)

 +5        KILL ^ICPT("E",DESC,CPT)

 +6        SET TOT=TOT+1

 +7        QUIT