- 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 Feb 18, 2025@23:14:29 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
