BDMSDX ; IHS/CMI/LAB - SWITCH CMS DIAGNOSIS LIST ENTRY ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4**;JUN 14, 2007
;
;This routine provides a utility to standardize entires in the CMS
;DIAGNOSIS LIST ENTRY file for diabetes related diagnoses.
;
EN ;EP
F D EN1 Q:$D(BDMQUIT)!$D(BDMOUT)
EXIT K BDMQUIT,BDMOUT,BDMDX,BDMX,BDMY,BDMNEW,BDMOLD,BDMJ
Q
EN1 D EXIT
D NEW
Q:$D(BDMQUIT)
D OLD
Q:$D(BDMQUIT)!'$D(BDMDX)
D SURE
I $D(BDMQUIT) K BDMQUIT Q
D POINT
Q
NEW ;LIST NEW DMS DIAGNOSES AND SELECT DX TO UPDATE
W @IOF
W !,"Select the DMS DIAGNOSIS"
S DIR(0)="SO^1:TYPE 1;2:TYPE 2;3:GESTATIONAL DM;4:IMPAIRED GLUCOSE TOLERANCE"
S DIR("A")="Which DX"
D DIR^BDMFDIC
I Y<1 S BDMQUIT="" Q
S BDMX=$O(^ACM(44.1,"B",Y(0),0))
I 'BDMX S BDMQUIT="" Q
S BDMX=BDMX_U_$P(^ACM(44.1,BDMX,0),U)
Q
OLD ;SELECT OLD CMS DIAGNOSES TO REPORT TO NEW DMS DIAGNOSIS
S J=0
F D O1 Q:$D(BDMQUIT)!$D(BDMOUT)
K BDMQUIT
Q
O1 D LOLD
S DIC="^ACM(44.1,"
S DIC(0)="AEMQZ"
S DIC("A")="CMS DIAGNOSIS LIST ENTRY: "
W !
D DIC^BDMFDIC
I Y<1 S BDMQUIT="" Q
I +Y=+BDMX W !!,"Same as current Official DMS Diagnosis" H 3 Q
S J=J+1
S BDMDX(J)=+Y_U_Y(0)
Q
LOLD ;LIST OLD DX'S
W @IOF
W !,"Current CMS DIAGNOSIS LIST ENTRIES that will be changed to:"
W !?5,$P(BDMX,U,2)
W !!?5,"NO.",?10,"NAME"
W !?5,"---",?10,"------------------------------"
N X
S X=0
F S X=$O(BDMDX(X)) Q:'X D
.W !?5,X,?10,$P(BDMDX(X),U,2)
Q
SURE ;LIST CHANGES TO BE MADE AND AFIRM
S DIR(0)="YO"
S DIR("A")="Are you certain you want to make these changes"
S DIR("B")="NO"
W !
D DIR^BDMFDIC
I Y'=1 S BDMQUIT="" Q
Q
POINT ;RE-POINT OLD CMS ENTRIES TO NEW DMS DX
N BDM,BDMJ
S BDMJ=0
F S BDMJ=$O(BDMDX(BDMJ)) Q:'BDMJ D P1
Q
P1 N BDMNEW,BDMOLD
;S BDMNEW=+BDMX ;maw orig
S BDMNEW=$P(BDMX,U,2) ;maw mod because of 4 slash stuff below not allowed 9/7/06
S BDMOLD=+BDMDX(BDMJ)
S BDMDA=0
F S BDMDA=$O(^ACM(44,"B",BDMOLD,BDMDA)) Q:'BDMDA D
.S DA=BDMDA
.S DIE="^ACM(44,"
.S DR=".01///"_BDMNEW
.W "."
.D DIE^BDMFDIC
S DA=+BDMDX(BDMJ)
S DIE="^ACM(44.1,"
S DR=".01///"_"ZZ "_$P(BDMDX(BDMJ),U,2)
W "."
D DIE^BDMFDIC
Q
BDMSDX ; IHS/CMI/LAB - SWITCH CMS DIAGNOSIS LIST ENTRY ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4**;JUN 14, 2007
+2 ;
+3 ;This routine provides a utility to standardize entires in the CMS
+4 ;DIAGNOSIS LIST ENTRY file for diabetes related diagnoses.
+5 ;
EN ;EP
+1 FOR
DO EN1
IF $DATA(BDMQUIT)!$DATA(BDMOUT)
QUIT
EXIT KILL BDMQUIT,BDMOUT,BDMDX,BDMX,BDMY,BDMNEW,BDMOLD,BDMJ
+1 QUIT
EN1 DO EXIT
+1 DO NEW
+2 IF $DATA(BDMQUIT)
QUIT
+3 DO OLD
+4 IF $DATA(BDMQUIT)!'$DATA(BDMDX)
QUIT
+5 DO SURE
+6 IF $DATA(BDMQUIT)
KILL BDMQUIT
QUIT
+7 DO POINT
+8 QUIT
NEW ;LIST NEW DMS DIAGNOSES AND SELECT DX TO UPDATE
+1 WRITE @IOF
+2 WRITE !,"Select the DMS DIAGNOSIS"
+3 SET DIR(0)="SO^1:TYPE 1;2:TYPE 2;3:GESTATIONAL DM;4:IMPAIRED GLUCOSE TOLERANCE"
+4 SET DIR("A")="Which DX"
+5 DO DIR^BDMFDIC
+6 IF Y<1
SET BDMQUIT=""
QUIT
+7 SET BDMX=$ORDER(^ACM(44.1,"B",Y(0),0))
+8 IF 'BDMX
SET BDMQUIT=""
QUIT
+9 SET BDMX=BDMX_U_$PIECE(^ACM(44.1,BDMX,0),U)
+10 QUIT
OLD ;SELECT OLD CMS DIAGNOSES TO REPORT TO NEW DMS DIAGNOSIS
+1 SET J=0
+2 FOR
DO O1
IF $DATA(BDMQUIT)!$DATA(BDMOUT)
QUIT
+3 KILL BDMQUIT
+4 QUIT
O1 DO LOLD
+1 SET DIC="^ACM(44.1,"
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="CMS DIAGNOSIS LIST ENTRY: "
+4 WRITE !
+5 DO DIC^BDMFDIC
+6 IF Y<1
SET BDMQUIT=""
QUIT
+7 IF +Y=+BDMX
WRITE !!,"Same as current Official DMS Diagnosis"
HANG 3
QUIT
+8 SET J=J+1
+9 SET BDMDX(J)=+Y_U_Y(0)
+10 QUIT
LOLD ;LIST OLD DX'S
+1 WRITE @IOF
+2 WRITE !,"Current CMS DIAGNOSIS LIST ENTRIES that will be changed to:"
+3 WRITE !?5,$PIECE(BDMX,U,2)
+4 WRITE !!?5,"NO.",?10,"NAME"
+5 WRITE !?5,"---",?10,"------------------------------"
+6 NEW X
+7 SET X=0
+8 FOR
SET X=$ORDER(BDMDX(X))
IF 'X
QUIT
Begin DoDot:1
+9 WRITE !?5,X,?10,$PIECE(BDMDX(X),U,2)
End DoDot:1
+10 QUIT
SURE ;LIST CHANGES TO BE MADE AND AFIRM
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Are you certain you want to make these changes"
+3 SET DIR("B")="NO"
+4 WRITE !
+5 DO DIR^BDMFDIC
+6 IF Y'=1
SET BDMQUIT=""
QUIT
+7 QUIT
POINT ;RE-POINT OLD CMS ENTRIES TO NEW DMS DX
+1 NEW BDM,BDMJ
+2 SET BDMJ=0
+3 FOR
SET BDMJ=$ORDER(BDMDX(BDMJ))
IF 'BDMJ
QUIT
DO P1
+4 QUIT
P1 NEW BDMNEW,BDMOLD
+1 ;S BDMNEW=+BDMX ;maw orig
+2 ;maw mod because of 4 slash stuff below not allowed 9/7/06
SET BDMNEW=$PIECE(BDMX,U,2)
+3 SET BDMOLD=+BDMDX(BDMJ)
+4 SET BDMDA=0
+5 FOR
SET BDMDA=$ORDER(^ACM(44,"B",BDMOLD,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+6 SET DA=BDMDA
+7 SET DIE="^ACM(44,"
+8 SET DR=".01///"_BDMNEW
+9 WRITE "."
+10 DO DIE^BDMFDIC
End DoDot:1
+11 SET DA=+BDMDX(BDMJ)
+12 SET DIE="^ACM(44.1,"
+13 SET DR=".01///"_"ZZ "_$PIECE(BDMDX(BDMJ),U,2)
+14 WRITE "."
+15 DO DIE^BDMFDIC
+16 QUIT
