- 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 Feb 18, 2025@23:14:45 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