PXRMTMED ; SLC/PKR/PJH - Edit a reminder term. ;Aug 18, 2020@11:19:40
;;2.0;CLINICAL REMINDERS;**1,4,6,12,26,45,42,65**;Feb 04, 2005;Build 438
;
;=======================================================
N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y
GETNAME ;Get the name of the term to edit.
K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
S DIC="^PXRMD(811.5,"
S DIC(0)="AEMQL"
S DIC("A")="Select Reminder Term: "
S DLAYGO=811.5
;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.5,DA)
D EDIT(DIC,DA)
I $G(DA)="" G GETNAME
S CS2=$$FILE^PXRMEXCS(811.5,DA)
I CS2=0 G GETNAME
I CS2=CS1 G GETNAME
W !!,"Checking integrity of the term ...",!
I '$$TERM^PXRMICK1(DA,.OUTPUT,1) G GETNAME
D SEHIST^PXRMUTIL(811.5,DIC,DA)
G GETNAME
END ;
Q
;
;=======================================================
CLASS(DA,DIE) ;
N DR,RESULT,X,Y
RETRY W !
S DR="100" D ^DIE I $D(Y) Q
;Sponsor
S DR="101" D ^DIE I $D(Y) Q
;Make sure Class and Sponsor Class are in synch.
S RESULT=$$VSPONSOR^PXRMINTR(X)
I RESULT=0 S DIE("NO^")="Other value" G RETRY
I RESULT=1 K DIE("NO^")
;Review date, Usage
S DR="102;1" D ^DIE I $D(Y) Q
Q
;
;=======================================================
EDIT(ROOT,DA) ;
N CLASS,DIC,DIE,DR,DIDEL,PXRMTMD,RESULT,TCONT,Y
;PXRMTMD is set by a xref on the .01 as a flag that the entire
;entry is being deleted.
S CLASS=$P($G(^PXRMD(811.5,DA,100)),U,1)
S DIE=ROOT
I CLASS'="N"!(($G(PXRMINST)=1)&($G(DUZ(0))="@")) D
. S DR=".01"
. D ^DIE
. I $G(DA)'="" D CLASS(DA,DIE)
I $G(DA)="" Q
S TCONT=1
F D FINDING(ROOT,DA) Q:TCONT=0
Q
;
;=======================================================
FINDING(DIE,DA) ;
N CFIEN,GLOB,IEN,LIST,NODE,TERMSTAT,VF,WPIEN
N DEF,DEF1,DEF2,STATUS
S DIE("NO^")="OUTOK"
S STATUS=0
D DEF^PXRMRUTL("811.52",.DEF,.DEF1,.DEF2)
S NODE="^PXRMD(811.5)"
D LIST^PXRMREDT(NODE,DA,.DEF1,.LIST)
D DSPALL^PXRMREDF("T",NODE,DA,.LIST)
S DA(1)=DA
S IEN=DA
S DIC=DIE_DA(1)_",20,"
S DIC(0)="QEAL"
S DIC("A")="Select Finding: "
D ^DIC I Y=-1 S DTOUT=1,TCONT=0 Q
S DIE=DIC
S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB=""
I GLOB="PXRMD(811.4," S CFIEN=$P($P(Y,U,2),";",1) D HELP^PXRMCF(CFIEN)
I GLOB="YTT(601.71," D WARN^PXRMMH
W !,"Editing Finding Number: "_$G(DA)
;Finding record fields
S DR=".01;9;12;17"
I GLOB="PXRMD(811.4," S DR=DR_";26"
;Taxonomy - use inactive problems
I GLOB="PXD(811.2," D
.S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"))
.I TERMSTAT="P" S DR=DR_";10" Q
.I TERMSTAT'=0 S DR=DR_";10",STATUS=1
;Health Factor - within category rank
I GLOB="AUTTHF(" S DR=DR_";11//0"
;If V file INCLUDE VISIT DATA
S VF=$S(GLOB["AUTTEDT":1,GLOB["AUTTEXAM":1,GLOB["AUTTHF":1,GLOB["AUTTIMM":1,GLOB="AUTTSK":1,GLOB["PXD(811.2":1,1:0)
I VF S DR=DR_";28"
;Immunization - Immunization Search Criteria
I GLOB["AUTTIMM" S DR=DR_";29"
;Mental Health - scale
I GLOB="YTT(601.71," S DR=DR_";13"
;Radiology procedure
I GLOB="RAMIS(71," S STATUS=1
;Orderable item
I GLOB="ORD(101.43," S DR=DR_";27",STATUS=1
;Rx Type
I GLOB="PSDRUG("!(GLOB="PS(50.605,")!(GLOB="PSNDF(50.6,") S DR=DR_";16;27",STATUS=1
;Condition, make the default for Condition Case Sensitive NO
S DR=DR_";14;15//NO;18"
;
;Edit finding record
D ^DIE
I STATUS=1,$D(DA)>0,$D(Y)=0 D STATUS^PXRMSTA1(.DA,"T")
S $P(^PXRMD(811.5,IEN,20,0),U,3)=0
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMTMED 3502 printed Apr 09, 2024@20:48:56 Page 2
PXRMTMED ; SLC/PKR/PJH - Edit a reminder term. ;Aug 18, 2020@11:19:40
+1 ;;2.0;CLINICAL REMINDERS;**1,4,6,12,26,45,42,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;=======================================================
+4 NEW CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y
GETNAME ;Get the name of the term to edit.
+1 KILL DA,DIC,DLAYGO,DTOUT,DUOUT,Y
+2 SET DIC="^PXRMD(811.5,"
+3 SET DIC(0)="AEMQL"
+4 SET DIC("A")="Select Reminder Term: "
+5 SET DLAYGO=811.5
+6 ;Set the starting place for additions.
+7 DO SETSTART^PXRMCOPY(DIC)
+8 WRITE !
+9 DO ^DIC
+10 IF ($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+11 IF Y=-1
GOTO END
+12 SET DA=$PIECE(Y,U,1)
+13 SET CS1=$$FILE^PXRMEXCS(811.5,DA)
+14 DO EDIT(DIC,DA)
+15 IF $GET(DA)=""
GOTO GETNAME
+16 SET CS2=$$FILE^PXRMEXCS(811.5,DA)
+17 IF CS2=0
GOTO GETNAME
+18 IF CS2=CS1
GOTO GETNAME
+19 WRITE !!,"Checking integrity of the term ...",!
+20 IF '$$TERM^PXRMICK1(DA,.OUTPUT,1)
GOTO GETNAME
+21 DO SEHIST^PXRMUTIL(811.5,DIC,DA)
+22 GOTO GETNAME
END ;
+1 QUIT
+2 ;
+3 ;=======================================================
CLASS(DA,DIE) ;
+1 NEW DR,RESULT,X,Y
RETRY WRITE !
+1 SET DR="100"
DO ^DIE
IF $DATA(Y)
QUIT
+2 ;Sponsor
+3 SET DR="101"
DO ^DIE
IF $DATA(Y)
QUIT
+4 ;Make sure Class and Sponsor Class are in synch.
+5 SET RESULT=$$VSPONSOR^PXRMINTR(X)
+6 IF RESULT=0
SET DIE("NO^")="Other value"
GOTO RETRY
+7 IF RESULT=1
KILL DIE("NO^")
+8 ;Review date, Usage
+9 SET DR="102;1"
DO ^DIE
IF $DATA(Y)
QUIT
+10 QUIT
+11 ;
+12 ;=======================================================
EDIT(ROOT,DA) ;
+1 NEW CLASS,DIC,DIE,DR,DIDEL,PXRMTMD,RESULT,TCONT,Y
+2 ;PXRMTMD is set by a xref on the .01 as a flag that the entire
+3 ;entry is being deleted.
+4 SET CLASS=$PIECE($GET(^PXRMD(811.5,DA,100)),U,1)
+5 SET DIE=ROOT
+6 IF CLASS'="N"!(($GET(PXRMINST)=1)&($GET(DUZ(0))="@"))
Begin DoDot:1
+7 SET DR=".01"
+8 DO ^DIE
+9 IF $GET(DA)'=""
DO CLASS(DA,DIE)
End DoDot:1
+10 IF $GET(DA)=""
QUIT
+11 SET TCONT=1
+12 FOR
DO FINDING(ROOT,DA)
if TCONT=0
QUIT
+13 QUIT
+14 ;
+15 ;=======================================================
FINDING(DIE,DA) ;
+1 NEW CFIEN,GLOB,IEN,LIST,NODE,TERMSTAT,VF,WPIEN
+2 NEW DEF,DEF1,DEF2,STATUS
+3 SET DIE("NO^")="OUTOK"
+4 SET STATUS=0
+5 DO DEF^PXRMRUTL("811.52",.DEF,.DEF1,.DEF2)
+6 SET NODE="^PXRMD(811.5)"
+7 DO LIST^PXRMREDT(NODE,DA,.DEF1,.LIST)
+8 DO DSPALL^PXRMREDF("T",NODE,DA,.LIST)
+9 SET DA(1)=DA
+10 SET IEN=DA
+11 SET DIC=DIE_DA(1)_",20,"
+12 SET DIC(0)="QEAL"
+13 SET DIC("A")="Select Finding: "
+14 DO ^DIC
IF Y=-1
SET DTOUT=1
SET TCONT=0
QUIT
+15 SET DIE=DIC
+16 SET DA=+Y
SET GLOB=$PIECE($PIECE(Y,U,2),";",2)
if GLOB=""
QUIT
+17 IF GLOB="PXRMD(811.4,"
SET CFIEN=$PIECE($PIECE(Y,U,2),";",1)
DO HELP^PXRMCF(CFIEN)
+18 IF GLOB="YTT(601.71,"
DO WARN^PXRMMH
+19 WRITE !,"Editing Finding Number: "_$GET(DA)
+20 ;Finding record fields
+21 SET DR=".01;9;12;17"
+22 IF GLOB="PXRMD(811.4,"
SET DR=DR_";26"
+23 ;Taxonomy - use inactive problems
+24 IF GLOB="PXD(811.2,"
Begin DoDot:1
+25 SET TERMSTAT=$$TAXNODE^PXRMSTA1($PIECE($PIECE(Y,U,2),";"))
+26 IF TERMSTAT="P"
SET DR=DR_";10"
QUIT
+27 IF TERMSTAT'=0
SET DR=DR_";10"
SET STATUS=1
End DoDot:1
+28 ;Health Factor - within category rank
+29 IF GLOB="AUTTHF("
SET DR=DR_";11//0"
+30 ;If V file INCLUDE VISIT DATA
+31 SET VF=$SELECT(GLOB["AUTTEDT":1,GLOB["AUTTEXAM":1,GLOB["AUTTHF":1,GLOB["AUTTIMM":1,GLOB="AUTTSK":1,GLOB["PXD(811.2":1,1:0)
+32 IF VF
SET DR=DR_";28"
+33 ;Immunization - Immunization Search Criteria
+34 IF GLOB["AUTTIMM"
SET DR=DR_";29"
+35 ;Mental Health - scale
+36 IF GLOB="YTT(601.71,"
SET DR=DR_";13"
+37 ;Radiology procedure
+38 IF GLOB="RAMIS(71,"
SET STATUS=1
+39 ;Orderable item
+40 IF GLOB="ORD(101.43,"
SET DR=DR_";27"
SET STATUS=1
+41 ;Rx Type
+42 IF GLOB="PSDRUG("!(GLOB="PS(50.605,")!(GLOB="PSNDF(50.6,")
SET DR=DR_";16;27"
SET STATUS=1
+43 ;Condition, make the default for Condition Case Sensitive NO
+44 SET DR=DR_";14;15//NO;18"
+45 ;
+46 ;Edit finding record
+47 DO ^DIE
+48 IF STATUS=1
IF $DATA(DA)>0
IF $DATA(Y)=0
DO STATUS^PXRMSTA1(.DA,"T")
+49 SET $PIECE(^PXRMD(811.5,IEN,20,0),U,3)=0
+50 QUIT
+51 ;
