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

PXRMEXIC.m

Go to the documentation of this file. 
  1. PXRMEXIC ;SLC/PKR,PJH - Routines to install repository entry components. ;09/27/2018
  1.  ;;2.0;CLINICAL REMINDERS;**6,12,17,16,18,22,24,26,47,45**;Feb 04, 2005;Build 566
  1.  ;=================================================
  1. FILE(PXRMRIEN,SITEIEN,IND120,JND120,ACTION,ATTR,NAMECHG) ;Read and process a
  1.  ;file entry in repository entry PXRMRIEN. IND120 and JND120 are the
  1.  ;indexes for the component list. ACTION is one of the possible actions.
  1.  I ACTION="S" Q
  1.  N DATA,DUZ0S,EDULIST,FDA,FDAEND,FDASTART,FIELD,FILENUM
  1.  N IEN,IENS,IENREND,IENROOT,IENRSTR,IENUSED,IND,INDICES
  1.  N LINE,MSG,NAME,NEW01,PXNAT,PXRMEDOK,PXRMEXCH
  1.  N SRCIEN,START,TEMP,TEXT,TFDA,TIENROOT,TIUFPRIV,TNAME,TOPFNUM,VERSN
  1.  N WPLCNT,WPTMP,XUMF
  1.  ;I $G(PXRMIGDS) S DUZ0S=DUZ(0),DUZ(0)="^",XUMF=1
  1.  ;Set PXRMEDOK so files pointing to sponsors can be installed.
  1.  ;Set PXRMEXCH so national entries can be installed and prevent
  1.  ;execution of the input transform for custom logic fields.
  1.  ;Set PXNAT to allow installation of national PCE data types.
  1.  S (PXNAT,PXRMEDOK,PXRMEXCH)=1
  1.  S TEMP=^PXD(811.8,PXRMRIEN,120,IND120,1,JND120,0)
  1.  S FDASTART=+$P(TEMP,U,2)
  1.  S FDAEND=+$P(TEMP,U,3)
  1.  S IENRSTR=+$P(TEMP,U,4)
  1.  S IENREND=+$P(TEMP,U,5)
  1.  F IND=FDASTART:1:FDAEND D
  1.  . S LINE=^PXD(811.8,PXRMRIEN,100,IND,0)
  1.  . S INDICES=$P(LINE,"~",1)
  1.  . S DATA=$P(LINE,"~",2)
  1.  . S FILENUM=$P(INDICES,";",1)
  1.  . S IENS=$P(INDICES,";",2)
  1.  . I IND=FDASTART S SRCIEN=+IENS
  1.  . S FIELD=$P(INDICES,";",3)
  1.  . I LINE["WP-start" D
  1.  .. S DATA="WPTMP("_IND_","_+FIELD_")"
  1.  .. S WPLCNT=$P(LINE,"~",3)
  1.  .. D WORDPROC(PXRMRIEN,.WPTMP,IND,+FIELD,.IND,WPLCNT)
  1.  . I (IND=FDASTART)&((FIELD=.01)!(FIELD=.001)) D
  1.  ..;Save the top level file number.
  1.  .. S TOPFNUM=FILENUM
  1.  ..;If the action is copy put it in the first open spot.
  1.  .. I ACTION="C" S IENROOT(SRCIEN)=$$LOIEN^PXRMEXU5(TOPFNUM,0)
  1.  ..;
  1.  ..;If the entry does not exist and the action is not copy set the
  1.  ..;action to install.
  1.  .. I SITEIEN=0 S ACTION="I"
  1.  ..;
  1.  ..;If the action is install try to install at the source IEN. If
  1.  ..;an entry already exists at the source IEN put it in the first
  1.  ..;open spot. 
  1.  .. I ACTION="I" D
  1.  ... S IENUSED=+$$FIND1^DIC(FILENUM,"","QU","`"_SRCIEN)
  1.  ... S IENROOT(SRCIEN)=$S(IENUSED=0:SRCIEN,1:$$LOIEN^PXRMEXU5(FILENUM))
  1.  ..;
  1.  ..;If the action is merge, overwrite,or update install at the site's
  1.  ..;IEN.
  1.  .. I (ACTION="M")!(ACTION="O")!(ACTION="U") S IENROOT(SRCIEN)=SITEIEN
  1.  .;
  1.  .;This line is use to convert pre-patch 12 disable text to the new
  1.  .;value of 1 for disable
  1.  . I FILENUM=801.41,FIELD=3,DATA'="",$L(DATA)>2 D
  1.  ..I DATA="DISABLE AND DO NOT SEND MESSAGE" Q
  1.  ..S DATA="DISABLE AND SEND MESSAGE"
  1.  .;
  1.  . S FDA(FILENUM,IENS,FIELD)=DATA
  1.  ;
  1.  ;Initialize the edit history.
  1.  D INIEH(TOPFNUM,IENS,.FDA,.WPTMP)
  1.  ;Build the IENROOT
  1.  F IND=IENRSTR:1:IENREND D
  1.  . I IND=0 Q
  1.  . S TEMP=^PXD(811.8,PXRMRIEN,100,IND,0)
  1.  . S IENROOT($P(TEMP,U,1))=$P(TEMP,U,2)
  1.  ;Check for name changes, i.e., the copy action.
  1.  D NAMECHG(.FDA,.NAMECHG,TOPFNUM)
  1.  ;
  1.  ;Special handling for file 142.
  1.  I TOPFNUM=142 D  Q:'$D(FDA)
  1.  . D SFMVPI^PXRMEXIU(.FDA,.NAMECHG,142.14)
  1.  ;
  1.  ;Special handling for file 801
  1.  I TOPFNUM=801 D  Q:PXRMDONE
  1.  . D SFMVPI^PXRMEXIU(.FDA,.NAMECHG,801.015)
  1.  . D ROC^PXRMEXU5(.FDA,.IENROOT)
  1.  ;
  1.  ;Special handling for file 801.1
  1.  I TOPFNUM=801.1 D  Q:PXRMDONE
  1.  . D ROCR^PXRMEXU5(.FDA)
  1.  ;
  1.  I TOPFNUM=801.48 D DLINKSAV^PXRMEXU5(.FDA) Q:PXRMDONE
  1.  ;Special handling for file 801.41
  1.  I TOPFNUM=801.41 D  Q:PXRMDONE
  1.  . I ACTION="M" D MOU^PXRMEXU5(801.41,SITEIEN,"18*",.FDA,.IENROOT,ACTION,.WPTMP)
  1.  . D DLG^PXRMEXU4(.FDA,.NAMECHG)
  1.  ;
  1.  ;Special handling for file 810.9
  1.  I TOPFNUM=810.9 D LOC^PXRMEXU0(.FDA)
  1.  ;
  1.  ;Special handling for file 811.2
  1.  I TOPFNUM=811.2 D TAX^PXRMEXU0(.FDA,"CFR")
  1.  ;
  1.  I TOPFNUM=801.46 D DIALOGGF^PXRMEXU5(.FDA,.IENROOT)
  1.  ;
  1.  ;If the file number is 811.4 the user must have programmer
  1.  ;access to install it.
  1.  I (TOPFNUM=811.4)&(DUZ(0)'="@") D  Q
  1.  . W !,"Only programmers can install Reminder Computed Findings."
  1.  ;
  1.  ;Special handling for file 811.5.
  1.  I TOPFNUM=811.5 D  Q:'$D(FDA)
  1.  .;If the site has any findings already mapped merge them in.
  1.  . I (ACTION="M")!(ACTION="U") D MOU^PXRMEXU5(811.5,SITEIEN,"20*",.FDA,.IENROOT,ACTION,.WPTMP)
  1.  . D SFMVPI^PXRMEXIU(.FDA,.NAMECHG,811.52)
  1.  ;
  1.  ;Special handling for file 811.9.
  1.  I TOPFNUM=811.9 D
  1.  .;Don't execute the input transform for custom logic fields.
  1.  . S PXRMEXCH=1
  1.  . D DEF^PXRMEXIU(.FDA,.NAMECHG)
  1.  ;
  1.  ;Special handling for file 8925.1
  1.  I TOPFNUM=8925.1 D
  1.  . S TIUFPRIV=1
  1.  . D TIUOBJ^PXRMEXIU(.FDA)
  1.  ;
  1.  ;Special handling for file 9999999.09: Education Topics.
  1.  I TOPFNUM=9999999.09 D EDU^PXRMEXIU(.FDA,.EDULIST)
  1.  ;
  1.  ;Special handling for file 9999999.15: Exams.
  1.  I TOPFNUM=9999999.15 D EXAM^PXRMEXIU(.FDA)
  1.  ;
  1.  ;Special handling for file 9999999.64: Health Factors.
  1.  I TOPFNUM=9999999.64 D HF^PXRMEXIU(.FDA)
  1.  ;
  1.  ;
  1.  ;If FDA is not defined at this point the user has opted to abort
  1.  ;the install.
  1.  I '$D(FDA) Q
  1.  ;
  1.  ;If the action is merge, overwrite, or update do a test install
  1.  ;before deleting the original entry.
  1.  I (ACTION="M")!(ACTION="O")!(ACTION="U") D
  1.  .;Make the .01 unique for the test install.
  1.  . S IENS=$O(FDA(TOPFNUM,""))
  1.  .;Get the length of the .01 field
  1.  . D FIELD^DID(TOPFNUM,.01,"","FIELD LENGTH","ATTR")
  1.  . S TNAME="tmp"_$E(FDA(TOPFNUM,IENS,.01),1,ATTR("FIELD LENGTH")-3)
  1.  .;Make sure the test entry does not already exist.
  1.  . D DELALL^PXRMEXFI(TOPFNUM,TNAME)
  1.  . M TFDA=FDA
  1.  . S TFDA(TOPFNUM,IENS,.01)=TNAME
  1.  . K TIENROOT M TIENROOT=IENROOT
  1.  . S TIENROOT(SRCIEN)=$$LOIEN^PXRMEXU5(TOPFNUM)
  1.  . D UPDATE^DIE("E","TFDA","TIENROOT","MSG")
  1.  . I $D(MSG) D  Q
  1.  .. S TEXT(1)=ATTR("FILE NAME")_" entry "_$G(ATTR("PT01"))_" did not get installed!"
  1.  .. S TEXT(2)="Examine the following error message for the reason."
  1.  .. S TEXT(3)=""
  1.  .. S TEXT(4)="The test update failed, UPDATE^DIE returned the following error message:"
  1.  .. D MES^XPDUTL(.TEXT)
  1.  .. D AWRITE^PXRMUTIL("MSG")
  1.  .. H 2
  1.  .;Delete the test entry.
  1.  . D DELALL^PXRMEXFI(TOPFNUM,TNAME)
  1.  .;If the original update worked put the entry at its original ien.
  1.  .;Delete the existing entry.
  1.  . D DELETE^PXRMEXFI(TOPFNUM,SITEIEN)
  1.  D UPDATE^DIE("ES","FDA","IENROOT","MSG")
  1.  I '$D(MSG),ATTR("FILE NUMBER")=9999999.64 D
  1.  . ;Build a list of health factor categories that need the [C] appended
  1.  . N IENS
  1.  . S IENS=$O(FDA(9999999.64,""))
  1.  . I FDA(9999999.64,IENS,.1)'="CATEGORY" Q
  1.  . N L3C,LEN,NAME
  1.  . S NAME=ATTR("NAME")
  1.  . S LEN=$L(NAME),L3C=$E(NAME,(LEN-2),LEN)
  1.  . I L3C'="[C]" S ^TMP($J,"HFCAT",NAME)=""
  1.  I $D(MSG) D
  1.  . S TEXT(1)=ATTR("FILE NAME")_" entry "_$G(ATTR("PT01"))_" did not get installed!"
  1.  . S TEXT(2)="Examine the following error message for the reason."
  1.  . S TEXT(3)=""
  1.  . S TEXT(4)="The update failed, UPDATE^DIE returned the following error message:"
  1.  . D MES^XPDUTL(.TEXT)
  1.  . D AWRITE^PXRMUTIL("MSG")
  1.  . W !
  1.  . H 2
  1.  ;
  1.  I TOPFNUM=811.2 D
  1.  .;Finish conversion from pointer based structure to Lexicon based.
  1.  . N IEN,PDS
  1.  . S IEN=+$O(^PXD(811.2,"B",ATTR("NAME"),""))
  1.  . I IEN=0 Q
  1.  . D EXCH^PXRMTXCR(IEN,"CFR")
  1.  . S PDS=$P(^PXD(811.2,IEN,0),U,4)
  1.  . I PDS="" D SPDS^PXRMPDS(IEN,PDS)
  1.  .;If there are codes marked Use In Dialog build the 30 node.
  1.  . D BLD30N^PXRMTAXD(IEN)
  1.  ;
  1.  S VERSN=$$GETTAGV^PXRMEXU3(^PXD(811.8,PXRMRIEN,100,3,0),"<PACKAGE_VERSION>")
  1.  I TOPFNUM=811.9,VERSN=1.5 D
  1.  . N IEN,PXRMEXCH,X
  1.  . S IEN=+$O(^PXD(811.9,"B",ATTR("PT01"),""))
  1.  . I IEN=0 Q
  1.  .;For reminder definitions build the found/not found text counts.
  1.  . D SFNFTC^PXRMEXU0(IEN)
  1.  .;Build the internal logic and finding strings.
  1.  . S X=$G(^PXD(811.9,IEN,30))
  1.  . I X'="" D CPPCLS^PXRMLOGX(IEN,X)
  1.  . S X=$G(^PXD(811.9,IEN,34))
  1.  . I X'="" D CPRESLS^PXRMLOGX(IEN,X)
  1.  . D BLDALL^PXRMLOGX(IEN,"","")
  1.  ;If there are national education topics rename them so they start
  1.  ;with VA-
  1.  I $D(EDULIST),$G(PXRMNAT) D
  1.  .;Get the length of the .01 field
  1.  . D FIELD^DID(TOPFNUM,.01,"","FIELD LENGTH","ATTR")
  1.  . S NAME=""
  1.  . F  S NAME=$O(EDULIST(NAME)) Q:NAME=""  D
  1.  .. I $E(NAME,1,3)="VA-" Q
  1.  .. S TNAME="VA-"_$E(ATTR("FIELD LENGTH")-3)
  1.  .. D RENAME^PXRMUTIL(TOPFNUM,NAME,TNAME)
  1.  ;I $G(PXRMIGDS) S DUZ(0)=DUZ0S
  1.  Q
  1.  ;
  1.  ;=================================================
  1. INIEH(FILENUM,IENS,FDA,WPTMP) ;If the file is a clinical reminder file and
  1.  ;it has an edit history initialize the history.
  1.  I (FILENUM<800)!(FILENUM>811.9) Q
  1.  N IENS,SFN,TARGET,WP
  1.  D FIELD^DID(FILENUM,"CHANGE LOG","","SPECIFIER","TARGET")
  1.  S SFN=+$G(TARGET("SPECIFIER"))
  1.  I SFN=0 D FIELD^DID(FILENUM,"EDIT HISTORY","","SPECIFIER","TARGET")
  1.  S SFN=+$G(TARGET("SPECIFIER"))
  1.  I SFN=0 Q
  1.  S IENS=$O(FDA(SFN,""))
  1.  I IENS="" Q
  1.  S FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1.  S FDA(SFN,IENS,1)="`"_DUZ
  1.  ;The word-processing field is set when the packing is done.
  1.  S WP=FDA(SFN,IENS,2)
  1.  K @WP
  1.  S @WP@(1)="Exchange Install"
  1.  Q
  1.  ;
  1.  ;=================================================
  1. NAMECHG(FDA,NAMECHG,FILENUM) ;If this component has been copied to a new
  1.  ;name make the change.
  1.  N CLASS,IENS,PT01
  1.  S IENS=$O(FDA(FILENUM,""))
  1.  S PT01=FDA(FILENUM,IENS,.01)
  1.  I $D(NAMECHG(FILENUM,PT01)) D
  1.  . S FDA(FILENUM,IENS,.01)=NAMECHG(FILENUM,PT01)
  1.  . I (FILENUM<801.41)!(FILENUM>811.9) Q
  1.  .;Once a component has been copied CLASS can no longer be national.
  1.  . S CLASS=$G(FDA(FILENUM,IENS,100))
  1.  . I CLASS["N" S FDA(FILENUM,IENS,100)="LOCAL"
  1.  .;The Sponsor is also removed.
  1.  . K FDA(FILENUM,IENS,101)
  1.  Q
  1.  ;
  1.  ;=================================================
  1. RTNLD(PXRMRIEN,START,END,ATTR,RTN) ;Load a routine from the repository into
  1.  ;the array RTN.
  1.  N IND,LINE,LN,ROUTINE
  1.  S LINE=^PXD(811.8,PXRMRIEN,100,START,0)
  1.  S ROUTINE=$P(LINE,";",1)
  1.  S ROUTINE=$TR(ROUTINE," ","")
  1.  S ATTR("FILE NUMBER")=0
  1.  S ATTR("NAME")=$P(LINE,";",1)
  1.  S ATTR("NAME")=$TR(ATTR("NAME")," ","")
  1.  S ATTR("MIN FIELD LENGTH")=3
  1.  S ATTR("FIELD LENGTH")=8
  1.  S LN=0
  1.  F IND=START:1:END D
  1.  . S LN=LN+1
  1.  . S LINE=^PXD(811.8,PXRMRIEN,100,IND,0)
  1.  . S RTN(LN,0)=LINE
  1.  Q
  1.  ;
  1.  ;=================================================
  1. RTNSAVE(RTN,NAME) ;Save the routine loaded in RTN to the name
  1.  ;found in NAMECHG.
  1.  N DIE,XCN
  1.  ;%ZOSF("SAVE") requires a global.
  1.  K ^TMP($J,"PXRMRTN")
  1.  S DIE="^TMP($J,""PXRMRTN"","
  1.  M ^TMP($J,"PXRMRTN")=RTN
  1.  S XCN=0
  1.  S X=NAME
  1.  X ^%ZOSF("SAVE")
  1.  K ^TMP($J,"PXRMRTN")
  1.  Q
  1.  ;
  1.  ;=================================================
  1. WORDPROC(PXRMRIEN,WPTMP,I1,I2,IND,WPLCNT) ;Load WPTMP with the word
  1.  ;processing field.
  1.  N I3
  1.  F I3=1:1:WPLCNT D
  1.  . S IND=IND+1
  1.  . S WPTMP(I1,I2,I3)=$G(^PXD(811.8,PXRMRIEN,100,IND,0))
  1.  Q
  1.  ;