94 lines
2.1 KiB
Mathematica
94 lines
2.1 KiB
Mathematica
PXRMLLED ; SLC/PJH - Edit a location list. ;12/23/2005
|
|
;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|
;
|
|
;================================================================
|
|
N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,FILEA,IENA,NUM,Y
|
|
GETNAME ;Get the name of the location list to edit.
|
|
K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
|
|
S DIC="^PXRMD(810.9,"
|
|
S DIC(0)="AEMQL"
|
|
S DIC("A")="Select Location List: "
|
|
S DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
|
|
S DLAYGO=810.9
|
|
;Set the starting place for additions.
|
|
D SETSTART^PXRMCOPY(DIC)
|
|
W !
|
|
D ^DIC
|
|
I ($D(DTOUT))!($D(DUOUT)) Q
|
|
I Y=-1 G END
|
|
S DA=$P(Y,U,1)
|
|
S CS1=$$FILE^PXRMEXCS(810.9,DA)
|
|
D EDIT(DIC,DA)
|
|
;See if any changes have been made, if so do the edit history.
|
|
S CS2=$$FILE^PXRMEXCS(810.9,DA)
|
|
I CS2'=0,CS2'=CS1 D SEHIST^PXRMUTIL(810.9,DIC,DA)
|
|
G GETNAME
|
|
END ;
|
|
Q
|
|
;
|
|
;================================================================
|
|
EDIT(ROOT,DA) ;
|
|
N DIE,DR,DIDEL,X,Y
|
|
S DIE=ROOT,DIDEL=810.9
|
|
NAME S DR=".01"
|
|
D ^DIE
|
|
I '$D(DA) Q
|
|
I $D(Y) Q
|
|
CLASS ;
|
|
;Class
|
|
RETRY W !!
|
|
S DR="100"
|
|
D ^DIE
|
|
I $D(Y) G NAME
|
|
;Sponsor
|
|
S DR="101"
|
|
D ^DIE
|
|
I $D(Y) G RETRY
|
|
;Make sure Class and Sponsor Class are in synch.
|
|
S RESULT=$$VSPONSOR^PXRMINTR(X)
|
|
I RESULT=0 S DIE("NO^")="Other value" G RETRY
|
|
I RESULT=1 K DIE("NO^")
|
|
;Review date
|
|
RD W !!
|
|
S DR="102"
|
|
D ^DIE
|
|
I $D(Y) G RETRY
|
|
;
|
|
;Description
|
|
DES S DR="1"
|
|
D ^DIE
|
|
I $D(Y) G RD
|
|
;
|
|
;Clinic Stops
|
|
CS S DR="40.7"
|
|
S DR(2,810.9001)=".01;1"
|
|
D ^DIE
|
|
I $D(Y) G DES
|
|
;
|
|
;Hospital Locations
|
|
HL S DR="44"
|
|
D ^DIE
|
|
I $D(Y) G CS
|
|
Q
|
|
;
|
|
;================================================================
|
|
KAMIS(X,DA) ;Kill the AMIS Reporting Stop Code.
|
|
;Do not execute as part of a verify fields.
|
|
I $G(DIUTIL)="VERIFY FIELDS" Q
|
|
;Do not execute as part of exchange.
|
|
I $G(PXRMEXCH) Q
|
|
S $P(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=""
|
|
Q
|
|
;
|
|
;================================================================
|
|
SAMIS(X,DA) ;Set the AMIS Reporting Stop Code.
|
|
;Do not execute as part of a verify fields.
|
|
I $G(DIUTIL)="VERIFY FIELDS" Q
|
|
;Do not execute as part of exchange.
|
|
I $G(PXRMEXCH) Q
|
|
N AMIS
|
|
S AMIS=$P(^DIC(40.7,X,0),U,2)
|
|
S $P(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=AMIS
|
|
Q
|
|
;
|