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

PXRMTXSM.m

Go to the documentation of this file. 
  1. PXRMTXSM ;SLC/PKR - Reminder Taxonomy ScreenMan routines ;02-Nov-2015 08:55;du
  1.  ;;2.0;CLINICAL REMINDERS;**26,1005**;Feb 04, 2005;Build 23
  1.  ;
  1.  ;===================================
  1. CODELIST(TAXIEN,TERM,CODESYS) ;See if the temporary list of selected codes
  1.  ;exists, if it does not and codes have been stored in the taxonomy
  1.  ;then build it.
  1.  I $D(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q
  1.  I '$D(^PXD(811.2,TAXIEN,20,"ATC",TERM,CODESYS)) Q
  1.  M ^TMP("PXRMCODES",$J,TERM,CODESYS)=^PXD(811.2,TAXIEN,20,"ATCC",TERM,CODESYS)
  1.  Q
  1.  ;
  1.  ;===================================
  1. EXETCCAP(DA) ;Executable caption for code search.
  1.  N TC
  1.  S TC=$$GET^DDSVAL(811.23,.DA,.01,"","E")
  1.  I $L(TC)>57 S TC=$E(TC,1,54)_"..."
  1.  Q " Term/Code: "_TC_" "
  1.  ;
  1.  ;===================================
  1. LEXSRCH(DA,CODESYS) ;Branch for Lexicon Term/Code search.
  1.  ;selection.
  1.  N PXRMLEXV,SAVEDDS,TAXIEN,TERM
  1.  ;These PXRM variables are used in the List Manager Lexicon search.
  1.  N PXRMBGS,PXRMLEXV
  1.  K ^TMP("PXRMLEXTC",$J)
  1.  S ^TMP("PXRMLEXTC",$J,"CODESYS")=CODESYS
  1.  S (^TMP("PXRMLEXTC",$J,"LEX TERM"),TERM)=$$GET^DDSVAL(811.23,.DA,.01,"","E")
  1.  S (^TMP("PXRMLEXTC",$J,"TAX IEN"),TAXIEN)=DA(1)
  1.  D CODELIST(TAXIEN,TERM,CODESYS)
  1.  ;DBIA #5746 covers kill and set of DDS.
  1.  I $D(DDS) S SAVEDDS=DDS K DDS
  1.  D EN^VALM("PXRM LEXICON SELECT")
  1.  K ^TMP("PXRMLEXTC",$J)
  1.  ;Reset the screen so ScreenMan displays properly.
  1.  I $D(SAVEDDS) D
  1.  . N IOAWM0,X
  1.  . S DDS=SAVEDDS
  1.  . S X=0 X ^%ZOSF("RM"),^%ZOSF("TYPE-AHEAD")
  1.  . S X="IOAWM0" D ENDR^%ZISS W IOAWM0
  1.  . D REFRESH^DDSUTL
  1.  Q
  1.  ;
  1.  ;===================================
  1. LTCPAOC(DA) ;Lexicon Term/Code post-action on change.
  1.  N NTC,OTC,TEXT
  1.  S NTC=$$GET^DDSVAL(811.23,.DA,"TERM/CODE")
  1.  S OTC=$G(^PXD(811.2,DA(1),20,DA,0))
  1.  I ($L(OTC)>0),(NTC'=OTC) D
  1.  . S TEXT(1)="Overwriting a search Term/Code is not allowed!"
  1.  . S TEXT(2)="To replace a search term delete the existing one first."
  1.  . S TEXT(3)="$$EOP"
  1.  . D HLP^DDSUTL(.TEXT)
  1.  . D PUT^DDSVAL(811.23,.DA,"TERM/CODE",OTC)
  1.  Q
  1.  ;
  1.  ;===================================
  1. NUMCODES(DA) ;Executable caption to display the number of selected codes
  1.  ;for Lexicon Term/Code.
  1.  ;^TMP("PXRMCODES",$J) will have the value from the current editing
  1.  ;session so check it first.
  1.  I DA="" Q $$REPEAT^XLFSTR(" ",30)
  1.  N CODESYS,COUNT,IND,NUID,NUM,TEMP,TERM,TEXT,UID
  1.  S TERM=$$GET^DDSVAL(811.23,.DA,.01,"","E")
  1.  S CODESYS=""
  1.  F  S CODESYS=$O(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q:CODESYS=""  D
  1.  . S CODE="",(NUID,NUM)=0
  1.  . F  S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE=""  D
  1.  .. S NUM=NUM+1
  1.  .. S UID=^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
  1.  .. I UID=1 S NUID=NUID+1
  1.  . S COUNT(CODESYS)=NUM
  1.  . S NUID(CODESYS)=NUID
  1.  ;Check for stored values.
  1.  S IND=0
  1.  F  S IND=+$O(^PXD(811.2,DA(1),20,DA,1,IND)) Q:IND=0  D
  1.  . S TEMP=^PXD(811.2,DA(1),20,DA,1,IND,0)
  1.  . S CODESYS=$P(TEMP,U,1),NUM=$P(TEMP,U,2),NUID=$P(TEMP,U,3)
  1.  . I $D(COUNT(CODESYS))!(NUM=0) Q
  1.  . S COUNT(CODESYS)=NUM
  1.  . S NUID(CODESYS)=NUID
  1.  I '$D(COUNT) Q "None"_$$REPEAT^XLFSTR(" ",26)
  1.  S (CODESYS,TEXT)=""
  1.  F  S CODESYS=$O(COUNT(CODESYS)) Q:CODESYS=""  D
  1.  . S TEXT=TEXT_CODESYS_":"_COUNT(CODESYS)
  1.  . I NUID(CODESYS)>0 S TEXT=TEXT_":"_NUID(CODESYS)
  1.  . S TEXT=TEXT_" "
  1.  S NUM=$L(TEXT)
  1.  I NUM<30 S TEXT=TEXT_$$REPEAT^XLFSTR(" ",(30-NUM))
  1.  Q TEXT
  1.  ;
  1.  ;===================================
  1. POSTACT(D0) ;Form Post Action
  1.  N INACTIVE,INUSE,OUTPUT
  1.  K ^TMP("PXRMCODES",$J)
  1.  ;If the change was a deletion there is nothing else to do.
  1.  I '$D(^PXD(811.2,D0)) Q
  1.  ;If the taxonomy was inactivated check to see if it is being used.
  1.  S INACTIVE=$$GET^DDSVAL(811.2,D0,"INACTIVE FLAG")
  1.  S INUSE=$S(INACTIVE:$$INUSE^PXRMTAXD(D0,"INACT"),1:0)
  1.  I INUSE D HLP^DDSUTL("$$EOP")
  1.  ;Check for dialog problems.
  1.  D TAXEDITC^PXRMDTAX(D0,.OUTPUT)
  1.  I $D(OUTPUT) D
  1.  . ;IHS/MSC/MGH Newed Variables
  1.  . N IOSTBM,IORI
  1.  . D BROWSE^DDBR("OUTPUT","NR","Problems with dialogs using this taxonomy.")
  1.  . I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
  1.  Q
  1.  ;
  1.  ;===================================
  1. POSTSAVE(IEN) ;Form Post Save. Store changes in lists of codes.
  1.  N CODE,CODESYS,CSYIND,FDA,KCSYSIND,KFDA,MSG,NSEL,NUID,PDS
  1.  N TEMP,TERM,TERMIND,TEXT,UID
  1.  S TERM="",TERMIND=0
  1.  F  S TERM=$O(^TMP("PXRMCODES",$J,TERM)) Q:TERM=""  D
  1.  .;If this term has been deleted, skip the rest.
  1.  . I '$D(^PXD(811.2,IEN,20,"B",TERM)) Q
  1.  . S TERMIND=$O(^PXD(811.2,IEN,20,"B",TERM,""))
  1.  . S CODESYS="",CSYSIND=TERMIND
  1.  . F  S CODESYS=$O(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q:CODESYS=""  D
  1.  ..;Check for existing entries for this term and this coding system.
  1.  ..;If there are any remove them before storing the new set.
  1.  .. I $D(^PXD(811.2,IEN,20,"ATC",TERM,CODESYS)) D
  1.  ... S KCSYSIND=$P(^PXD(811.2,IEN,20,"ATC",TERM,CODESYS),U,2)
  1.  ... S IENS=KCSYSIND_","_TERMIND_","_IEN_","
  1.  ... S KFDA(811.231,IENS,.01)="@"
  1.  ... D FILE^DIE("","KFDA","MSG")
  1.  .. S CSYSIND=CSYSIND+1
  1.  .. S (NSEL,NUID)=0,CODE=""
  1.  .. F  S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE=""  D
  1.  ... S NSEL=NSEL+1
  1.  ... S UID=^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
  1.  ... I UID=1 S NUID=NUID+1
  1.  ... S IENS="+"_(NSEL+CSYSIND)_",+"_CSYSIND_","_TERMIND_","_IEN_","
  1.  ... S FDA(811.2312,IENS,.01)=CODE
  1.  ... S FDA(811.2312,IENS,1)=UID
  1.  .. S IENS="+"_CSYSIND_","_TERMIND_","_IEN_","
  1.  .. S FDA(811.231,IENS,.01)=CODESYS
  1.  .. S FDA(811.231,IENS,1)=NSEL
  1.  .. S FDA(811.231,IENS,3)=NUID
  1.  .. S CSYSIND=NSEL+CSYSIND
  1.  . D UPDATE^DIE("","FDA","","MSG")
  1.  . I $D(MSG) D
  1.  .. S TEXT(1)="Error storing codes for term "_TERM
  1.  .. S TEXT(2)=" coding system "_CODESYS
  1.  .. D EN^DDIOL(.TEXT)
  1.  .. D AWRITE^PXRMUTIL("MSG")
  1.  .. H 2
  1.  K ^TMP("PXRMCODES",$J)
  1.  ;Make sure Patient Data Source index is built.
  1.  S PDS=$$GET^DDSVAL(811.2,IEN,"PATIENT DATA SOURCE")
  1.  I PDS="" D SPDS^PXRMPDS(IEN,PDS)
  1.  Q
  1.  ;
  1.  ;===================================
  1. SMANEDIT(IEN,NEW,FORM) ;ScreenMan edit for entry IEN.
  1.  N CLASS,DA,DDSCHANG,DDSFILE,DDSPARM,DIDEL,DIMSG,DR,DTOUT,NATOK
  1.  S (DDSFILE,DIDEL)=811.2,DDSPARM="CS",DR="["_FORM_"]"
  1.  S CLASS=$P(^PXD(811.2,IEN,100),U,1)
  1.  S NATOK=$S(CLASS'="N":1,1:($G(PXRMINST)=1)&($G(DUZ(0))="@"))
  1.  I 'NATOK D  Q
  1.  . W !,"National taxonomies cannot be edited."
  1.  . H 2
  1.  . S VALMBCK="R"
  1.  ;These ^TMP entries are used by the Lexicon display to store the
  1.  ;results of the search and selection. Initializing them here minimizes
  1.  ;the number of Lexicon searches.
  1.  K ^TMP("PXRMCODES",$J),^TMP("PXRMLEXS",$J),^TMP("PXRMTEXT",$J)
  1.  S DA=IEN
  1.  D ^DDS
  1.  K ^TMP("PXRMCODES",$J),^TMP("PXRMLEXS",$J),^TMP("PXRMTEXT",$J)
  1.  I $D(DIMSG) H 2
  1.  ;If the entry is new and the user did not save, delete it.
  1.  I $G(NEW),$G(DDSSAVE)'=1 D DELETE^PXRMEXFI(811.2,IEN) Q
  1.  ;If changes were made update the change log and rebuild the
  1.  ;List Manager list.
  1.  I 'NEW,$G(DDSCHANG)'=1 S VALMBCK="R" Q
  1.  D BLDLIST^PXRMTAXL("PXRMTAXL")
  1.  S VALMBCK="R"
  1.  ;If the change was a deletion skip the change log.
  1.  I '$D(^PXD(811.2,IEN)) Q
  1.  N IENS,FDA,FDAIEN,MSG,WPTMP
  1.  S IENS="+1,"_IEN_","
  1.  S FDA(811.21,IENS,.01)=$$NOW^XLFDT
  1.  S FDA(811.21,IENS,1)=DUZ
  1.  I NEW D
  1.  . S WPTMP(1,1,1)=" Creation."
  1.  . S FDA(811.21,IENS,2)="WPTMP(1,1)"
  1.  D UPDATE^DIE("S","FDA","FDAIEN","MSG")
  1.  K DA,DDSFILE
  1.  S DA=FDAIEN(1),DA(1)=IEN
  1.  S DDSFILE=811.2,DDSFILE(1)=811.21
  1.  S DR="[PXRM TAXONOMY CHANGE LOG]"
  1.  D ^DDS
  1.  Q
  1.  ;