PXRMPARS ; SLC/PJH - Edit PXRM(800 reminder parameters. ;01/28/2013
;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
;
;called by protocol PXRM EDIT SITE DISCLAIMER
;
DISC(DA) ;Edit default disclaimer
Q:'$$LOCK(DA)
N DIC,DIE,DR,Y
;Edit
S DIC="^PXRM(800,",DIE=800,DR=2
D ^DIE
D FORMAT^PXRMDISC
Q
;
MH(DA) ;Edit MH default Question Value
Q:'$$LOCK(DA)
N DIC,DIE,DR,Y
;Edit
S DIE="^PXRM(800,",DR=17
D ^DIE
Q
;
;called by protocol PXRM EDIT WEB SITE
;
WEB(DA) ;Edit default web site
Q:'$$LOCK(DA)
;Edit
N DTOUT,DUOUT
F D Q:$D(DUOUT)!$D(DTOUT)
.D WLIST,WSET,WURL(DA)
Q
;
WLIST ;Display web sites
N FIRST,SUB,SUB1
S FIRST=1,SUB=""
F S SUB=$O(^PXRM(800,DA,1,"B",SUB)) Q:SUB="" D
.S SUB1=0
.F S SUB1=$O(^PXRM(800,DA,1,"B",SUB,SUB1)) Q:'SUB1 D
..I FIRST S FIRST=0 W !!,"Choose from:",!
..W ?8,$P($G(^PXRM(800,DA,1,SUB1,0)),U),!
I FIRST W !!,"No default web sites defined",!
Q
;
WSET ;Set node if not defined
S:'$D(^PXRM(800,DA,1,0)) ^PXRM(800,DA,1,0)="^800.04"
Q
;
WURL(IEN) ;Edit individual URL
N DA,DIC,DIE,DR,Y
S DA(1)=IEN
S DIC="^PXRM(800,"_IEN_",1,"
S DIC(0)="QEAL"
S DIC("A")="Select URL: "
S DIC("P")="800.04"
D ^DIC I Y=-1 S DTOUT=1 Q
S DIE=DIC K DIC
S DA=+Y
;Finding record fields
S DR=".01;.02;1"
;Edit finding record
D ^DIE
I $D(Y) S DTOUT=1 Q
;Check if deleted
I '$D(DA) Q
Q
;
LOCK(DA) ;Lock the record
L +^PXRM(800,DA):DILOCKTM I Q 1
E W !!,?5,"Another user is editing this file, try later" H 2 Q 0
;
UNLOCK(DA) ;Unlock the record
L -^PXRM(800,DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPARS 1609 printed Oct 16, 2024@17:49:13 Page 2
PXRMPARS ; SLC/PJH - Edit PXRM(800 reminder parameters. ;01/28/2013
+1 ;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
+2 ;
+3 ;called by protocol PXRM EDIT SITE DISCLAIMER
+4 ;
DISC(DA) ;Edit default disclaimer
+1 if '$$LOCK(DA)
QUIT
+2 NEW DIC,DIE,DR,Y
+3 ;Edit
+4 SET DIC="^PXRM(800,"
SET DIE=800
SET DR=2
+5 DO ^DIE
+6 DO FORMAT^PXRMDISC
+7 QUIT
+8 ;
MH(DA) ;Edit MH default Question Value
+1 if '$$LOCK(DA)
QUIT
+2 NEW DIC,DIE,DR,Y
+3 ;Edit
+4 SET DIE="^PXRM(800,"
SET DR=17
+5 DO ^DIE
+6 QUIT
+7 ;
+8 ;called by protocol PXRM EDIT WEB SITE
+9 ;
WEB(DA) ;Edit default web site
+1 if '$$LOCK(DA)
QUIT
+2 ;Edit
+3 NEW DTOUT,DUOUT
+4 FOR
Begin DoDot:1
+5 DO WLIST
DO WSET
DO WURL(DA)
End DoDot:1
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+6 QUIT
+7 ;
WLIST ;Display web sites
+1 NEW FIRST,SUB,SUB1
+2 SET FIRST=1
SET SUB=""
+3 FOR
SET SUB=$ORDER(^PXRM(800,DA,1,"B",SUB))
if SUB=""
QUIT
Begin DoDot:1
+4 SET SUB1=0
+5 FOR
SET SUB1=$ORDER(^PXRM(800,DA,1,"B",SUB,SUB1))
if 'SUB1
QUIT
Begin DoDot:2
+6 IF FIRST
SET FIRST=0
WRITE !!,"Choose from:",!
+7 WRITE ?8,$PIECE($GET(^PXRM(800,DA,1,SUB1,0)),U),!
End DoDot:2
End DoDot:1
+8 IF FIRST
WRITE !!,"No default web sites defined",!
+9 QUIT
+10 ;
WSET ;Set node if not defined
+1 if '$DATA(^PXRM(800,DA,1,0))
SET ^PXRM(800,DA,1,0)="^800.04"
+2 QUIT
+3 ;
WURL(IEN) ;Edit individual URL
+1 NEW DA,DIC,DIE,DR,Y
+2 SET DA(1)=IEN
+3 SET DIC="^PXRM(800,"_IEN_",1,"
+4 SET DIC(0)="QEAL"
+5 SET DIC("A")="Select URL: "
+6 SET DIC("P")="800.04"
+7 DO ^DIC
IF Y=-1
SET DTOUT=1
QUIT
+8 SET DIE=DIC
KILL DIC
+9 SET DA=+Y
+10 ;Finding record fields
+11 SET DR=".01;.02;1"
+12 ;Edit finding record
+13 DO ^DIE
+14 IF $DATA(Y)
SET DTOUT=1
QUIT
+15 ;Check if deleted
+16 IF '$DATA(DA)
QUIT
+17 QUIT
+18 ;
LOCK(DA) ;Lock the record
+1 LOCK +^PXRM(800,DA):DILOCKTM
IF $TEST
QUIT 1
+2 IF '$TEST
WRITE !!,?5,"Another user is editing this file, try later"
HANG 2
QUIT 0
+3 ;
UNLOCK(DA) ;Unlock the record
+1 LOCK -^PXRM(800,DA)
+2 QUIT
