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

PXRMEXID.m

Go to the documentation of this file.
  1. PXRMEXID ;SLC/PJH - Reminder Dialog Exchange Install Routine. ;09/08/2015 09:21
  1. ;;2.0;CLINICAL REMINDERS;**6,12,24,26,45**;Feb 04, 2005;Build 566
  1. ;
  1. ;==================================================
  1. ;Install all dialog components in an exchange file entry
  1. ;------------------------------------------------
  1. INSALL N ALL,DIROUT,DIRUT,DTOUT,DUOUT,IND,PXRMDONE
  1. ;
  1. ;Set the install date and time.
  1. S IND="",PXRMDONE=0
  1. ;
  1. ;Go to full screen mode.
  1. D FULL^VALM1
  1. ;
  1. ;Check if all or none exists - option to install all unchanged
  1. N DNAME
  1. S DNAME=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAME"))
  1. D EXIST^PXRMEXIX(.ALL,DNAME,"reminder dialog","")
  1. I ALL=0 D DISP^PXRMEXLD(PXRMMODE) Q
  1. ;
  1. ;Lock the entire file
  1. Q:'$$LOCK
  1. F S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:(IND="")!(PXRMDONE) D
  1. .D INSCOM(DNAME,IND,1)
  1. ;
  1. ;Clear lock
  1. D UNLOCK
  1. ;
  1. ;Rebuild display workfile
  1. D DISP^PXRMEXLD(PXRMMODE)
  1. ;
  1. K PXRMNMCH
  1. Q
  1. ;
  1. ;Build list of descendents names
  1. ;-------------------------------
  1. INSBLD(DIALNAM,NAME,INAME) ;
  1. N DNAME,IDATA,ISEQ
  1. S ISEQ=0
  1. F S ISEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:'ISEQ D
  1. .S IDATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:IDATA=""
  1. .S DNAME=$P(IDATA,U) Q:DNAME=""
  1. .;
  1. .I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D
  1. ..S REPL=$$CHKREPL^PXRMEXDB(DIALNAM,NAME) I REPL>0 D INSREPL(DIALNAM,NAME,REPL,.INAME)
  1. .S INAME(DNAME)=""
  1. .;Check for descendants
  1. .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DIALNAM,DNAME,.INAME)
  1. Q
  1. ;
  1. ;Build list of replacement names
  1. ;-------------------------------
  1. INSREPL(DIALNAME,NAME,REPL,INAME) ;
  1. N DNAME,IDATA,ISEQ
  1. S ISEQ=0
  1. S IDATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",DIALNAM,REPL,NAME)) Q:IDATA=""
  1. S DNAME=$P(IDATA,U) Q:DNAME="" S INAME(DNAME)=""
  1. ;Check for descendants
  1. I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DIALNAM,DNAME,.INAME)
  1. Q
  1. ;
  1. ;Install component IND
  1. ;---------------------
  1. INSCOM(DIALNAM,IND,SILENT) ;
  1. N ACTION,ATTR,CSUM,DTYP,EXIEN,END,EXISTS,FILENUM,IND120,JND120
  1. N NEWPT01,PT01,START,REPL,SAME,TEMP
  1. S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),FILENUM=$P(TEMP,U,1)
  1. S START=$P(TEMP,U,2),END=$P(TEMP,U,3) Q:START=""
  1. S IND120=$P(TEMP,U,4) Q:'IND120
  1. S JND120=$P(TEMP,U,5) Q:'JND120
  1. S EXISTS=$P(TEMP,U,6)
  1. S TEMP=^PXD(811.8,PXRMRIEN,100,START,0),PT01=$P(TEMP,"~",2) Q:PT01=""
  1. S DTYP=$G(^TMP("PXRMEXTMP",$J,"DTYP",PT01))
  1. I DTYP="dialog" S DTYP="reminder dialog"
  1. ;
  1. ;Go to full screen mode.
  1. D FULL^VALM1
  1. ;
  1. ;Check for descendents
  1. S REPL=$$CHKREPL^PXRMEXDB(DIALNAM,PT01)
  1. I 'SILENT&($$INSDSC(PT01)!(REPL>0)) D Q:PXRMDONE
  1. .N ANS,INDS,TEXT
  1. .S TEXT(1)=PT01_" ("_DTYP_") contains sub-components."
  1. .S TEXT="Install all sub-components with the "_DTYP_": "
  1. .;Give option to install all descendents
  1. .D ASK^PXRMEXIX(.ANS,.TEXT,1) Q:PXRMDONE
  1. .I $G(ANS)="N" S PXRMDONE=1 Q
  1. .I $G(ANS)="Y" D
  1. ..S INDS=IND
  1. ..N IDATA,INAME,IND
  1. ..I REPL>0 D INSREPL(DIALNAM,PT01,REPL,.INAME)
  1. ..;Build list of decendents to install
  1. ..D INSBLD(DIALNAM,PT01,.INAME)
  1. ..;Check if all or none exists - option to install all unchanged
  1. ..D EXIST^PXRMEXIX(.ALL,PT01,DTYP,.INAME) Q:PXRMDONE
  1. ..;Start at the end of the list
  1. ..S IND=""
  1. ..F S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:PXRMDONE!(IND=INDS) D
  1. ...N PT01,START,TEMP
  1. ...S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),START=$P(TEMP,U,2) Q:START=""
  1. ...S PT01=$P(^PXD(811.8,PXRMRIEN,100,START,0),"~",2) Q:PT01=""
  1. ...;Ignore namechanges
  1. ...I $D(PXRMNMCH(801.41,PT01)) Q
  1. ...;Only install descendents
  1. ...I $D(INAME(PT01)) D INSCOM(DIALNAM,IND,1)
  1. ;
  1. SETENTRY ;
  1. D SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
  1. S ACTION=""
  1. ;Double check that it hasn't been installed
  1. S EXIEN=$$EXISTS^PXRMEXIU(801.41,PT01)
  1. I EXIEN,'EXISTS S EXISTS=1
  1. I EXISTS D
  1. . D CHECKSUM^PXRMEXCS(.ATTR,START,END)
  1. . S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),EXIEN)
  1. . S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
  1. . I SAME D FEIMSG^PXRMEXFI(SAME,.ATTR) S ACTION="S",(PXRMNMCH,NEWPT01)=""
  1. I ACTION="" D
  1. .;If all components installed the default is 'Install or Overwrite'
  1. . S:ALL ACTION=$S(EXISTS:"O",1:"I"),(PXRMNMCH,NEWPT01)=""
  1. . S:'ALL ACTION=$$GETFACT^PXRMEXFI(PT01,.ATTR,.NEWPT01,.PXRMNMCH,EXIEN)
  1. ;Save what was done for the installation summary.
  1. S ^TMP("PXRMEXIAD",$J,IND,ATTR("FILE NAME"),ATTR("PT01"),ACTION)=NEWPT01
  1. ;Clear heading
  1. S VALMHDR(2)=""
  1. ;If the ACTION is Quit then quit the entire install.
  1. I ACTION="Q" S PXRMDONE=1 S VALMHDR(2)="Install not completed" Q
  1. ;If the ACTION is Skip then skip this component.
  1. I ACTION="S" S VALMBCK="R" Q
  1. ;If the ACTION is Replace then skip this component.
  1. I ACTION="P" S VALMBCK="R",VALMHDR(2)=PT01_" replaced with "_NEWPT01 Q
  1. ;Install this component.
  1. D FILE^PXRMEXIC(PXRMRIEN,EXIEN,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
  1. S VALMBCK="R"
  1. I PXRMDONE S VALMHDR(2)="Install aborted" Q
  1. I NEWPT01="" S VALMHDR(2)=PT01_" ("_DTYP_") installed from exchange file."
  1. I NEWPT01'="" S VALMHDR(2)=PT01_" installed as "_NEWPT01_"."
  1. ;If reminder dialog - disable and give option to link
  1. I DTYP="reminder dialog" D
  1. .N DNAME
  1. .S DNAME=PT01
  1. .I NEWPT01'="" S DNAME=NEWPT01
  1. .D INSLNK(DNAME)
  1. .I $D(^TMP("PXRM DIALOG LINK FILE",$J))>0 D DLINKSET^PXRMEXU5
  1. Q
  1. ;
  1. ;Check for descendents (either elements or prompts)
  1. ;--------------------------------------------------
  1. INSDSC(NAME) ;
  1. N DATA,DFOUND,SUB
  1. S DFOUND=0,SUB=0
  1. F S SUB=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:'SUB D Q:DFOUND
  1. .S DATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:DATA=""
  1. .S DFOUND=1
  1. Q DFOUND
  1. ;
  1. INSREPL1(NAME) ;
  1. N DATA,DFOUND,SUB
  1. S DFOUND=0,SUB=0
  1. F S SUB=$O(^TMP("PXRMEXTMP",$J,"DREPL",NAME,SUB)) Q:'SUB D Q:DFOUND
  1. .S DATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",NAME,SUB)) Q:DATA=""
  1. .S DFOUND=1
  1. Q DFOUND
  1. ;Option to link dialog to a reminder
  1. ;-----------------------------------
  1. INSLNK(DNAME) ;
  1. N DIEN,DISABLE,DSRC,RNAME
  1. N DA,DIE,DR
  1. ;Disable
  1. S DIEN=$O(^PXRMD(801.41,"B",DNAME,"")) Q:'DIEN
  1. ;Set dialog as disabled
  1. S DISABLE=1
  1. ;Except for National dialogs
  1. I $P(^PXRMD(801.41,DIEN,100),U)="N" S DISABLE=0
  1. ;
  1. S DR="3///^S X=DISABLE",DIE="^PXRMD(801.41,",DA=$P(DIEN,U)
  1. D ^DIE
  1. ;
  1. ;Quit if already linked
  1. I $D(^PXD(811.9,"AG",DIEN)) Q
  1. ;
  1. S RNAME=$O(^TMP("PXRMEXDL",$J,DNAME,""))
  1. ;
  1. ;Otherwise use original reminder name as default
  1. I RNAME="" D
  1. .N DATA,FOUND,RIEN,SUB
  1. .;Rebuild ^TMP("PXRMEXLC",$J
  1. .D CDISP^PXRMEXLC(PXRMRIEN)
  1. .;
  1. .S SUB="",FOUND=0
  1. .F S SUB=$O(^TMP("PXRMEXLC",$J,"SEL",SUB),-1) Q:'SUB Q:FOUND D
  1. ..S DATA=$G(^TMP("PXRMEXLC",$J,"SEL",SUB)) Q:$P(DATA,U)'=811.9
  1. ;
  1. I RNAME="" Q
  1. TAG W !!,"Reminder Dialog "_DNAME_" is not linked to a reminder.",!
  1. ;Select reminder to link
  1. S IEN=$$SELECT^PXRMINQ("^PXD(811.9,","Select Reminder to Link: ",RNAME)
  1. ;Update reminder link in #811.9
  1. I $P(IEN,U)'=-1 D
  1. .N DA,DIE,DIK,DR
  1. .;Set reminder to dialog pointer
  1. .S DR="51///^S X=DNAME",DIE="^PXD(811.9,",DA=$P(IEN,U)
  1. .D ^DIE
  1. .;If source reminder is null replace with linked reminder
  1. .S DSRC=$P($G(^PXRMD(801.41,DIEN,0)),U,2) Q:DSRC
  1. .S DSRC=$P(IEN,U)
  1. .S DR="2///^S X=DSRC",DIE="^PXRMD(801.41,",DA=$P(DIEN,U)
  1. .D ^DIE
  1. Q
  1. ;
  1. ;Install Selected Components
  1. ;---------------------------
  1. INSSEL N ALL,IND,PXRMDONE,VALMY
  1. N DIROUT,DIRUT,DNAME,DTOUT,DUOUT
  1. N VALMBG,VALMLST
  1. S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXLD",$J,"IDX",""),-1)
  1. ;Get the list to install.
  1. D EN^VALM2(XQORNOD(0))
  1. ;
  1. ;Set the install date and time.
  1. S ALL="",PXRMDONE=0
  1. ;
  1. ;Lock the entire file
  1. Q:'$$LOCK
  1. ;
  1. S DNAME=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAME"))
  1. S IND=0
  1. F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D INSCOM(DNAME,IND,0)
  1. ;
  1. ;Clear locks
  1. D UNLOCK
  1. ;
  1. ;Rebuild workfile
  1. D DISP^PXRMEXLD(PXRMMODE)
  1. Q
  1. ;
  1. ;Install the exchange entry PXRMRIEN
  1. ;-----------------------------------
  1. INSTALL N CLOK,IEN,IND,VALMY
  1. ;Make sure the component list exists for this entry. PXRMRIEN is
  1. ;set in INSTALL^PXRMEXLR.
  1. S CLOK=1
  1. I '$D(^PXD(811.8,PXRMRIEN,120)) D CLIST^PXRMEXCO(PXRMRIEN,.CLOK)
  1. I 'CLOK Q
  1. D CDISP^PXRMEXLC(PXRMRIEN)
  1. S VALMBCK="R",VALMCNT=$O(^TMP("PXRMEXLD",$J,"IDX"),-1)
  1. Q
  1. ;
  1. PXRM(NAME) ;Validate prompts
  1. ;Ignore non-PXRM
  1. I $E(NAME,1,4)'="PXRM" Q 0
  1. N DIEN,RESULT
  1. I $G(PXRMINST)=1 D Q RESULT
  1. .S RESULT=0
  1. .S DIEN=$O(^PXRMD(801.41,"B",NAME,"")) I 'DIEN Q
  1. .I $P($G(^PXRMD(801.41,DIEN,100)),U)'="N" Q
  1. .I ($P($G(^PXRMD(801.41,DIEN,0)),U,4)="P")!($P($G(^PXRMD(801.41,DIEN,0)),U,4)="F") S RESULT=1
  1. ;
  1. ;Check if this is a national code
  1. S DIEN=$O(^PXRMD(801.41,"B",NAME,""))
  1. ;If not found abort
  1. I 'DIEN Q 0
  1. ;if result group/element quit
  1. I $P($G(^PXRMD(801.41,DIEN,0)),U,4)="S"!($P($G(^PXRMD(801.41,DIEN,0)),U,4)="T") Q 0
  1. ;Check class
  1. I $P($G(^PXRMD(801.41,DIEN,100)),U)="N" Q 1
  1. ;Otherwise local
  1. Q 0
  1. ;
  1. ;Lock the dialog file
  1. LOCK() ;
  1. L +^PXRMD(801.41):DILOCKTM I Q 1
  1. E W !,"Another user is editing this file, try later" H 2
  1. Q 0
  1. ;
  1. ;Clear lock
  1. UNLOCK L -^PXRMD(801.41)
  1. Q