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
