PXRMTEDT ; SLC/PKR - Edit a taxonomy item. ;12/23/2005
;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
;
;===============================================
N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y
GETNAME ;Get the name of the reminder taxonomy to edit.
K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
S DIC="^PXD(811.2,"
S DIC(0)="AEMQL"
S DIC("A")="Select Reminder Taxonomy: "
S DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
S DLAYGO=811.2
;Set the starting place for additions.
D SETSTART^PXRMCOPY(DIC)
W !
D ^DIC
I ($D(DTOUT))!($D(DUOUT)) Q
I Y=-1 G END
S DA=$P(Y,U,1)
S CS1=$$FILE^PXRMEXCS(811.2,DA)
D EDIT(DIC,DA)
;See if any changes have been made, if so do the edit history.
S CS2=$$FILE^PXRMEXCS(811.2,DA)
I CS2'=0,CS2'=CS1 D SEHIST^PXRMUTIL(811.2,DIC,DA)
G GETNAME
END ;
Q
;
;===============================================
EDIT(ROOT,DA) ;
N DIE,DR,DIDEL,RESULT,X
S DIE=ROOT,DIDEL=811.2
S DIE("NO^")="OUTOK"
W !!,"General Taxonomy Data"
NAME S DR=".01"
D ^DIE
;If DA is undefined then the entry was deleted.
I '$D(DA) Q
I $D(Y) Q
;
BD S DR=".02"
D ^DIE
I '$D(DA) Q
I $D(Y) G NAME
;
CLASS ;
;Class
W !!
S DR="100"
D ^DIE
I $D(Y) G BD
;Sponsor
S DR="101"
D ^DIE
I $D(Y) G CLASS
;Make sure Class and Sponsor Class are in synch.
S RESULT=$$VSPONSOR^PXRMINTR(X)
I RESULT=0 G CLASS
;Review date
RD W !!
S DR="102"
D ^DIE
I $D(Y) G CLASS
;
PDS W !!
S DR="4"
D ^DIE
I '$D(DA) Q
I $D(Y) G RD
;
UINP S DR="10"
D ^DIE
I '$D(DA) Q
I $D(Y) G PDS
;
IFL S DR="1.6"
D ^DIE
I '$D(DA) Q
I $D(Y) G UINP
;
ICD0 W !!,"ICD0 Range of Coded Values"
S DR="2103"
S DR(2,811.22103)=".01;1"
D ^DIE
I $D(Y) Q
;
ICD9 W !!,"ICD9 Range of Coded Values"
S DR="2102"
S DR(2,811.22102)=".01;1"
D ^DIE
I $D(Y) G ICD0
;
CPT W !!,"CPT Range of Coded Values"
S DR="2104"
S DR(2,811.22104)=".01;1"
D ^DIE
I $D(Y) G ICD9
Q
;
PXRMTEDT ; SLC/PKR - Edit a taxonomy item. ;12/23/2005
+1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+2 ;
+3 ;===============================================
+4 NEW CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y
GETNAME ;Get the name of the reminder taxonomy to edit.
+1 KILL DA,DIC,DLAYGO,DTOUT,DUOUT,Y
+2 SET DIC="^PXD(811.2,"
+3 SET DIC(0)="AEMQL"
+4 SET DIC("A")="Select Reminder Taxonomy: "
+5 SET DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
+6 SET DLAYGO=811.2
+7 ;Set the starting place for additions.
+8 DO SETSTART^PXRMCOPY(DIC)
+9 WRITE !
+10 DO ^DIC
+11 IF ($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+12 IF Y=-1
GOTO END
+13 SET DA=$PIECE(Y,U,1)
+14 SET CS1=$$FILE^PXRMEXCS(811.2,DA)
+15 DO EDIT(DIC,DA)
+16 ;See if any changes have been made, if so do the edit history.
+17 SET CS2=$$FILE^PXRMEXCS(811.2,DA)
+18 IF CS2'=0
IF CS2'=CS1
DO SEHIST^PXRMUTIL(811.2,DIC,DA)
+19 GOTO GETNAME
END ;
+1 QUIT
+2 ;
+3 ;===============================================
EDIT(ROOT,DA) ;
+1 NEW DIE,DR,DIDEL,RESULT,X
+2 SET DIE=ROOT
SET DIDEL=811.2
+3 SET DIE("NO^")="OUTOK"
+4 WRITE !!,"General Taxonomy Data"
NAME SET DR=".01"
+1 DO ^DIE
+2 ;If DA is undefined then the entry was deleted.
+3 IF '$DATA(DA)
QUIT
+4 IF $DATA(Y)
QUIT
+5 ;
BD SET DR=".02"
+1 DO ^DIE
+2 IF '$DATA(DA)
QUIT
+3 IF $DATA(Y)
GOTO NAME
+4 ;
CLASS ;
+1 ;Class
+2 WRITE !!
+3 SET DR="100"
+4 DO ^DIE
+5 IF $DATA(Y)
GOTO BD
+6 ;Sponsor
+7 SET DR="101"
+8 DO ^DIE
+9 IF $DATA(Y)
GOTO CLASS
+10 ;Make sure Class and Sponsor Class are in synch.
+11 SET RESULT=$$VSPONSOR^PXRMINTR(X)
+12 IF RESULT=0
GOTO CLASS
+13 ;Review date
RD WRITE !!
+1 SET DR="102"
+2 DO ^DIE
+3 IF $DATA(Y)
GOTO CLASS
+4 ;
PDS WRITE !!
+1 SET DR="4"
+2 DO ^DIE
+3 IF '$DATA(DA)
QUIT
+4 IF $DATA(Y)
GOTO RD
+5 ;
UINP SET DR="10"
+1 DO ^DIE
+2 IF '$DATA(DA)
QUIT
+3 IF $DATA(Y)
GOTO PDS
+4 ;
IFL SET DR="1.6"
+1 DO ^DIE
+2 IF '$DATA(DA)
QUIT
+3 IF $DATA(Y)
GOTO UINP
+4 ;
ICD0 WRITE !!,"ICD0 Range of Coded Values"
+1 SET DR="2103"
+2 SET DR(2,811.22103)=".01;1"
+3 DO ^DIE
+4 IF $DATA(Y)
QUIT
+5 ;
ICD9 WRITE !!,"ICD9 Range of Coded Values"
+1 SET DR="2102"
+2 SET DR(2,811.22102)=".01;1"
+3 DO ^DIE
+4 IF $DATA(Y)
GOTO ICD0
+5 ;
CPT WRITE !!,"CPT Range of Coded Values"
+1 SET DR="2104"
+2 SET DR(2,811.22104)=".01;1"
+3 DO ^DIE
+4 IF $DATA(Y)
GOTO ICD9
+5 QUIT
+6 ;
