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

PXRMPARS.m

Go to the documentation of this file.
  1. PXRMPARS ; SLC/PJH - Edit PXRM(800 reminder parameters. ;01/28/2013
  1. ;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
  1. ;
  1. ;called by protocol PXRM EDIT SITE DISCLAIMER
  1. ;
  1. DISC(DA) ;Edit default disclaimer
  1. Q:'$$LOCK(DA)
  1. N DIC,DIE,DR,Y
  1. ;Edit
  1. S DIC="^PXRM(800,",DIE=800,DR=2
  1. D ^DIE
  1. D FORMAT^PXRMDISC
  1. Q
  1. ;
  1. MH(DA) ;Edit MH default Question Value
  1. Q:'$$LOCK(DA)
  1. N DIC,DIE,DR,Y
  1. ;Edit
  1. S DIE="^PXRM(800,",DR=17
  1. D ^DIE
  1. Q
  1. ;
  1. ;called by protocol PXRM EDIT WEB SITE
  1. ;
  1. WEB(DA) ;Edit default web site
  1. Q:'$$LOCK(DA)
  1. ;Edit
  1. N DTOUT,DUOUT
  1. F D Q:$D(DUOUT)!$D(DTOUT)
  1. .D WLIST,WSET,WURL(DA)
  1. Q
  1. ;
  1. WLIST ;Display web sites
  1. N FIRST,SUB,SUB1
  1. S FIRST=1,SUB=""
  1. F S SUB=$O(^PXRM(800,DA,1,"B",SUB)) Q:SUB="" D
  1. .S SUB1=0
  1. .F S SUB1=$O(^PXRM(800,DA,1,"B",SUB,SUB1)) Q:'SUB1 D
  1. ..I FIRST S FIRST=0 W !!,"Choose from:",!
  1. ..W ?8,$P($G(^PXRM(800,DA,1,SUB1,0)),U),!
  1. I FIRST W !!,"No default web sites defined",!
  1. Q
  1. ;
  1. WSET ;Set node if not defined
  1. S:'$D(^PXRM(800,DA,1,0)) ^PXRM(800,DA,1,0)="^800.04"
  1. Q
  1. ;
  1. WURL(IEN) ;Edit individual URL
  1. N DA,DIC,DIE,DR,Y
  1. S DA(1)=IEN
  1. S DIC="^PXRM(800,"_IEN_",1,"
  1. S DIC(0)="QEAL"
  1. S DIC("A")="Select URL: "
  1. S DIC("P")="800.04"
  1. D ^DIC I Y=-1 S DTOUT=1 Q
  1. S DIE=DIC K DIC
  1. S DA=+Y
  1. ;Finding record fields
  1. S DR=".01;.02;1"
  1. ;Edit finding record
  1. D ^DIE
  1. I $D(Y) S DTOUT=1 Q
  1. ;Check if deleted
  1. I '$D(DA) Q
  1. Q
  1. ;
  1. LOCK(DA) ;Lock the record
  1. L +^PXRM(800,DA):DILOCKTM I Q 1
  1. E W !!,?5,"Another user is editing this file, try later" H 2 Q 0
  1. ;
  1. UNLOCK(DA) ;Unlock the record
  1. L -^PXRM(800,DA)
  1. Q