PXRMP6IC ; SLC/PKR - Inits for PXRM*2.0*6 ;10/26/2007
;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
;========================
MHCOND ;Check for definitions and terms that use an MH finding and a
;condition and convert the condition.
N COND,FDA,FI,ICOND,IEN,IENS,MSG,NEWCOND,PTR
D BMES^XPDUTL("Converting Conditions for MH findings in definitions and terms.")
;Check definitions.
S IEN=0
F S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0 D
. I '$D(^PXD(811.9,IEN,20,"E","YTT(601.71,")) Q
. S PTR=""
. F S PTR=$O(^PXD(811.9,IEN,20,"E","YTT(601.71,",PTR)) Q:PTR="" D
.. S FI=0
.. F S FI=$O(^PXD(811.9,IEN,20,"E","YTT(601.71,",PTR,FI)) Q:FI="" D
... S COND=$P($G(^PXD(811.9,IEN,20,FI,3)),U,1)
... I COND="" Q
... W !,"811.9 - IEN=",IEN," FI=",FI," COND=",COND
... S NEWCOND=$$NEWCOND(COND)
... W !,NEWCOND
... K FDA,MSG
... S IENS=FI_","_IEN_","
...;Force it to file by deleting the value.
... S FDA(811.902,IENS,14)="@"
... D FILE^DIE("E","FDA","MSG")
... S FDA(811.902,IENS,14)=NEWCOND
... D FILE^DIE("E","FDA","MSG")
;Check terms
S IEN=0
F S IEN=+$O(^PXRMD(811.5,IEN)) Q:IEN=0 D
. I '$D(^PXRMD(811.5,IEN,20,"E","YTT(601.71,")) Q
. S PTR=""
. F S PTR=$O(^PXRMD(811.5,IEN,20,"E","YTT(601.71,",PTR)) Q:PTR="" D
.. S FI=0
.. F S FI=$O(^PXRMD(811.5,IEN,20,"E","YTT(601.71,",PTR,FI)) Q:FI="" D
... S COND=$P($G(^PXRMD(811.5,IEN,20,FI,3)),U,1)
... I COND="" Q
... W !,"811.5 - IEN=",IEN," FI=",FI," COND=",COND
... S NEWCOND=$$NEWCOND(COND)
... W !,NEWCOND
... K FDA,MSG
... S IENS=FI_","_IEN_","
...;Force it to file by deleting the value.
... S FDA(811.902,IENS,14)="@"
... D FILE^DIE("E","FDA","MSG")
... S FDA(811.52,IENS,14)=NEWCOND
... D FILE^DIE("E","FDA","MSG")
Q
;
;========================
NEWCOND(COND) ;Replace V with +V for MH conditions using scale.
N CHAR,IND,NEWCOND
S COND=$TR(COND,"+","")
S NEWCOND=""
F IND=1:1:$L(COND) D
. S CHAR=$E(COND,IND)
. I CHAR'="V" S NEWCOND=NEWCOND_CHAR Q
.;If the condition is checking a response do not plus.
. I $E(COND,(IND+3))="R" S NEWCOND=NEWCOND_CHAR Q
. S NEWCOND=NEWCOND_"+"_CHAR
Q NEWCOND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP6IC 2164 printed Apr 09, 2024@20:53:51 Page 2
PXRMP6IC ; SLC/PKR - Inits for PXRM*2.0*6 ;10/26/2007
+1 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+2 ;========================
MHCOND ;Check for definitions and terms that use an MH finding and a
+1 ;condition and convert the condition.
+2 NEW COND,FDA,FI,ICOND,IEN,IENS,MSG,NEWCOND,PTR
+3 DO BMES^XPDUTL("Converting Conditions for MH findings in definitions and terms.")
+4 ;Check definitions.
+5 SET IEN=0
+6 FOR
SET IEN=+$ORDER(^PXD(811.9,IEN))
if IEN=0
QUIT
Begin DoDot:1
+7 IF '$DATA(^PXD(811.9,IEN,20,"E","YTT(601.71,"))
QUIT
+8 SET PTR=""
+9 FOR
SET PTR=$ORDER(^PXD(811.9,IEN,20,"E","YTT(601.71,",PTR))
if PTR=""
QUIT
Begin DoDot:2
+10 SET FI=0
+11 FOR
SET FI=$ORDER(^PXD(811.9,IEN,20,"E","YTT(601.71,",PTR,FI))
if FI=""
QUIT
Begin DoDot:3
+12 SET COND=$PIECE($GET(^PXD(811.9,IEN,20,FI,3)),U,1)
+13 IF COND=""
QUIT
+14 WRITE !,"811.9 - IEN=",IEN," FI=",FI," COND=",COND
+15 SET NEWCOND=$$NEWCOND(COND)
+16 WRITE !,NEWCOND
+17 KILL FDA,MSG
+18 SET IENS=FI_","_IEN_","
+19 ;Force it to file by deleting the value.
+20 SET FDA(811.902,IENS,14)="@"
+21 DO FILE^DIE("E","FDA","MSG")
+22 SET FDA(811.902,IENS,14)=NEWCOND
+23 DO FILE^DIE("E","FDA","MSG")
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;Check terms
+25 SET IEN=0
+26 FOR
SET IEN=+$ORDER(^PXRMD(811.5,IEN))
if IEN=0
QUIT
Begin DoDot:1
+27 IF '$DATA(^PXRMD(811.5,IEN,20,"E","YTT(601.71,"))
QUIT
+28 SET PTR=""
+29 FOR
SET PTR=$ORDER(^PXRMD(811.5,IEN,20,"E","YTT(601.71,",PTR))
if PTR=""
QUIT
Begin DoDot:2
+30 SET FI=0
+31 FOR
SET FI=$ORDER(^PXRMD(811.5,IEN,20,"E","YTT(601.71,",PTR,FI))
if FI=""
QUIT
Begin DoDot:3
+32 SET COND=$PIECE($GET(^PXRMD(811.5,IEN,20,FI,3)),U,1)
+33 IF COND=""
QUIT
+34 WRITE !,"811.5 - IEN=",IEN," FI=",FI," COND=",COND
+35 SET NEWCOND=$$NEWCOND(COND)
+36 WRITE !,NEWCOND
+37 KILL FDA,MSG
+38 SET IENS=FI_","_IEN_","
+39 ;Force it to file by deleting the value.
+40 SET FDA(811.902,IENS,14)="@"
+41 DO FILE^DIE("E","FDA","MSG")
+42 SET FDA(811.52,IENS,14)=NEWCOND
+43 DO FILE^DIE("E","FDA","MSG")
End DoDot:3
End DoDot:2
End DoDot:1
+44 QUIT
+45 ;
+46 ;========================
NEWCOND(COND) ;Replace V with +V for MH conditions using scale.
+1 NEW CHAR,IND,NEWCOND
+2 SET COND=$TRANSLATE(COND,"+","")
+3 SET NEWCOND=""
+4 FOR IND=1:1:$LENGTH(COND)
Begin DoDot:1
+5 SET CHAR=$EXTRACT(COND,IND)
+6 IF CHAR'="V"
SET NEWCOND=NEWCOND_CHAR
QUIT
+7 ;If the condition is checking a response do not plus.
+8 IF $EXTRACT(COND,(IND+3))="R"
SET NEWCOND=NEWCOND_CHAR
QUIT
+9 SET NEWCOND=NEWCOND_"+"_CHAR
End DoDot:1
+10 QUIT NEWCOND
