[623] | 1 | PXRMPARS ; SLC/PJH - Edit PXRM(800 reminder parameters. ;06/14/2005
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
---|
| 3 | ;
|
---|
| 4 | ;called by protocol PXRM EDIT SITE DISCLAIMER
|
---|
| 5 | ;
|
---|
| 6 | DISC(DA) ;Edit default disclaimer
|
---|
| 7 | Q:'$$LOCK(DA)
|
---|
| 8 | N DIC,DIE,DR,Y
|
---|
| 9 | ;Edit
|
---|
| 10 | S DIC="^PXRM(800,",DIE=800,DR=2
|
---|
| 11 | D ^DIE
|
---|
| 12 | D FORMAT^PXRMDISC
|
---|
| 13 | Q
|
---|
| 14 | ;
|
---|
| 15 | ;called by protocol PXRM EDIT WEB SITE
|
---|
| 16 | ;
|
---|
| 17 | WEB(DA) ;Edit default web site
|
---|
| 18 | Q:'$$LOCK(DA)
|
---|
| 19 | ;Edit
|
---|
| 20 | N DTOUT,DUOUT
|
---|
| 21 | F D Q:$D(DUOUT)!$D(DTOUT)
|
---|
| 22 | .D WLIST,WSET,WURL(DA)
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | WLIST ;Display web sites
|
---|
| 26 | N FIRST,SUB,SUB1
|
---|
| 27 | S FIRST=1,SUB=""
|
---|
| 28 | F S SUB=$O(^PXRM(800,DA,1,"B",SUB)) Q:SUB="" D
|
---|
| 29 | .S SUB1=0
|
---|
| 30 | .F S SUB1=$O(^PXRM(800,DA,1,"B",SUB,SUB1)) Q:'SUB1 D
|
---|
| 31 | ..I FIRST S FIRST=0 W !!,"Choose from:",!
|
---|
| 32 | ..W ?8,$P($G(^PXRM(800,DA,1,SUB1,0)),U),!
|
---|
| 33 | I FIRST W !!,"No default web sites defined",!
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|
| 36 | WSET ;Set node if not defined
|
---|
| 37 | S:'$D(^PXRM(800,DA,1,0)) ^PXRM(800,DA,1,0)="^800.04"
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | WURL(IEN) ;Edit individual URL
|
---|
| 41 | N DA,DIC,DIE,DR,Y
|
---|
| 42 | S DA(1)=IEN
|
---|
| 43 | S DIC="^PXRM(800,"_IEN_",1,"
|
---|
| 44 | S DIC(0)="QEAL"
|
---|
| 45 | S DIC("A")="Select URL: "
|
---|
| 46 | S DIC("P")="800.04"
|
---|
| 47 | D ^DIC I Y=-1 S DTOUT=1 Q
|
---|
| 48 | S DIE=DIC K DIC
|
---|
| 49 | S DA=+Y
|
---|
| 50 | ;Finding record fields
|
---|
| 51 | S DR=".01;.02;1"
|
---|
| 52 | ;Edit finding record
|
---|
| 53 | D ^DIE
|
---|
| 54 | I $D(Y) S DTOUT=1 Q
|
---|
| 55 | ;Check if deleted
|
---|
| 56 | I '$D(DA) Q
|
---|
| 57 | Q
|
---|
| 58 | ;
|
---|
| 59 | LOCK(DA) ;Lock the record
|
---|
| 60 | L +^PXRM(800,DA):0 I Q 1
|
---|
| 61 | E W !!,?5,"Another user is editing this file, try later" H 2 Q 0
|
---|
| 62 | ;
|
---|
| 63 | UNLOCK(DA) ;Unlock the record
|
---|
| 64 | L -^PXRM(800,DA)
|
---|
| 65 | Q
|
---|