224 lines
9.2 KiB
Mathematica
224 lines
9.2 KiB
Mathematica
OREV3 ;SLC/DAN Event delayed orders set up continued ;12/23/02 13:28
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165**;Dec 17, 1997
|
|
;DBIA reference section
|
|
;10116 - VALM1
|
|
;2324 - USRLM
|
|
;10009 - DICN
|
|
;2056 - DIQ
|
|
;2336 - XPAREDIT
|
|
;2263 - XPAR
|
|
;10006 - DIC
|
|
;10026 - DIR
|
|
;10018 - DIE
|
|
;10103 - XLFDT
|
|
;
|
|
ACE ;Add child events to existing events
|
|
N DIC,ORJ,ORTMP,DA,Y,ORGLOB,ADD
|
|
D FULL^VALM1 ;get full screen
|
|
S VALMBCK="R"
|
|
S (DIC,ORGLOB)="^ORD(100.5,"
|
|
I $G(ORNMBR)="" S ORNMBR=$$ORDERS^OREV1("add child events to") Q:ORNMBR="^" ;If action selected before items, get items
|
|
I $G(ORNMBR)="" D Q
|
|
.S DIC(0)="AEMQ",DIC("S")="I '+$P($G(^(0)),U,12)" ;Screen children from being parents
|
|
.D ^DIC Q:Y=-1 S DA=+Y
|
|
.Q:'$$PARENTOK^OREV4
|
|
.L +@(ORGLOB_DA_")"):1 I '$T W !!,"This entry is being edited by another user." H 3 Q
|
|
.W !!,"Adding children to parent ",$P(^ORD(100.5,DA,0),U)
|
|
.D ADDCHLD(DA,.ADD) ;Add child to selected event
|
|
.I $G(ADD) D AUDIT^OREV(DA,"E"),CHKPRM^OREV4 ;If child event added update audit history and check parameters
|
|
.L -@(ORGLOB_DA_")")
|
|
F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ),DA=$O(^TMP("OREDO",$J,"IDX",ORTMP,0)) D
|
|
.I $P($G(^ORD(100.5,DA,0)),U,12) W !!,"You may not add child events to events that are already children.",!,$P($G(^ORD(100.5,DA,0)),U)," - SKIPPED!",! H 3 Q
|
|
.Q:'$$PARENTOK^OREV4
|
|
.L +@(ORGLOB_DA_")"):1 I '$T W !!,"This entry is being edited by another user." H 3 Q ;Lock global
|
|
.W !!,"Adding children to parent ",$P(^ORD(100.5,DA,0),U)
|
|
.D ADDCHLD(DA,.ADD) ;Add child to selected event
|
|
.I $G(ADD) D AUDIT^OREV(DA,"E"),CHKPRM^OREV4 ;If child event added update audit history and check paramters
|
|
.L -@(ORGLOB_DA_")") ;Unlock global
|
|
Q
|
|
;
|
|
ADDCHLD(ENTRY,ADD) ;Add child(ren) to event
|
|
;ENTRY - Internal entry number of event that will be the parent
|
|
;ADD - Will be set to 1 if a child is successfully added
|
|
;
|
|
N DIR,Y,DIC,DIE,DA,DR,DIRUT,X,NEW
|
|
F D Q:$G(DIRUT)
|
|
.W !
|
|
.S DIR(0)="FAO^3:50"
|
|
.S DIR("A")="OE/RR CHILD RELEASE EVENT NAME: "
|
|
.S DIR("?")="Enter the name of the child event you wish to create. It must be free text between 3 and 50 characters and be unique."
|
|
.D ^DIR
|
|
.Q:$G(DIRUT)
|
|
.I $D(^ORD(100.5,"B",Y)) W !,"There is already an entry with this name. Please select a different name." Q
|
|
.S DIC="^ORD(100.5,",DIC(0)="",X=Y D FILE^DICN ;Add child to file
|
|
.Q:Y=-1
|
|
.S DIE=DIC
|
|
.S DR="[OREV CHILD EVENT"
|
|
.S DA=+Y
|
|
.S NEW=1
|
|
.D ^DIE
|
|
.Q:'$G(DA) ;Child event deleted, stop processing
|
|
.D AUDIT^OREV(DA,"N") ;Update audit history for child
|
|
.S DR="1///"_$$NOW^XLFDT_";14///`"_ENTRY D ^DIE ;Add parent pointer to child entry
|
|
.S ADD=1 ;Indicate that child was added
|
|
.W !!,"Enter next child name or press enter to stop adding children."
|
|
Q
|
|
;
|
|
UPDTCHLD(PARENT,CDT) ;Update children to inactive when parent is inactivated
|
|
N DA,DIE,CHILD,DR,DONE
|
|
S DONE=0
|
|
S CHILD="" F S CHILD=$O(^ORD(100.5,"DAD",PARENT,CHILD)) Q:'+CHILD D
|
|
.I 'DONE W !!,"Updating children..." S DONE=1
|
|
.Q:$G(^ORD(100.5,CHILD,1)) ;Child is already inactive
|
|
.S DA=CHILD
|
|
.S DIE="^ORD(100.5,"
|
|
.S DR="1///"_CDT
|
|
.D ^DIE ;Sets inactivated date/time for child
|
|
.;
|
|
.S DA(1)=DA
|
|
.S DA=$O(^ORD(100.5,DA(1),2,"ACT",0))
|
|
.S DIE="^ORD(100.5,DA(1),2,"
|
|
.S DR="1///"_CDT
|
|
.D ^DIE ;Update inactivated date/time of activation multiple for child
|
|
Q
|
|
;
|
|
PARAM ;Allow user to edit event delayed order parameters
|
|
N DIR,Y
|
|
S VALMBCK="R" D FULL^VALM1
|
|
F D Q:'Y
|
|
.S DIR(0)="SO^1:Write orders list by event;2:Default release event;3:Common release event list;4:Manual release controlled by;5:Set manual release parameter;6:Exclude display groups from copy"
|
|
.S DIR("A")="Select parameter to edit"
|
|
.D ^DIR Q:'Y
|
|
.I Y=2!(Y=3) D:Y=2 SETDFLT() D:Y=3 EVENTLST Q
|
|
.D EDITPAR^XPAREDIT($S(Y=1:"ORWDX WRITE ORDERS EVENT LIST",Y=4:"OREVNT MANUAL RELEASE CONTROL",Y=5:"OREVNT MANUAL RELEASE",1:"OREVNT EXCLUDE DGRP"))
|
|
Q
|
|
;
|
|
CANREL() ;Function to determine if delayed order can be manually released
|
|
N ORMAN,CAN
|
|
S ORMAN=$$GET^XPAR("ALL","OREVNT MANUAL RELEASE CONTROL")
|
|
S:ORMAN="" ORMAN="K" ;If no value found, default to checking for keys
|
|
I ORMAN="K",'$$KEY Q 0
|
|
I ORMAN="P",'$$MANPARAM Q 0
|
|
I ORMAN="B" D Q:$G(CAN)=0 0
|
|
.I $$KEY,$$MANPARAM=0 S CAN=0 Q
|
|
.I '$$KEY,'$$MANPARAM S CAN=0
|
|
Q 1
|
|
;
|
|
KEY() ;Check for ORES or ORELSE keys
|
|
I '$D(^XUSEC("ORES",DUZ))&('$D(^XUSEC("ORELSE",DUZ))) Q 0
|
|
Q 1
|
|
;
|
|
MANPARAM() ;Check setting of OREVNT MANUAL RELEASE parameter
|
|
N LST,I,FND,PRM,X,Y,DIC,EXP,STR,VAL,FNDNO
|
|
S DIC=8989.51,DIC(0)="MX",X="OREVNT MANUAL RELEASE" D ^DIC
|
|
I Y=-1 Q 0 ;Parameter not found so quit
|
|
S PRM=+Y
|
|
;Check USER level
|
|
S VAL=$$GET^XPAR("USR",PRM) I VAL'="" Q VAL
|
|
;Check USER CLASS
|
|
D WHATIS^USRLM(DUZ,"LST")
|
|
I $O(LST(0))'="" D I FND'="" Q FND
|
|
.S FND=""
|
|
.S I=0 F S I=$O(LST(I)) Q:I=""!(FND) S EXP=+$P(LST(I),U,5),STR=+$P(LST(I),U,4) I 'EXP!(EXP'<DT) I 'STR!(STR'>DT) S FND=$G(^XTV(8989.5,"AC",PRM,$P(LST(I),U)_";USR(8930,",1)) I FND=0 S FNDNO=1
|
|
.I 'FND,$G(FNDNO) S FND=0
|
|
;Check OE/RR Teams
|
|
K LST,FNDNO
|
|
D TEAMPR^ORQPTQ1(.LST,DUZ)
|
|
I +$G(LST(1)) D I FND'="" Q FND
|
|
.S FND=""
|
|
.S I=0 F S I=$O(LST(I)) Q:I=""!(FND) S FND=$G(^XTV(8989.5,"AC",PRM,$P(LST(I),U)_";OR(100.21,",1)) S:FND=0 FNDNO=1
|
|
.I 'FND,$G(FNDNO) S FND=0
|
|
;Check location
|
|
I +$G(LOC) S VAL=$$GET^XPAR("LOC.`"_+$G(LOC),PRM) I VAL'="" Q VAL
|
|
;Check Service
|
|
S VAL=$G(^XTV(8989.5,"AC",PRM,+$$GET1^DIQ(200,DUZ,29,"I")_";DIC(49,",1)) I VAL'="" Q VAL
|
|
;Check Division and System
|
|
S VAL=$$GET^XPAR("DIV^SYS",PRM) I VAL'="" Q VAL
|
|
Q ""
|
|
;
|
|
DEFHELP ;Provide detailed help for setting default treating specialty
|
|
N DEF,DEFTS,DEFTSNM
|
|
I $D(^ORD(100.5,DA(1),"TS","DEF")) D Q
|
|
.S DEF=$O(^ORD(100.5,DA(1),"TS","DEF",1,0))
|
|
.I DEF=DA Q ;Default is current entry
|
|
.S DEFTS=$P(^ORD(100.5,DA(1),"TS",DEF,0),U)
|
|
.S DEFTSNM=$$GET1^DIQ(45.7,DEFTS_",",.01)
|
|
.W !?5,"You may not set this treating specialty as the default because"
|
|
.W !?5,DEFTSNM," is already set as the default."
|
|
.W !?5,"If you would like to change the default you must first delete the",!?5,"default designation from the above mentioned treating specialty.",!
|
|
;
|
|
W !?5,"Currently there is no default treating specialty set for this event.",!
|
|
Q
|
|
;
|
|
EVENTLST ;Allow user to edit OREVNT COMMON LIST parameter and set a default for that list
|
|
N DIC,X,Y,PRM,ORENT
|
|
S DIC=8989.51,DIC(0)="MX",X="OREVNT COMMON LIST" D ^DIC
|
|
Q:Y=-1 ;Parameter doesn't exist
|
|
S PRM=Y
|
|
D GETENT^XPAREDIT(.ORENT,PRM)
|
|
Q:ORENT="" ;Nothing selected
|
|
D EDIT^XPAREDIT(ORENT,PRM) ;edit selected entity
|
|
Q:$G(DUOUT)!($G(DTOUT)) ;User ^ or timed out
|
|
I '$D(^XTV(8989.5,"AC",+PRM,ORENT)) Q ;No value stored for entity don't ask for default
|
|
D SETDFLT(ORENT,PRM)
|
|
Q
|
|
;
|
|
SETDFLT(ORENT,PRM) ;Set default for given list
|
|
N DIC,Y,X,PRMD,DEF,I,J,DIR,FND,ORLST
|
|
I $G(PRM)="" S DIC=8989.51,DIC(0)="MX",X="OREVNT COMMON LIST" D ^DIC Q:Y=-1 S PRM=Y
|
|
S DIC=8989.51,DIC(0)="MX",X="OREVNT DEFAULT" D ^DIC
|
|
Q:Y=-1 ;Parameter doesn't exist
|
|
S PRMD=Y
|
|
I $G(ORENT)="" D GETENT^XPAREDIT(.ORENT,PRMD) Q:ORENT="" ;Nothing selected
|
|
D GETLST^XPAR(.ORLST,ORENT,+PRM)
|
|
I ORLST=0 W !!,"No common list is defined for this entity and therefore a default",!,"may not be set. Create a common list first.",! Q
|
|
S DEF=$$GET^XPAR(ORENT,+PRMD,,"B") F I=1:1:ORLST I $P(ORLST(I),U,2)=+DEF S FND=1
|
|
I '$G(FND) S DEF="" D EN^XPAR(ORENT,+PRMD,,"@") ;Delete default if no longer in list
|
|
W !!,$S(DEF'="":"Current DEFAULT is "_$P(DEF,U,2)_$S($G(^ORD(100.5,+DEF,1)):" (*INACTIVE*)",1:""),1:"No DEFAULT has been set yet.")
|
|
W ! F J=1:1:ORLST W !,J,") ",$P(^ORD(100.5,$P(ORLST(J),U,2),0),U),$S($G(^(1)):" (*INACTIVE*)",1:"")
|
|
I DEF'="" S ORLST=ORLST+1 W !!,ORLST,") DELETE CURRENT DEFAULT"
|
|
W ! S DIR(0)="NO^1:"_ORLST,DIR("A")="Select default release event"_$S(DEF'="":" or delete current event",1:"") D ^DIR
|
|
I 'Y Q ;No selection made
|
|
I Y=ORLST&(DEF'="") D EN^XPAR(ORENT,+PRMD,,"@") W !,"Default deleted" Q
|
|
I $G(^ORD(100.5,$P(ORLST(Y),U,2),1)) W !,"You cannot set an inactive event as the default." Q ;No inactive defaults can be set
|
|
;write updated parameter
|
|
D EN^XPAR(ORENT,+PRMD,,"`"_$P(ORLST(Y),"^",2))
|
|
Q
|
|
;
|
|
GETLST(LST) ;Return common list and default event
|
|
N I,FND,PRM,X,Y,DIC,TLST,ORCLST,ENT,EXP,STR
|
|
S DIC=8989.51,DIC(0)="MX",X="OREVNT COMMON LIST" D ^DIC
|
|
I Y=-1 Q ;Parameter not found so quit
|
|
S PRM=+Y
|
|
D ENVAL^XPAR(.ORCLST,PRM) Q:ORCLST=0 ;Nothing defined at any level
|
|
;Check USER level
|
|
S ENT=DUZ_";VA(200," I $D(ORCLST(ENT)) D RETLST Q
|
|
;Check USER CLASS
|
|
D WHATIS^USRLM(DUZ,"TLST")
|
|
I $O(TLST(0))'="" D I FND Q
|
|
.S FND=0
|
|
.S I=0 F S I=$O(TLST(I)) Q:I=""!(FND) S ENT=$P(TLST(I),U)_";USR(8930," S EXP=+$P(TLST(I),U,5),STR=+$P(TLST(I),U,4) I 'EXP!(EXP'<DT) I 'STR!(STR'>DT) I $D(ORCLST(ENT)) D RETLST S FND=1
|
|
;Check OE/RR Teams
|
|
K TLST
|
|
D TEAMPR^ORQPTQ1(.TLST,DUZ)
|
|
I +$G(TLST(1)) D I FND Q
|
|
.S FND=0
|
|
.S I=0 F S I=$O(TLST(I)) Q:I=""!(FND) S ENT=$P(TLST(I),U)_"OR(100.21," I $D(ORCLST(ENT)) D RETLST S FND=1
|
|
;Check location
|
|
I +$G(LOC) S ENT=+LOC_";SC(" I $D(ORCLST(ENT)) D RETLST Q
|
|
;Check Service
|
|
S ENT=$$GET1^DIQ(200,DUZ,29,"I")_";DIC(49,"
|
|
I $D(ORCLST(ENT)) D RETLST Q
|
|
;Check Division
|
|
S ENT=DUZ(2)_";DIC(4," I $D(ORCLST(ENT)) D RETLST Q
|
|
Q
|
|
;
|
|
RETLST ;Sets up list for entity
|
|
N DEF,Y,DIC,I,CNT,X
|
|
S DIC=8989.51,DIC(0)="MQ",X="OREVNT DEFAULT" D ^DIC
|
|
Q:'Y ;Stop if parameter doesn't exist
|
|
S CNT=1
|
|
S DEF=$$GET^XPAR(ENT,+Y,,"B")
|
|
S I=0 F S I=$O(ORCLST(ENT,I)) Q:'+I I '$G(^ORD(100.5,ORCLST(ENT,I),1))&('$D(^ORD(100.5,"DAD",ORCLST(ENT,I)))) S LST(CNT)=ORCLST(ENT,I) S:ORCLST(ENT,I)=+DEF $P(LST(CNT),U,2)=1 S CNT=CNT+1
|
|
Q
|