[628] | 1 | PXRMEXID ;SLC/PJH - Reminder Dialog Exchange Install Routine.;08/16/2007
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
|
---|
| 3 | ;
|
---|
| 4 | ;==================================================
|
---|
| 5 | ;
|
---|
| 6 | ;Install all dialog components in an exchange file entry
|
---|
| 7 | ;------------------------------------------------
|
---|
| 8 | INSALL N ALL,DIROUT,DIRUT,DTOUT,DUOUT,IND,PXRMDONE
|
---|
| 9 | ;
|
---|
| 10 | ;Set the install date and time.
|
---|
| 11 | S IND="",PXRMDONE=0
|
---|
| 12 | ;
|
---|
| 13 | ;Go to full screen mode.
|
---|
| 14 | D FULL^VALM1
|
---|
| 15 | ;
|
---|
| 16 | ;Check if all or none exists - option to install all unchanged
|
---|
| 17 | N DNAME
|
---|
| 18 | S DNAME=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAM"))
|
---|
| 19 | D EXIST^PXRMEXIX(.ALL,DNAME,"reminder dialog","")
|
---|
| 20 | I ALL=0 D DISP^PXRMEXLD(PXRMMODE) Q
|
---|
| 21 | ;
|
---|
| 22 | ;Lock the entire file
|
---|
| 23 | Q:'$$LOCK
|
---|
| 24 | F S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:(IND="")!(PXRMDONE) D
|
---|
| 25 | .D INSCOM(IND,1)
|
---|
| 26 | ;
|
---|
| 27 | ;Clear lock
|
---|
| 28 | D UNLOCK
|
---|
| 29 | ;
|
---|
| 30 | ;Rebuild display workfile
|
---|
| 31 | D DISP^PXRMEXLD(PXRMMODE)
|
---|
| 32 | ;
|
---|
| 33 | K PXRMNMCH
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|
| 36 | ;Build list of descendents names
|
---|
| 37 | ;-------------------------------
|
---|
| 38 | INSBLD(NAME,INAME) ;
|
---|
| 39 | N DNAME,IDATA,ISEQ
|
---|
| 40 | S ISEQ=0
|
---|
| 41 | F S ISEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:'ISEQ D
|
---|
| 42 | .S IDATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:IDATA=""
|
---|
| 43 | .S DNAME=$P(IDATA,U) Q:DNAME=""
|
---|
| 44 | .;
|
---|
| 45 | .I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D
|
---|
| 46 | ..S REPL=$$CHKREPL^PXRMEXD1(NAME) I REPL>0 D INSREPL(NAME,REPL,.INAME)
|
---|
| 47 | .S INAME(DNAME)=""
|
---|
| 48 | .;Q:$$PXRM(DNAME) S INAME(DNAME)=""
|
---|
| 49 | .;Check for descendants
|
---|
| 50 | .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DNAME,.INAME)
|
---|
| 51 | Q
|
---|
| 52 | ;Build list of replacement names
|
---|
| 53 | ;-------------------------------
|
---|
| 54 | INSREPL(NAME,REPL,INAME) ;
|
---|
| 55 | N DNAME,IDATA,ISEQ
|
---|
| 56 | S ISEQ=0
|
---|
| 57 | S IDATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",REPL,NAME)) Q:IDATA=""
|
---|
| 58 | S DNAME=$P(IDATA,U) Q:DNAME="" S INAME(DNAME)=""
|
---|
| 59 | ;S DNAME=$P(IDATA,U) Q:DNAME="" Q:$$PXRM(DNAME) S INAME(DNAME)=""
|
---|
| 60 | ;Check for descendants
|
---|
| 61 | I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DNAME,.INAME)
|
---|
| 62 | Q
|
---|
| 63 | ;
|
---|
| 64 | ;Install component IND
|
---|
| 65 | ;---------------------
|
---|
| 66 | INSCOM(IND,SILENT) ;
|
---|
| 67 | N ACTION,ATTR,CSUM,DTYP,EXIEN,END,EXISTS,FILENUM,IND120,JND120
|
---|
| 68 | N NEWPT01,PT01,START,REPL,SAME,TEMP
|
---|
| 69 | S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),FILENUM=$P(TEMP,U,1)
|
---|
| 70 | S EXISTS=$P(TEMP,U,4),START=$P(TEMP,U,2),END=$P(TEMP,U,3) Q:START=""
|
---|
| 71 | S JND120=$P(TEMP,U,6) Q:'JND120
|
---|
| 72 | S IND120=$P(TEMP,U,5) Q:'IND120
|
---|
| 73 | S TEMP=^PXD(811.8,PXRMRIEN,100,START,0),PT01=$P(TEMP,"~",2) Q:PT01=""
|
---|
| 74 | S DTYP=$G(^TMP("PXRMEXTMP",$J,"DTYP",PT01))
|
---|
| 75 | I DTYP="dialog" S DTYP="reminder dialog"
|
---|
| 76 | ;
|
---|
| 77 | ;Go to full screen mode.
|
---|
| 78 | D FULL^VALM1
|
---|
| 79 | ;
|
---|
| 80 | ;Check for descendents
|
---|
| 81 | S REPL=$$CHKREPL^PXRMEXD1(PT01)
|
---|
| 82 | I 'SILENT&($$INSDSC(PT01)!(REPL>0)) D Q:PXRMDONE
|
---|
| 83 | .N ANS,INDS,TEXT
|
---|
| 84 | .S TEXT(1)=PT01_" ("_DTYP_") contains sub-components."
|
---|
| 85 | .S TEXT="Install all sub-components with the "_DTYP_": "
|
---|
| 86 | .;Give option to install all descendents
|
---|
| 87 | .D ASK^PXRMEXIX(.ANS,.TEXT,1) Q:PXRMDONE
|
---|
| 88 | .I $G(ANS)="N" S PXRMDONE=1 Q
|
---|
| 89 | .I $G(ANS)="Y" D
|
---|
| 90 | ..S INDS=IND
|
---|
| 91 | ..N IDATA,INAME,IND
|
---|
| 92 | ..I REPL>0 D INSREPL(PT01,REPL,.INAME)
|
---|
| 93 | ..;Build list of decendents to install
|
---|
| 94 | ..D INSBLD(PT01,.INAME)
|
---|
| 95 | ..;Check if all or none exists - option to install all unchanged
|
---|
| 96 | ..D EXIST^PXRMEXIX(.ALL,PT01,DTYP,.INAME) Q:PXRMDONE
|
---|
| 97 | ..;Start at the end of the list
|
---|
| 98 | ..S IND=""
|
---|
| 99 | ..F S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:PXRMDONE!(IND=INDS) D
|
---|
| 100 | ...N PT01,START,TEMP
|
---|
| 101 | ...S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),START=$P(TEMP,U,2) Q:START=""
|
---|
| 102 | ...S PT01=$P(^PXD(811.8,PXRMRIEN,100,START,0),"~",2) Q:PT01=""
|
---|
| 103 | ...;Ignore namechanges
|
---|
| 104 | ...I $D(PXRMNMCH(801.41,PT01)) Q
|
---|
| 105 | ...;Only install descendents
|
---|
| 106 | ...I $D(INAME(PT01)) D INSCOM(IND,1)
|
---|
| 107 | ;
|
---|
| 108 | SETENTRY ;
|
---|
| 109 | D SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
|
---|
| 110 | S ACTION=""
|
---|
| 111 | ;Double check that it hasn't been installed
|
---|
| 112 | S EXIEN=$$EXISTS^PXRMEXIU(801.41,PT01)
|
---|
| 113 | I EXIEN,'EXISTS S EXISTS=1
|
---|
| 114 | I EXISTS D
|
---|
| 115 | . D CHECKSUM^PXRMEXCS(.ATTR,START,END)
|
---|
| 116 | . S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),EXIEN)
|
---|
| 117 | . S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
|
---|
| 118 | . I SAME D FEIMSG^PXRMEXFI(SAME,.ATTR) S ACTION="S",(PXRMNMCH,NEWPT01)=""
|
---|
| 119 | I ACTION="" D
|
---|
| 120 | .;If all components installed the default is 'Install or Overwrite'
|
---|
| 121 | . S:ALL ACTION=$S(EXISTS:"O",1:"I"),(PXRMNMCH,NEWPT01)=""
|
---|
| 122 | . S:'ALL ACTION=$$GETFACT^PXRMEXFI(PT01,.ATTR,.NEWPT01,.PXRMNMCH,EXIEN)
|
---|
| 123 | ;Save what was done for the installation summary.
|
---|
| 124 | S ^TMP("PXRMEXIAD",$J,IND,ATTR("FILE NAME"),ATTR("PT01"),ACTION)=NEWPT01
|
---|
| 125 | ;Clear heading
|
---|
| 126 | S VALMHDR(2)=""
|
---|
| 127 | ;If the ACTION is Quit then quit the entire install.
|
---|
| 128 | I ACTION="Q" S PXRMDONE=1 S VALMHDR(2)="Install not completed" Q
|
---|
| 129 | ;If the ACTION is Skip then skip this component.
|
---|
| 130 | I ACTION="S" S VALMBCK="R" Q
|
---|
| 131 | ;If the ACTION is Replace then skip this component.
|
---|
| 132 | I ACTION="P" S VALMBCK="R",VALMHDR(2)=PT01_" replaced with "_NEWPT01 Q
|
---|
| 133 | ;Install this component.
|
---|
| 134 | D FILE^PXRMEXIC(PXRMRIEN,EXIEN,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
|
---|
| 135 | S VALMBCK="R"
|
---|
| 136 | I PXRMDONE S VALMHDR(2)="Install aborted" Q
|
---|
| 137 | I NEWPT01="" S VALMHDR(2)=PT01_" ("_DTYP_") installed from exchange file."
|
---|
| 138 | I NEWPT01'="" S VALMHDR(2)=PT01_" installed as "_NEWPT01_"."
|
---|
| 139 | ;If reminder dialog - disable and give option to link
|
---|
| 140 | I DTYP="reminder dialog" D
|
---|
| 141 | .N DNAME
|
---|
| 142 | .S DNAME=PT01
|
---|
| 143 | .I NEWPT01'="" S DNAME=NEWPT01
|
---|
| 144 | .D INSLNK(DNAME)
|
---|
| 145 | Q
|
---|
| 146 | ;
|
---|
| 147 | ;Check for descendents (either elements or prompts)
|
---|
| 148 | ;--------------------------------------------------
|
---|
| 149 | INSDSC(NAME) ;
|
---|
| 150 | N DATA,DFOUND,SUB
|
---|
| 151 | S DFOUND=0,SUB=0
|
---|
| 152 | F S SUB=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:'SUB D Q:DFOUND
|
---|
| 153 | .S DATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:DATA=""
|
---|
| 154 | .S DFOUND=1
|
---|
| 155 | .;I '$$PXRM($P(DATA,U)) S DFOUND=1
|
---|
| 156 | Q DFOUND
|
---|
| 157 | ;
|
---|
| 158 | INSREPL1(NAME) ;
|
---|
| 159 | N DATA,DFOUND,SUB
|
---|
| 160 | S DFOUND=0,SUB=0
|
---|
| 161 | F S SUB=$O(^TMP("PXRMEXTMP",$J,"DREPL",NAME,SUB)) Q:'SUB D Q:DFOUND
|
---|
| 162 | .S DATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",NAME,SUB)) Q:DATA=""
|
---|
| 163 | .S DFOUND=1
|
---|
| 164 | Q DFOUND
|
---|
| 165 | ;Option to link dialog to a reminder
|
---|
| 166 | ;-----------------------------------
|
---|
| 167 | INSLNK(DNAME) ;
|
---|
| 168 | N DIEN,DISABLE,DSRC,RNAME
|
---|
| 169 | N DA,DIE,DR
|
---|
| 170 | ;Disable
|
---|
| 171 | S DIEN=$O(^PXRMD(801.41,"B",DNAME,"")) Q:'DIEN
|
---|
| 172 | ;Set dialog as disabled
|
---|
| 173 | S DISABLE="DISABLED IN EXCHANGE"
|
---|
| 174 | ;Except for National dialogs
|
---|
| 175 | I $P(^PXRMD(801.41,DIEN,100),U)="N" S DISABLE=""
|
---|
| 176 | ;
|
---|
| 177 | S DR="3///^S X=DISABLE",DIE="^PXRMD(801.41,",DA=$P(DIEN,U)
|
---|
| 178 | D ^DIE
|
---|
| 179 | ;
|
---|
| 180 | ;Quit if already linked
|
---|
| 181 | I $D(^PXD(811.9,"AG",DIEN)) Q
|
---|
| 182 | ;
|
---|
| 183 | S RNAME=""
|
---|
| 184 | ;If reminder was renamed use as default
|
---|
| 185 | I $D(PXRMNMCH(811.9)) D
|
---|
| 186 | .S RNAME=$O(PXRMNMCH(811.9,"")) Q:RNAME=""
|
---|
| 187 | .S RNAME=$G(PXRMNMCH(811.9,RNAME))
|
---|
| 188 | ;Otherwise use original reminder name as default
|
---|
| 189 | I RNAME="" D
|
---|
| 190 | .N DATA,FOUND,RIEN,SUB
|
---|
| 191 | .;Rebuild ^TMP("PXRMEXLC",$J
|
---|
| 192 | .D CDISP^PXRMEXLC(PXRMRIEN)
|
---|
| 193 | .;
|
---|
| 194 | .S SUB="",FOUND=0
|
---|
| 195 | .F S SUB=$O(^TMP("PXRMEXLC",$J,"SEL",SUB),-1) Q:'SUB Q:FOUND D
|
---|
| 196 | ..S DATA=$G(^TMP("PXRMEXLC",$J,"SEL",SUB)) Q:$P(DATA,U)'=811.9
|
---|
| 197 | ..S RIEN=$P(DATA,U,4),FOUND=1 Q:'RIEN
|
---|
| 198 | ..S RNAME=$P($G(^PXD(811.9,RIEN,0)),U)
|
---|
| 199 | ;
|
---|
| 200 | TAG W !!,"Reminder Dialog "_DNAME_" is not linked to a reminder.",!
|
---|
| 201 | ;Select reminder to link
|
---|
| 202 | S IEN=$$SELECT^PXRMINQ("^PXD(811.9,","Select Reminder to Link: ",RNAME)
|
---|
| 203 | ;Update reminder link in #811.9
|
---|
| 204 | I $P(IEN,U)'=-1 D
|
---|
| 205 | .N DA,DIE,DIK,DR
|
---|
| 206 | .;Set reminder to dialog pointer
|
---|
| 207 | .S DR="51///^S X=DNAME",DIE="^PXD(811.9,",DA=$P(IEN,U)
|
---|
| 208 | .D ^DIE
|
---|
| 209 | .;If source reminder is null replace with linked reminder
|
---|
| 210 | .S DSRC=$P($G(^PXRMD(801.41,DIEN,0)),U,2) Q:DSRC
|
---|
| 211 | .S DSRC=$P(IEN,U)
|
---|
| 212 | .S DR="2///^S X=DSRC",DIE="^PXRMD(801.41,",DA=$P(DIEN,U)
|
---|
| 213 | .D ^DIE
|
---|
| 214 | Q
|
---|
| 215 | ;
|
---|
| 216 | ;Install Selected Components
|
---|
| 217 | ;---------------------------
|
---|
| 218 | INSSEL N ALL,IND,PXRMDONE,VALMY
|
---|
| 219 | N DIROUT,DIRUT,DTOUT,DUOUT
|
---|
| 220 | N VALMBG,VALMLST
|
---|
| 221 | S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXLD",$J,"IDX",""),-1)
|
---|
| 222 | ;Get the list to install.
|
---|
| 223 | D EN^VALM2(XQORNOD(0))
|
---|
| 224 | ;
|
---|
| 225 | ;Set the install date and time.
|
---|
| 226 | S ALL="",PXRMDONE=0
|
---|
| 227 | ;
|
---|
| 228 | ;Lock the entire file
|
---|
| 229 | Q:'$$LOCK
|
---|
| 230 | ;
|
---|
| 231 | S IND=0
|
---|
| 232 | F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D INSCOM(IND,0)
|
---|
| 233 | ;
|
---|
| 234 | ;Clear locks
|
---|
| 235 | D UNLOCK
|
---|
| 236 | ;
|
---|
| 237 | ;Rebuild workfile
|
---|
| 238 | D DISP^PXRMEXLD(PXRMMODE)
|
---|
| 239 | Q
|
---|
| 240 | ;
|
---|
| 241 | ;Install the exchange entry PXRMRIEN
|
---|
| 242 | ;-----------------------------------
|
---|
| 243 | INSTALL N IEN,IND,VALMY
|
---|
| 244 | ;Make sure the component list exists for this entry. PXRMRIEN is
|
---|
| 245 | ;set in INSTALL^PXRMEXLR.
|
---|
| 246 | I '$D(^PXD(811.8,PXRMRIEN,120)) D CLIST^PXRMEXU1(.PXRMRIEN)
|
---|
| 247 | I PXRMRIEN=-1 Q
|
---|
| 248 | ;Format the component list for display.
|
---|
| 249 | D CDISP^PXRMEXLC(PXRMRIEN)
|
---|
| 250 | S VALMBCK="R",VALMCNT=$O(^TMP("PXRMEXLD",$J,"IDX"),-1)
|
---|
| 251 | Q
|
---|
| 252 | ;
|
---|
| 253 | PXRM(NAME) ;Validate prompts
|
---|
| 254 | ;
|
---|
| 255 | ;Ignore non-PXRM
|
---|
| 256 | I $E(NAME,1,4)'="PXRM" Q 0
|
---|
| 257 | N DIEN,RESULT
|
---|
| 258 | I $G(PXRMINST)=1 D Q RESULT
|
---|
| 259 | .S RESULT=0
|
---|
| 260 | .S DIEN=$O(^PXRMD(801.41,"B",NAME,"")) I 'DIEN Q
|
---|
| 261 | .I $P($G(^PXRMD(801.41,DIEN,100)),U)'="N" Q
|
---|
| 262 | .I ($P($G(^PXRMD(801.41,DIEN,0)),U,4)="P")!($P($G(^PXRMD(801.41,DIEN,0)),U,4)="F") S RESULT=1
|
---|
| 263 | ;
|
---|
| 264 | ;Check if this is a national code
|
---|
| 265 | S DIEN=$O(^PXRMD(801.41,"B",NAME,""))
|
---|
| 266 | ;If not found abort
|
---|
| 267 | I 'DIEN Q 0
|
---|
| 268 | ;if result group/element quit
|
---|
| 269 | I $P($G(^PXRMD(801.41,DIEN,0)),U,4)="S"!($P($G(^PXRMD(801.41,DIEN,0)),U,4)="T") Q 0
|
---|
| 270 | ;Check class
|
---|
| 271 | I $P($G(^PXRMD(801.41,DIEN,100)),U)="N" Q 1
|
---|
| 272 | ;Otherwise local
|
---|
| 273 | Q 0
|
---|
| 274 | ;
|
---|
| 275 | ;Lock the dialog file
|
---|
| 276 | LOCK() ;
|
---|
| 277 | L +^PXRMD(801.41):0 I Q 1
|
---|
| 278 | E W !,"Another user is editing this file, try later" H 2
|
---|
| 279 | Q 0
|
---|
| 280 | ;
|
---|
| 281 | ;Clear lock
|
---|
| 282 | UNLOCK L -^PXRMD(801.41)
|
---|
| 283 | Q
|
---|