Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMREDF

PXRMREDF.m

Go to the documentation of this file. 
  1. PXRMREDF ; SLC/PJH - Edit PXRM reminder findings. ;05/08/2014
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,12,26**;Feb 04, 2005;Build 404
  1.  ;
  1.  ; Called by PXRMREDT which newes and initialized DEF, DEF1, DEF2.
  1.  ;
  1. SET S:'$D(^PXD(811.9,DA,20,0)) ^PXD(811.9,DA,20,0)="^811.902V" Q
  1.  ;Display ALL findings
  1.  ;
  1.  ;--------------------
  1. DSPALL(TYPE,NODE,DA,LIST) ;
  1.  I '$D(LIST) D  Q
  1.  . I TYPE="D" W !!,"Reminder has no findings!",!
  1.  . I TYPE="T" W !!,"Reminder Term has no findings!",!
  1.  N FINUM,FMTSTR,FNAME,FTYPE,IND,NL,OUTPUT,TEXTSTR
  1.  W !!,"Choose from:",!
  1.  S FMTSTR="2L1^60L1^9L1^3R"
  1.  S FTYPE=""
  1.  F  S FTYPE=$O(LIST(FTYPE)) Q:FTYPE=""  D
  1.  . S FNAME=0
  1.  . F  S FNAME=$O(LIST(FTYPE,FNAME)) Q:FNAME=""  D
  1.  .. S FINUM=0
  1.  .. F  S FINUM=$O(LIST(FTYPE,FNAME,FINUM)) Q:FINUM=""  D
  1.  ... S TEXTSTR=FTYPE_U_FNAME_U_"Finding #"_U_FINUM
  1.  ... D COLFMT^PXRMTEXT(FMTSTR,TEXTSTR," ",.NL,.OUTPUT)
  1.  ... F IND=1:1:NL W !,OUTPUT(IND)
  1.  ;Update
  1.  D LIST^PXRMREDT(NODE,DA,.DEF1,.LIST)
  1.  Q
  1.  ;
  1.  ;Edit individual FINDING entry
  1.  ;-----------------------------
  1. FEDIT(IEN) ;
  1.  N CFIEN,DA,DIC,DIE,DR,ETYPE,GLOB
  1.  N STATUS,TERMSTAT,TIEN,TERMTYPE,VF,WPIEN,Y
  1.  S DA(1)=IEN
  1.  S DIC="^PXD(811.9,"_IEN_",20,"
  1.  I $P(^PXD(811.9,IEN,100),U)="N",$G(PXRMINST)'=1 S DIC(0)="QEA"
  1.  E  S DIC(0)="QEAL"
  1.  S DIC("A")="Select FINDING: "
  1.  S DIC("P")="811.902V"
  1.  D ^DIC
  1.  I Y=-1 S DTOUT=1 Q
  1.  S DIE=DIC K DIC
  1.  S DIE("NO^")="OUTOK"
  1.  S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB=""
  1.  S TYPE=$G(DEF1(GLOB))
  1.  S SDA(2)=DA(1),SDA(1)=DA
  1.  ;Save term IEN
  1.  S STATUS=0
  1.  I TYPE="CF" S CFIEN=$P($P(Y,U,2),";",1) D HELP^PXRMCF(CFIEN)
  1.  I TYPE="MH" D WARN^PXRMMH
  1.  I TYPE="RT" S TIEN=$P($P(Y,U,2),";",1)
  1.  ;Finding record fields
  1.  W !!,"Editing Finding Number: "_$G(DA)
  1.  S DR=".01;3;I X=""0Y"" S Y=6;1;2;6;7;8;9;12;17"
  1.  ;Taxonomy - use inactive problems
  1.  I TYPE="TX" D
  1.  .S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"))
  1.  .I TERMSTAT="P" S DR=DR_";10" Q
  1.  .I TERMSTAT'=0 S DR=DR_";10",STATUS=1
  1.  I TYPE="RT" D
  1.  .S TERMTYPE=$$TERMTYPE(TIEN)
  1.  .I TERMTYPE["H" S DR=DR_";11"
  1.  ;Health Factor - within category rank
  1.  I TYPE="HF" S DR=DR_";11"
  1.  ;If V file INCLUDE VISIT DATA
  1.  S VF=$S(TYPE="ED":1,TYPE="EX":1,TYPE="HF":1,TYPE="IM":1,TYPE="ST":1,TYPE="TX":1,1:0)
  1.  I TYPE="RT",$P(TERMTYPE,U,2)="VF" S VF=1
  1.  I VF S DR=DR_";28"
  1.  ;
  1.  ;Mental Health - scale
  1.  I TYPE="MH" S DR=DR_";13"
  1.  ;Radiology procedure.
  1.  I TYPE="RP" S STATUS=1
  1.  ;Orderable Item
  1.  I TYPE="OI" S DR=DR_";27",STATUS=1
  1.  ;Rx Type
  1.  I (TYPE="DC")!(TYPE="DG")!(TYPE="DR") S DR=DR_";16;27",STATUS=1
  1.  ;Condition
  1.  S DR=DR_";14;15;18"
  1.  I TYPE="CF" S DR=DR_";26"
  1.  ;Found/not found text
  1.  S DR=DR_";4;5"
  1.  ;
  1.  I TYPE="RT" D
  1.  . I TERMTYPE["D" S DR=DR_";16;27",STATUS=1
  1.  . I TERMTYPE["O" S DR=DR_";27",STATUS=1
  1.  . I TERMTYPE["R" S STATUS=1
  1.  . I TERMTYPE["T" S STATUS=1
  1.  .I TERMTYPE[2 D
  1.  .. N MSG
  1.  .. S MSG(1)="Cannot set a status since the term contains multiple types of findings"
  1.  .. S MSG(2)="Edit the status field at the term level for each finding" H 2
  1.  .. D EN^DDIOL(.MSG)
  1.  ;Edit finding record
  1.  D ^DIE
  1.  S $P(^PXD(811.9,IEN,20,0),U,3)=0
  1.  I $D(Y) S DTOUT=1 Q
  1.  ;Check if deleted
  1.  I '$D(DA) Q
  1.  I STATUS=1,$D(Y)=0 D STATUS^PXRMSTA1(.DA,"D")
  1.  ;
  1.  S ETYPE=$P(^PXD(811.9,IEN,20,SDA(1),0),U,1)
  1.  ;Option to edit term findings
  1.  I $P(ETYPE,";",2)="PXRMD(811.5," D
  1.  . S TIEN=$P(ETYPE,";",1)
  1.  . D TMAP(IEN,TIEN)
  1.  Q
  1.  ;
  1.  ;Edit individual function finding entry
  1.  ;-----------------------------
  1. FFEDIT(IEN) ;
  1.  N DA,DIC,DIE,DR,Y
  1.  S DA(1)=IEN
  1.  S DIC="^PXD(811.9,"_IEN_",25,"
  1.  S DIC(0)="QEAL"
  1.  S DIC("A")="Select FUNCTION FINDING: "
  1.  D ^DIC
  1.  I Y=-1 S DTOUT=1 Q
  1.  S DIE=DIC K DIC
  1.  S DA=+Y
  1.  ;Finding record fields
  1.  S DR=".01;3"
  1.  ;Edit finding record
  1.  D ^DIE
  1.  I $D(Y) S DTOUT=1 Q
  1.  I '$D(DA) Q
  1.  ;If the function string is null don't do the rest of the fields.
  1.  I $G(^PXD(811.9,IEN,25,DA,3))="" Q
  1.  S DR="1;2;11;12;15;I X=""0Y"" S Y=16;13;14;16"
  1.  D ^DIE
  1.  I $D(Y) S DTOUT=1 Q
  1.  I '$D(DA) Q
  1.  ;Check if deleted
  1.  Q
  1.  ;
  1.  ;Edit Reminder Function Findings
  1.  ;----------------------
  1. FFIND ;
  1.  N DTOUT,DUOUT
  1.  F  D  Q:$D(DUOUT)!$D(DTOUT)
  1.  .D FFEDIT(DA) I $D(DUOUT)!$D(DTOUT) Q
  1.  K DUOUT,DTOUT
  1.  Q
  1.  ;
  1.  ;Edit Reminder Findings
  1.  ;----------------------
  1. FIND(LIST) ;
  1.  N DTOUT,DUOUT,NODE,SDA
  1.  D SET ; Check if node defined
  1.  S NODE="^PXD(811.9)"
  1.  F  D  Q:$D(DUOUT)!$D(DTOUT)
  1.  .;Display list of existing reminder findings
  1.  .W !!,"Reminder Definition Findings"
  1.  .D DSPALL("D",NODE,DA,.LIST)
  1.  .;Edit findings
  1.  .D FEDIT(DA) I $D(DUOUT)!$D(DTOUT) D LIST^PXRMREDT(NODE,DA,.DEF1,.LIST) Q
  1.  .;Update list with finding changes
  1.  .D LIST^PXRMREDT(NODE,DA,.DEF1,.LIST)
  1.  Q
  1.  ;
  1.  ;General help text routine
  1.  ;-------------------------
  1. HELP(CALL) ;
  1.  N HTEXT
  1.  N DIWF,DIWL,DIWR,IC
  1.  S DIWF="C70",DIWL=0,DIWR=70
  1.  ;
  1.  I CALL=1 D
  1.  .S HTEXT(1)="Select the type of finding you wish to change or add."
  1.  .S HTEXT(2)="Type '?' for a list of the available finding types."
  1.  I CALL=2 D
  1.  .S HTEXT(1)="Select section of the reminder you wish to edit or 'All'"
  1.  .S HTEXT(2)="to step through all sections of the reminder definition."
  1.  I CALL=3 D
  1.  .S HTEXT(1)="Select 'Y' to edit the findings mapped to this term"
  1.  .S HTEXT(2)="or 'N' to return to select another reminder finding."
  1.  ;
  1.  K ^UTILITY($J,"W")
  1.  S IC=""
  1.  F  S IC=$O(HTEXT(IC)) Q:IC=""  D
  1.  . S X=HTEXT(IC)
  1.  . D ^DIWP
  1.  W !
  1.  S IC=0
  1.  F  S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC=""  D
  1.  . W !,^UTILITY($J,"W",0,IC,0)
  1.  K ^UTILITY($J,"W")
  1.  W !
  1.  Q
  1.  ;
  1.  ;Display TERM findings
  1.  ;--------------------
  1. TDSP(DA) ;
  1.  N FIRST,SUB,SUB1,TLST
  1.  S FIRST=1,SUB="",SUB1=""
  1.  ;Build list of term findings
  1.  D TLST(.TLST,DA)
  1.  ;Display list
  1.  F  S SUB=$O(TLST(SUB)) Q:SUB=""  D
  1.  .S SUB1=0
  1.  .F  S SUB1=$O(TLST(SUB,SUB1)) Q:SUB1=""  D
  1.  ..I FIRST S FIRST=0 W !!,"Reminder Term Findings:",!!
  1.  ..W SUB
  1.  ..W ?8,SUB1,!
  1.  I FIRST W !!,"Term has no mapped findings",!!
  1.  Q
  1.  ;
  1.  ;List Reminders using this term
  1.  ;------------------------------
  1. TERMS(TIEN,RIEN) ;
  1.  ;RIEN will be the reminder ien if called from reminder edit
  1.  ;or zero if called from term edit
  1.  N ARRAY,FIND,IEN,SUB,TCNT,RNAME
  1.  ;Scan all reminders in file #811.9
  1.  S IEN=0,FIND="PXRMD(811.5,",TCNT=0
  1.  F  S IEN=$O(^PXD(811.9,IEN)) Q:'IEN  D
  1.  .;Exclude current reminder called in reminder edit
  1.  .I RIEN,IEN=RIEN Q
  1.  .;Check the term findings
  1.  .I '$D(^PXD(811.9,IEN,20,"E",FIND,TIEN)) Q
  1.  .;Add to reminder array
  1.  .S RNAME=$P($G(^PXD(811.9,IEN,0)),U)
  1.  .I RNAME="" S RNAME=IEN
  1.  .I '$D(ARRAY(RNAME)) S TCNT=TCNT+1
  1.  .S ARRAY(RNAME)=""
  1.  ;
  1.  ;Display list of reminders using the term
  1.  I TCNT D
  1.  .N TXT
  1.  .S TXT="This Reminder Term is" S:RIEN TXT=TXT_" also"
  1.  .S TXT=TXT_" used by the following Reminder Definition"
  1.  .I TCNT>1 S TXT=TXT_"s"
  1.  .W !!,TXT_":"
  1.  .S RNAME="" F  S RNAME=$O(ARRAY(RNAME)) Q:RNAME=""  W !," ",RNAME
  1.  Q
  1.  ;
  1.  ;------------------------------
  1.  ;Check term for finding item to edit status item
  1. TERMTYPE(TIEN) ;
  1.  N DRUG,FOUND,HF,ORD,OTHER,RAD,RESULT,TAX,TYPE,VF
  1.  S (DRUG,FOUND,HF,ORD,OTHER,RAD,RESULT,TAX,VF)=0
  1.  S TYPE="" F  S TYPE=$O(^PXRMD(811.5,TIEN,20,"B",TYPE)) Q:TYPE=""  D
  1.  . I TYPE["AUTTEDT(" S (OTHER,VF)=1 Q
  1.  . I TYPE["AUTTHF(" S (HF,OTHER,VF)=1 Q
  1.  . I TYPE["AUTTIMM(" S (OTHER,VF)=1 Q
  1.  . I TYPE["AUTTSK(" S (OTHER,VF)=1 Q
  1.  . I TYPE["ORD" S (ORD,FOUND)=1 Q
  1.  . I TYPE["PS" S (DRUG,FOUND)=1 Q
  1.  . I TYPE["PXD(811.2" S (FOUND,TAX,VF)=1 Q
  1.  . I TYPE["RAMIS" S (FOUND,RAD)=1 Q
  1.  . S OTHER=1
  1.  I RAD=1,ORD=0,TAX=0,DRUG=0,OTHER=0 S RESULT="R"
  1.  I RAD=0,ORD=1,TAX=0,DRUG=0,OTHER=0 S RESULT="O"
  1.  I RAD=0,ORD=0,TAX=1,DRUG=0,OTHER=0 S RESULT="T"
  1.  I RAD=0,ORD=0,TAX=0,DRUG=1,OTHER=0 S RESULT="D"
  1.  I OTHER=1 S RESULT=1 I FOUND=1 S RESULT=2
  1.  I RESULT="T" S RESULT=$$TAXTYPE^PXRMSTA1(TIEN,"")
  1.  I HF=1 S RESULT="H"_RESULT
  1.  I VF=1 S RESULT=RESULT_U_"VF"
  1.  Q RESULT
  1.  ;
  1.  ;Build list of mapped findings for term
  1.  ;--------------------------------------
  1. TLST(ARRAY,DA) ;
  1.  N TYPE,DATA,GLOB,IEN,NAME,NODE,SUB
  1.  ;Clear passed arrays
  1.  K ARRAY
  1.  ;Build cross reference global to file number
  1.  ;Get each finding
  1.  S SUB=0 F  S SUB=$O(^PXRMD(811.5,DA,20,SUB)) Q:'SUB  D
  1.  .S DATA=$G(^PXRMD(811.5,DA,20,SUB,0)) I DATA="" Q
  1.  .;Determine global and global ien
  1.  .S NODE=$P(DATA,U),GLOB=$P(NODE,";",2),IEN=$P(NODE,";")
  1.  .;Ignore null entries
  1.  .I (GLOB="")!(IEN="") Q
  1.  .;Work out the file type
  1.  .S TYPE=$G(DEF1(GLOB)) Q:TYPE=""
  1.  .S NAME=$P($G(@(U_GLOB_IEN_",0)")),U)
  1.  .S ARRAY(TYPE,NAME)=""
  1.  Q
  1.  ;
  1.  ;Map Term findings
  1.  ;-----------------
  1. TMAP(RIEN,TIEN) ;
  1.  N TOPT,TNAM
  1.  ;Display any other reminders using this term
  1.  D TERMS(TIEN,RIEN)
  1.  ;Term name
  1.  S TNAM=$P($G(^PXRMD(811.5,TIEN,0)),U)
  1.  ;Give option to edit mapped findings (Y/N)
  1.  D TMASK(.TOPT,TNAM) Q:$D(DUOUT)!($D(DTOUT))
  1.  ;Edit term findings
  1.  I TOPT="Y" D TRMED(TIEN)
  1.  Q
  1.  ;
  1.  ;Option to edit term findings
  1.  ;----------------------------
  1. TMASK(YESNO,TNAM) ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="YA0"
  1.  S DIR("A")="Do you want to edit mapped findings for "_TNAM_": "
  1.  S (DIR("B"),YESNO)="N"
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMREDF(3)"
  1.  W !
  1.  D ^DIR K DIR
  1.  I $D(DIROUT)!$D(DIRUT) Q
  1.  I $D(DTOUT)!$D(DUOUT) Q
  1.  S YESNO=$E(Y(0))
  1.  Q
  1.  ;
  1.  ;Term edit
  1.  ;---------
  1. TRMED(DA) ;
  1.  N CS1,CS2,DIC,DLAYGO,DTOUT,DUOUT,Y
  1.  K DLAYGO,DTOUT,DUOUT,Y
  1.  ;Display term findings
  1.  D TDSP(DA)
  1.  ;Initialize change history
  1.  S CS1=$$FILE^PXRMEXCS(811.5,DA)
  1.  ;Edit term findings
  1.  S DIC="^PXRMD(811.5,"
  1.  D EDIT^PXRMTMED(DIC,DA)
  1.  ;Update change history
  1.  S CS2=$$FILE^PXRMEXCS(811.5,DA)
  1.  I CS2=0 Q
  1.  I CS2'=CS1 D SEHIST^PXRMUTIL(811.5,DIC,DA)
  1.  Q
  1.  ;