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 ;06/14/2022
  1.  ;;2.0;CLINICAL REMINDERS;**26,47,42,65**;Feb 04, 2005;Build 438
  1.  ;
  1.  ;===============
  1. CODELIST(TAXIEN) ;See if the temporary list of selected codes exists,
  1.  ;if it does not and codes have been stored in the taxonomy
  1.  ;then build it.
  1.  I $D(^TMP("PXRMCODES",$J)) Q
  1.  I '$D(^PXD(811.2,TAXIEN,20,"ATCC")) Q
  1.  M ^TMP("PXRMCODES",$J)=^PXD(811.2,TAXIEN,20,"ATC")
  1.  M ^TMP("PXRMCODES",$J)=^PXD(811.2,TAXIEN,20,"ATCC")
  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. FDATAVAL(IEN) ;Form Data Validation.
  1.  ;If either MINIMUM VALUE or MAXIMUM VALUE is defined, they both must be.
  1.  N MAX,MAXDEC,MIN,PROMPT,TEXT,UCUM,UDISPLAY
  1.  S MIN=$$GET^DDSVAL(811.2,IEN,220)
  1.  S MAX=$$GET^DDSVAL(811.2,IEN,221)
  1.  S MAXDEC=$$GET^DDSVAL(811.2,IEN,222)
  1.  S UCUM=$$GET^DDSVAL(811.2,IEN,223)
  1.  S PROMPT=$$GET^DDSVAL(811.2,IEN,224)
  1.  S UDISPLAY=$$GET^DDSVAL(811.2,IEN,225)
  1.  I (MIN=""),(MAX=""),(MAXDEC=""),(UCUM=""),(PROMPT=""),(UDISPLAY="") G SPONCLASS
  1.  ;If any of the measurement fields are defined they all must be.
  1.  I (MIN="")!(MAX="")!(MAXDEC="")!(UCUM="")!(PROMPT="")!(UDISPLAY="") D  Q
  1.  . S TEXT="If any of the measurement fields are defined, they all must be."
  1.  . D HLP^DDSUTL(.TEXT)
  1.  . S DDSBR="MINIMUM VALUE",DDSERROR=1
  1.  I MAX<MIN D  Q
  1.  . S TEXT="The Maximum Value cannot be less than the Minimum Value."
  1.  . D HLP^DDSUTL(.TEXT)
  1.  . S DDSBR="MAXIMUM VALUE",DDSERROR=1
  1. SPONCLASS ;Make sure the Class of the Sponsor matches that of the Taxonomy.
  1.  N CLASS,ERROR,NAME,SCLASS,SIEN
  1.  S CLASS=$$GET^DDSVAL(811.2,IEN,100,.ERROR,"I")
  1.  S SIEN=$$GET^DDSVAL(811.2,IEN,101,.ERROR,"I")
  1.  S SCLASS=$S(SIEN="":"",1:$$GET1^DIQ(811.6,SIEN,100,"I"))
  1.  I (SCLASS'=""),(SCLASS'=CLASS) D
  1.  . S TEXT="Sponsor Class is "_SCLASS_", Taxonomy Class is "_CLASS_" they must match!"
  1.  . D HLP^DDSUTL(.TEXT)
  1.  . S DDSBR="CLASS",DDSERROR=1
  1.  ;If the Name starts with VA- make sure the Class is National.
  1.  S NAME=$$GET^DDSVAL(811.2,IEN,.01,.ERROR,"I")
  1.  I $E(NAME,1,3)="VA-",CLASS'="N" D
  1.  . S TEXT="Name starts with 'VA-', but the Class is not National."
  1.  . D HLP^DDSUTL(.TEXT)
  1.  . S DDSBR="NAME",DDSERROR=1
  1.  Q
  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.  ;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 TERM
  1.  S TERM=$$GET^DDSVAL(811.23,.DA,.01,"","E")
  1.  I TERM="" Q $$REPEAT^XLFSTR(" ",30)
  1.  N CODESYS,COUNT,ERROR,IND,NUID,NUM,TEMP,TEXT,UID
  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.  ;If nothing was found for this term in ^TMP("PXRMCODES"), check for
  1.  ;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.  .;If COUNT is already defined for this CODESYS don't get the stored
  1.  .;values.
  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.  ;DX and DY should not be newed or killed, control by ScreenMan
  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.  . 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,CSYSIND,DELTERM,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 DELTERM=$G(^TMP("PXRMCODES",$J,TERM))
  1.  . I DELTERM="@" D  Q
  1.  .. S IENS=TERMIND_","_IEN_","
  1.  .. S KFDA(811.23,IENS,.01)="@"
  1.  .. D FILE^DIE("","KFDA","MSG")
  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.  .. I NSEL>0 D
  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.  . I $D(FDA) 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.  ;Reset the 811.23 0 node so holes are not left.
  1.  I $D(^PXD(811.2,IEN,20)) S $P(^PXD(811.2,IEN,20,0),U,3)=0
  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,DDSSAVE,DEL,DIDEL,DIMSG,DR,DTOUT
  1.  N HASH256,OCLOG,NATOK,SHASH256
  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.  S NEW=$G(NEW)
  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.  ;Initialize the code list.
  1.  D CODELIST(IEN)
  1.  S SHASH256=$$FILE^XLFSHAN(256,811.2,IEN)
  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 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. However, if the change was a deletion skip
  1.  ;the change log.
  1.  S DEL=$S($D(^PXD(811.2,IEN)):0,1:1)
  1.  I DEL&(FORM="PXRM TAXONOMY EDIT") D  Q
  1.  . D BLDLIST^PXRMTAXL("PXRMTAXL")
  1.  . S VALMBCK="R"
  1.  I NEW S OCLOG=1
  1.  E  S HASH256=$$FILE^XLFSHAN(256,811.2,IEN),OCLOG=$S(HASH256=SHASH256:0,1:1)
  1.  I 'OCLOG S VALMBCK="R" Q
  1.  ;Open the Change Log
  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.  I (FORM="PXRM TAXONOMY EDIT") D BLDLIST^PXRMTAXL("PXRMTAXL") S VALMBCK="R"
  1.  Q
  1.  ;
  1.  ;===============
  1. VEALLSEL(DA) ;Branch for View/edit all selected codes.
  1.  ;selection.
  1.  N PXRMLEXV,SAVEDDS
  1.  K ^TMP("PXRMTAX",$J)
  1.  S ^TMP("PXRMTAX",$J,"TAXIEN")=DA
  1.  ;DBIA #5746 covers kill and set of DDS.
  1.  I $D(DDS) S SAVEDDS=DDS K DDS
  1.  D EN^VALM("PXRM TAXONOMY ALL SELECTED")
  1.  K ^TMP("PXRMTAX",$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.  ;