ACDPPFIX.m

ACDPPFIX ;IHS/ADC/EDE/KML - fix files pointing to patient;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

 ;Go through CDMIS files and repoint bad patient pointers to 885.

 ;

START ;

 D ^XBKVAR

 NEW F,P

 W !,"Checking CDMIS patient pointers"

 S ACDTIEN=0,ACDGBL="^ACDVIS(",ACDFP="4;5"

 F  S ACDTIEN=$O(^ACDVIS(ACDTIEN)) Q:'ACDTIEN  I $D(^ACDVIS(ACDTIEN,0)) S X=^(0) D CHK

 S ACDTIEN=0,ACDGBL="^ACDINTV(",ACDFP="1;2"

 F  S ACDTIEN=$O(^ACDINTV(ACDTIEN)) Q:'ACDTIEN  I $D(^ACDINTV(ACDTIEN,0)) S X=^(0) D CHK

 S ACDTIEN=0

 F  S ACDTIEN=$O(^ACDPAT(ACDTIEN)) Q:'ACDTIEN  I $D(^ACDPAT(ACDTIEN,0)) D

 .  S ACDMIEN=0

 .  F  S ACDMIEN=$O(^ACDPAT(ACDTIEN,1,ACDMIEN)) Q:'ACDMIEN  D

 ..  I $D(^DPT(ACDMIEN,0)),$D(^AUPNPAT(ACDMIEN,0)) Q  ; pointer is good

 ..  S DIK="^ACDPAT("_ACDTIEN_",1,",DA=ACDMIEN,DA(1)=ACDTIEN

 ..  D DIK^ACDFMC

 ..  W "|"

 ..  Q

 .  Q

 Q

 ;

CHK ; CHECK FOR BAD PATIENT POINTERS

 W:'(ACDTIEN#100) "."

 S F=$P(ACDFP,";"),P=$P(ACDFP,";",2)

 S Y=$P(X,U,P)

 Q:'Y  ;                                  no patient pointer

 I $D(^DPT(Y,0)),$D(^AUPNPAT(Y,0)) Q  ;   pointer is good

 S DIE=ACDGBL,DA=ACDTIEN,DR=F_"////885"

 D DIE^ACDFMC

 I $D(Y) W !,"Modify of "_ACDGBL_" failed for entry ",ACDTIEN Q

 W "|"

 Q

ACDPPFIX  ;IHS/ADC/EDE/KML - fix files pointing to patient;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

 +3       ;Go through CDMIS files and repoint bad patient pointers to 885.

 +4       ;

START     ;

 +1        DO ^XBKVAR

 +2        NEW F,P

 +3        WRITE !,"Checking CDMIS patient pointers"

 +4        SET ACDTIEN=0

           SET ACDGBL="^ACDVIS("

           SET ACDFP="4;5"

 +5        FOR 

               SET ACDTIEN=$ORDER(^ACDVIS(ACDTIEN))

               IF 'ACDTIEN

                   QUIT 

               IF $DATA(^ACDVIS(ACDTIEN,0))

                   SET X=^(0)

                   DO CHK

 +6        SET ACDTIEN=0

           SET ACDGBL="^ACDINTV("

           SET ACDFP="1;2"

 +7        FOR 

               SET ACDTIEN=$ORDER(^ACDINTV(ACDTIEN))

               IF 'ACDTIEN

                   QUIT 

               IF $DATA(^ACDINTV(ACDTIEN,0))

                   SET X=^(0)

                   DO CHK

 +8        SET ACDTIEN=0

 +9        FOR 

               SET ACDTIEN=$ORDER(^ACDPAT(ACDTIEN))

               IF 'ACDTIEN

                   QUIT 

               IF $DATA(^ACDPAT(ACDTIEN,0))

                   Begin DoDot:1

 +10                   SET ACDMIEN=0

 +11                   FOR 

                           SET ACDMIEN=$ORDER(^ACDPAT(ACDTIEN,1,ACDMIEN))

                           IF 'ACDMIEN

                               QUIT 

                           Begin DoDot:2

 +12      ; pointer is good

                               IF $DATA(^DPT(ACDMIEN,0))

                                   IF $DATA(^AUPNPAT(ACDMIEN,0))

                                       QUIT 

 +13                           SET DIK="^ACDPAT("_ACDTIEN_",1,"

                               SET DA=ACDMIEN

                               SET DA(1)=ACDTIEN

 +14                           DO DIK^ACDFMC

 +15                           WRITE "|"

 +16                           QUIT 

                           End DoDot:2

 +17                   QUIT 

                   End DoDot:1

 +18       QUIT 

 +19      ;

CHK       ; CHECK FOR BAD PATIENT POINTERS

 +1        IF '(ACDTIEN#100)

               WRITE "."

 +2        SET F=$PIECE(ACDFP,";")

           SET P=$PIECE(ACDFP,";",2)

 +3        SET Y=$PIECE(X,U,P)

 +4       ;                                  no patient pointer

           IF 'Y

               QUIT 

 +5       ;   pointer is good

           IF $DATA(^DPT(Y,0))

               IF $DATA(^AUPNPAT(Y,0))

                   QUIT 

 +6        SET DIE=ACDGBL

           SET DA=ACDTIEN

           SET DR=F_"////885"

 +7        DO DIE^ACDFMC

 +8        IF $DATA(Y)

               WRITE !,"Modify of "_ACDGBL_" failed for entry ",ACDTIEN

               QUIT 

 +9        WRITE "|"

 +10       QUIT