ACDPDIF.m

ACDPDIF ;IHS/ADC/EDE/KML - DISPLAY DEMOGRAPHIC DIFFERENCE; 

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

 ;

 ; This routine shows the user the differences in demographic data

 ; between Patient Registration and CDMIS.

 ;

START ;

 D MAIN

 D EOJ

 Q

 ;

MAIN ; PROCESS PATIENTS UNTIL NO MORE WANTED

 F  D GETPAT Q:ACDQ  D PATIENT

 Q

 ;

GETPAT ; GET CLIENT/PATIENT

 S ACDQ=1

 S AUPNLK("ALL")=1

 S DIC="^AUPNPAT(",DIC(0)="AEMQ",DIC("S")="I $D(^ACDVIS(""D"",+Y))" D DIC^ACDFMC

 K AUPNLK("ALL")

 Q:Y<0

 S ACDDFNP=+Y,ACDDFN=$P(^DPT(ACDDFNP,0),U)

 S ACDQ=0

 Q

 ;

PATIENT ; PROCESS ONE PATIENT

 D GETREG^ACDDEGP2

 S ACDY=0

 D GETCDMIS^ACDDEGP2

 I 'ACDY W !,"----------",!,"Not a CDMIS patient!",!,"----------",! Q

 S ACDAGE=$P(^ACDVIS(ACDY,0),U,16) ;    I don't like this but expediant

 D DSPDIFF

 Q:'ACDY

 D DEV^ACDDEU Q:ACDQ

 I $D(ACDSLAVE)!(IO'=IO(0)) D DSPDIFF

 K ACDSLAVE S IO=IO(0)

 Q

 ;

DSPDIFF ; DISPLAY DIFFERENCES IN DEMO DATA VALUES  

 I $D(IO("Q")) D  Q

 . S ZTRTN="DSPDIFFQ^ACDPDIF",ZTDESC="CDMIS DEMO DIFFERENCES",ZTDTH=$H,ZTSAVE("ACD*")=""

 . D ^%ZTLOAD

 . Q

 D DSPDIFFQ

 U 0

 I 'ACDY W !,"No differences found",!

 Q

 ;

DSPDIFFQ ; EP - FOR TASKMAN

 I $D(ACDSLAVE) S IOP=ACDSLAVE D ^%ZIS

 U IO

 W:IO'=IO(0) @IOF

 W !!

 S ACDY=0 F X="ACDSEX","ACDAGE","ACDVET","ACDSTANM","ACDTRBN" D

 . S Y=$S(X="ACDSEX":1,X="ACDAGE":2,X="ACDVET":3,X="ACDSTANM":4,1:5)

 . I @X'=ACDPRD(X) D:'ACDY  W ?8,$S(Y=1:"SEX",Y=2:"AGE",Y=3:"IS CLIENT A VET (Y/N)",Y=4:"RESIDENT STATE",1:"TRIBE"),": ",ACDPRD(X)," versus our ",$S(@X="":"NULL",1:@X),!

 .. D:$E(IOST,1,2)="P-" CONF^ACDDEU

 .. W !,"PATIENT: ",ACDDFN,!,?4,"PATIENT REGISTRATION DATA DIFFERS FOR THE FOLLOWING ITEMS:",!

 .. S ACDY=1

 .. Q

 . Q

 I $D(ACDSLAVE) W @IOF D ^%ZISC

 I $D(ZTQUEUED) D EOJ S ZTREQ="@"

 Q

 ;

EOJ ;

 D ^%ZISC

 D ^ACDKILL

 Q

ACDPDIF   ;IHS/ADC/EDE/KML - DISPLAY DEMOGRAPHIC DIFFERENCE; 

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

 +2       ;

 +3       ; This routine shows the user the differences in demographic data

 +4       ; between Patient Registration and CDMIS.

 +5       ;

START     ;

 +1        DO MAIN

 +2        DO EOJ

 +3        QUIT 

 +4       ;

MAIN      ; PROCESS PATIENTS UNTIL NO MORE WANTED

 +1        FOR 

               DO GETPAT

               IF ACDQ

                   QUIT 

               DO PATIENT

 +2        QUIT 

 +3       ;

GETPAT    ; GET CLIENT/PATIENT

 +1        SET ACDQ=1

 +2        SET AUPNLK("ALL")=1

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           SET DIC("S")="I $D(^ACDVIS(""D"",+Y))"

           DO DIC^ACDFMC

 +4        KILL AUPNLK("ALL")

 +5        IF Y<0

               QUIT 

 +6        SET ACDDFNP=+Y

           SET ACDDFN=$PIECE(^DPT(ACDDFNP,0),U)

 +7        SET ACDQ=0

 +8        QUIT 

 +9       ;

PATIENT   ; PROCESS ONE PATIENT

 +1        DO GETREG^ACDDEGP2

 +2        SET ACDY=0

 +3        DO GETCDMIS^ACDDEGP2

 +4        IF 'ACDY

               WRITE !,"----------",!,"Not a CDMIS patient!",!,"----------",!

               QUIT 

 +5       ;    I don't like this but expediant

           SET ACDAGE=$PIECE(^ACDVIS(ACDY,0),U,16)

 +6        DO DSPDIFF

 +7        IF 'ACDY

               QUIT 

 +8        DO DEV^ACDDEU

           IF ACDQ

               QUIT 

 +9        IF $DATA(ACDSLAVE)!(IO'=IO(0))

               DO DSPDIFF

 +10       KILL ACDSLAVE

           SET IO=IO(0)

 +11       QUIT 

 +12      ;

DSPDIFF   ; DISPLAY DIFFERENCES IN DEMO DATA VALUES  

 +1        IF $DATA(IO("Q"))

               Begin DoDot:1

 +2                SET ZTRTN="DSPDIFFQ^ACDPDIF"

                   SET ZTDESC="CDMIS DEMO DIFFERENCES"

                   SET ZTDTH=$HOROLOG

                   SET ZTSAVE("ACD*")=""

 +3                DO ^%ZTLOAD

 +4                QUIT 

               End DoDot:1

               QUIT 

 +5        DO DSPDIFFQ

 +6        USE 0

 +7        IF 'ACDY

               WRITE !,"No differences found",!

 +8        QUIT 

 +9       ;

DSPDIFFQ  ; EP - FOR TASKMAN

 +1        IF $DATA(ACDSLAVE)

               SET IOP=ACDSLAVE

               DO ^%ZIS

 +2        USE IO

 +3        IF IO'=IO(0)

               WRITE @IOF

 +4        WRITE !!

 +5        SET ACDY=0

           FOR X="ACDSEX","ACDAGE","ACDVET","ACDSTANM","ACDTRBN"

               Begin DoDot:1

 +6                SET Y=$SELECT(X="ACDSEX":1,X="ACDAGE":2,X="ACDVET":3,X="ACDSTANM":4,1:5)

 +7                IF @X'=ACDPRD(X)

                       IF 'ACDY

                           Begin DoDot:2

 +8                            IF $EXTRACT(IOST,1,2)="P-"

                                   DO CONF^ACDDEU

 +9                            WRITE !,"PATIENT: ",ACDDFN,!,?4,"PATIENT REGISTRATION DATA DIFFERS FOR THE FOLLOWING ITEMS:",!

 +10                           SET ACDY=1

 +11                           QUIT 

                           End DoDot:2

                       WRITE ?8,$SELECT(Y=1:"SEX",Y=2:"AGE",Y=3:"IS CLIENT A VET (Y/N)",Y=4:"RESIDENT STATE",1:"TRIBE"),": ",ACDPRD(X)," versus our ",$SELECT(@X="":"NULL",1:@X),!

 +12               QUIT 

               End DoDot:1

 +13       IF $DATA(ACDSLAVE)

               WRITE @IOF

               DO ^%ZISC

 +14       IF $DATA(ZTQUEUED)

               DO EOJ

               SET ZTREQ="@"

 +15       QUIT 

 +16      ;

EOJ       ;

 +1        DO ^%ZISC

 +2        DO ^ACDKILL

 +3        QUIT