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

OREV1.m

Go to the documentation of this file.
  1. OREV1 ;SLC/DAN Event delayed orders set up continued ;1/14/03 11:54
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141,165**;Dec 17, 1997
  1. ;DBIA reference section
  1. ;2686 - ^XTV(8989.5 and ^XTV(8989.51
  1. ;519 - ^DIC(45.7
  1. ;2263 - XPAR
  1. ;10039- ^DIC(42
  1. ;10009- DICN
  1. ;10018- DIE
  1. ;10026- DIR
  1. ;10116- VALM1
  1. ;10103- XLFDT
  1. SCR ;Sets DIC("S") for MAS MOVEMENT TYPE field of either file
  1. N FILE
  1. S FILE="^ORD("_$O(DR(1,0))_","
  1. S DIC("S")="S TMP=$P("_FILE_"DA,0),U,2),TTP=$E($P(^DG(405.3,$P(^DG(405.2,Y,0),U,2),0),U)) I $S(TMP=TTP:1,1:0)"_$S('$G(@(FILE_DA_",1)")):"&('$$INUSEDC^OREV1())",1:"")
  1. Q
  1. ;
  1. ACT ;Inactivate or reactivate an event or auto dc rule
  1. N ORJ,Y,ORTMP,DA,DIC,ORGLOB
  1. S VALMBCK="R" D FULL^VALM1
  1. S ORGLOB="^ORD(100."_$S(ORTYPE="E":"5,",1:"6,")
  1. I $G(ORNMBR)="" S ORNMBR=$$ORDERS("activate/inactivate")
  1. F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ),DA=$O(^TMP("OREDO",$J,"IDX",ORTMP,0)) D FLIP(DA)
  1. Q
  1. ;
  1. FLIP(DA) ;Check status and flip if necessary
  1. N STAT,DIR,DIE,DR,Y,NAME,CDT,MULT,IEN,SUB,USED,EVNTYPE
  1. S NAME=$P(@(ORGLOB_DA_",0)"),U),EVNTYPE=$P(^(0),U,2)
  1. S CDT=$$NOW^XLFDT
  1. S STAT=$S($G(@(ORGLOB_DA_",1)")):^(1),1:0) ;Status is date/time if already inactivated
  1. W !!,NAME," is currently ",$S(STAT:"IN",1:"")_"ACTIVE."
  1. I ORTYPE="E",$$RELEVNTS(DA),'STAT W !!,"There are delayed orders awaiting release that are associated with this event.",!,"This event, even if inactivated, will still be applied to these delayed orders.",!!
  1. I ORTYPE="A",'STAT W !!,"Inactivating auto-dc rules takes effect immediately.",!
  1. I STAT,$G(EVNTYPE)="O",$$ACTSURG^OREV4(ORTYPE,DA) D Q
  1. .W !,NAME,!,"can not be activated because you already have an active surgery rule for this",!,"division. Only one active surgery rule per division is allowed.",!
  1. .S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
  1. I STAT,ORTYPE="E",$P($G(^ORD(100.5,DA,0)),U,12),$G(^ORD(100.5,$P(^(0),U,12),1)) D Q ;If inactive child event and parent is inactive don't activate child
  1. .W !,NAME,!,"can not be activated until its parent event is active.",!
  1. .S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
  1. I STAT,ORTYPE="E",'$$CANACT(DA,.USED) D Q
  1. .W !,NAME,!,"can not be activated because the following locations",!,"and/or treating specialties are currently in use by other entries.",!
  1. .F MULT="LOC","TS" W:$D(USED(MULT)) !,$S(MULT="LOC":"LOCATIONS:",1:"TREATING SPECIALTIES:"),! D
  1. ..S IEN=0 F S IEN=$O(USED(MULT,IEN)) Q:'+IEN D
  1. ...S SUB=0 F S SUB=$O(USED(MULT,IEN,SUB)) Q:'+SUB D
  1. ....W !,$S(MULT="LOC":$P($G(^DIC(42,SUB,0)),"^"),1:$P($G(^DIC(45.7,SUB,0)),"^"))," is in use by ",$P($G(@(ORGLOB_IEN_",0)")),"^"),!
  1. .W !,"For active entries, LOCATIONS and TREATING SPECIALTIES",!,"must be unique within division and event type."
  1. .S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
  1. I STAT I ORTYPE="A" I '$$CANACT(DA,.USED) D Q
  1. .W !,NAME,!,"can not be activated because the following MAS movements",!,"are currently in use by other entries.",!
  1. .S IEN=0 F S IEN=$O(USED(IEN)) Q:'+IEN D
  1. ..S SUB=0 F S SUB=$O(USED(IEN,SUB)) Q:'+SUB D
  1. ...W !,$P($G(^DG(405.2,IEN,0)),U)," is in use by ",$P($G(^ORD(100.6,SUB,0)),U)
  1. .W !,"For active entries, MAS movements within DIVISION must be unique."
  1. .S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR K DIR
  1. ;
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to "_$S(STAT:"",1:"IN")_"ACTIVATE this entry" D ^DIR
  1. I Y'=1 W !,"Nothing changed!" Q
  1. S DIE=ORGLOB,DR="1///"_$S(STAT:"@",1:CDT) D ^DIE W !,NAME," is now "_$S(STAT:"",1:"IN")_"ACTIVATED!"
  1. I 'STAT S DA(1)=DA,DA=$O(@(ORGLOB_DA(1)_",2,"_"""ACT"""_",0)")),DIE=ORGLOB_DA(1)_",2,",DR="1///"_CDT D ^DIE D:ORTYPE="E" UPDTCHLD^OREV3(DA(1),CDT) Q
  1. D SET(DA,CDT)
  1. Q
  1. ;
  1. SET(MIEN,X) ;add new multiple to activation history
  1. N DIC,DA
  1. S DA(1)=MIEN
  1. S DIC=ORGLOB_DA(1)_",2,",DIC(0)="L"
  1. D FILE^DICN
  1. Q
  1. ;
  1. INUSE(MULT) ;determine if location or treating specialty is already in use
  1. N ACTIVE,USED,NAME,TYPE,DIV,FMIEN
  1. S USED=0,NAME="",FMIEN=$G(DA(1),DA)
  1. S TYPE=$P($G(^ORD(100.5,FMIEN,0)),"^",2) ;movement type of entry being checked
  1. S DIV=$P($G(^ORD(100.5,FMIEN,0)),"^",3) ;division of entry being checked
  1. F S NAME=$O(^ORD(100.5,"C",NAME)) Q:NAME=""!(USED) D
  1. .S ACTIVE=0 F S ACTIVE=$O(^ORD(100.5,"C",NAME,ACTIVE)) Q:'+ACTIVE!USED D
  1. ..Q:DIV'=$P($G(^ORD(100.5,ACTIVE,0)),"^",3) ;stop processing if not same division
  1. ..Q:TYPE'=$P($G(^ORD(100.5,ACTIVE,0)),"^",2) ;stop processing if not the same type
  1. ..S USED=$D(^ORD(100.5,ACTIVE,MULT,"B",Y)) I USED S WHO=ACTIVE
  1. Q USED
  1. ;
  1. CANACT(DA,USED) ;Function returns whether or not an entry can be activated.
  1. ;For EVENTS, locations and specialties must be unique within division
  1. ;and EVENT TYPE. For AUTO DC, movement types must be unique within
  1. ;division.
  1. N MULT,SUB,Y,CANACT,WHO
  1. S CANACT=1
  1. I ORTYPE="E" F MULT="LOC","TS" D
  1. .S SUB=0 F S SUB=$O(^ORD(100.5,DA,MULT,SUB)) Q:'+SUB D
  1. ..S Y=$G(^(SUB,0)) I Y I $$INUSE(MULT) S CANACT=0,USED(MULT,WHO,Y)=""
  1. ;
  1. I ORTYPE="A" D
  1. .S SUB=0 F S SUB=$O(^ORD(100.6,DA,3,SUB)) Q:'+SUB D
  1. ..S Y=+$G(^(SUB,0)) I Y I $$INUSEDC() S CANACT=0,USED(Y,WHO)=""
  1. Q CANACT
  1. ;
  1. INUSEDC() ;Checks AUTO-DC rules for unique movement types
  1. N DIV,USED
  1. S USED=0
  1. S DIV=+$P($G(^ORD(100.6,DA,0)),U,3)
  1. I DIV I $D(^ORD(100.6,"AC",DIV,Y)) S WHO=$O(^(Y,0)),USED=1
  1. Q USED
  1. ;
  1. HASREQD() ;Function returns whether entry has required entries or not
  1. N REQD
  1. S REQD=0
  1. I ORTYPE="E" D
  1. .I "^22^23^24^"[("^"_$P($G(^ORD(100.5,DA,0)),U,7)_"^") S REQD=1 Q ;From pass (transfer) doesn't require treating specialty
  1. .I $O(^ORD(100.5,DA,"LOC",0))>0!($O(^ORD(100.5,DA,"TS",0))>0) S REQD=1 ;Has locations or treating specialties
  1. .I $O(^ORD(100.5,DA,"LOC",0))>0&($O(^ORD(100.5,DA,"TS",0))>0) S REQD=2 ;Warn user that both must be true if both defined.
  1. I ORTYPE="A" D
  1. .I $P($G(^ORD(100.6,DA,0)),U,2)="O" S REQD=1 ;If type is operating room then movements not required
  1. .I $P($G(^ORD(100.6,DA,0)),U,2)'="O"&($O(^ORD(100.6,DA,3,0))>0) S REQD=1 ;movement type exists
  1. .I $P($G(^ORD(100.6,DA,0)),U,2)="T",$D(^ORD(100.6,DA,3,"B",4)),$P($G(^ORD(100.6,DA,3,0)),U,4)>1 S REQD=2 ;If transfer type and interward transfer type not by itself
  1. Q REQD
  1. ;
  1. CHKTYP(IEN) ;Check type of event and delete fields that are no longer needed based on the event type
  1. N J,DR,DIE,DA,DIC,TYPE
  1. I ORTYPE="E" D Q
  1. .S TYPE=$P(^ORD(100.5,IEN,0),U,2)
  1. .I TYPE'="A"&(TYPE'="T") D DELMUL(100.5,IEN,"""LOC"""),DELMUL(100.5,IEN,"""TS""") ;if not admit or transfer delete locations and treating specialties
  1. .S DA=IEN,DIE=100.5,DR="7///@" D ^DIE ;Delete MAS MOVEMENT when type changes as movement types are associated with event type
  1. ;If not event type must be auto-dc
  1. S TYPE=$P(^ORD(100.6,IEN,0),U,2)
  1. I TYPE'="D" S DA=IEN,DIE=100.6,DR="6///@" D ^DIE ;Delete 'except from observation" if not discharge type
  1. D DELMUL(100.6,IEN,3) ;delete MAS MOVEMENT
  1. I TYPE'="S" D DELMUL(100.6,IEN,4) ;If not specialty type delete excluded treating specialties
  1. I TYPE'="T" D DELMUL(100.6,IEN,5),DELMUL(100.6,IEN,6) ;If not transfer type delete included locations and included divisions
  1. Q
  1. ;
  1. ORDERS(ACTION) ; -- Return order numbers to act on, if action chosen first
  1. N X,Y,DIR,MAX
  1. S MAX=$G(VALMCNT) Q:MAX'>0 ""
  1. I ACTION="edit" W !!,"Enter item number to edit or press enter to create a new entry"
  1. S DIR(0)="LAO^1:"_MAX,DIR("A")="Select item(s): "
  1. S DIR("?")="Enter the items you wish to "_ACTION_", as a range or list of numbers."_$S(ACTION="edit":" Press enter to create a NEW entry",1:"")
  1. D ^DIR S:$D(DTOUT) Y="^"
  1. I $D(Y(1)) W !,">>>Too many entries selected, try using smaller ranges" H 2 S Y="^"
  1. Q Y
  1. ;
  1. ;
  1. CANDEL(FILE) ;Determines if event or rule can be deleted
  1. N DEL,EVENT,LIST,I,J
  1. S DEL=1
  1. S EVENT=$O(^XTV(8989.51,"B","ORWDX WRITE ORDERS EVENT LIST",0))
  1. S LIST=$O(^XTV(8989.51,"B","OREVNT COMMON LIST",0))
  1. I FILE=100.5 D
  1. .I $O(^ORE(100.2,"E",DA,0)) W !,"< Can't delete this event because file 100.2 is pointing to it > " S DEL=0 Q
  1. .I $D(^ORD(100.5,"DAD",DA)) W !,"< Can't delete parent events that have children > " S DEL=0 Q
  1. .S FND=0
  1. .K LST D ENVAL^XPAR(.LST,LIST)
  1. .S I="" F S I=$O(LST(I)) Q:I=""!(FND) D
  1. ..S J="" F S J=$O(LST(I,J)) Q:J=""!(FND) I LST(I,J)=DA S FND=1
  1. .I 'FND K LST D ENVAL^XPAR(.LST,EVENT) D
  1. ..S I="" F S I=$O(LST(I)) Q:I=""!(FND) D
  1. ...S J="" F S J=$O(LST(I,J)) Q:J=""!(FND) I DA=J S FND=1
  1. .I FND W !,"< Can't delete event because parameters are pointing to it > " S DEL=0
  1. ;
  1. I FILE=100.6 D
  1. .I $O(^ORE(100.2,"DC",DA,0)) S DEL=0 W !,"< Can't delete this rule because file 100.2 is pointing to it > " Q
  1. ;
  1. Q 'DEL ;Reverse value of DEL so that $T is set correctly for fileman to determine if entry can be deleted. Code is in ^DD(file#,.01,"DEL",.01,0)
  1. ;
  1. ASKOBS() ;Function to determine if 'except from observation' field should be asked.
  1. N ANS
  1. S ANS=1
  1. I ETYPE="D" I $D(^ORD(100.6,DA,3,"B",12))!($D(^ORD(100.6,DA,3,"B",38))) S ANS=0 ;Don't ask if MAS MOVEMENT TYPE is 12 (death) or 38 (death with autopsy)
  1. I ETYPE="T" I '$D(^ORD(100.6,DA,3,"B",14)) S ANS=0 ;If MAS MOVEMENT TYPE doesn't contain FROM ASIH (VAH) when type is transfer then don't ask
  1. Q ANS
  1. ;
  1. DELMUL(FILE,IEN,LOC) ;Delete multiple entries for entry IEN in file FILE stored at location LOC
  1. N I,DR,DIE,DA,DIC,GLOB,Y,DQ,DP,DL,DM,DI,DK
  1. S GLOB="^ORD("_FILE_","_IEN_","
  1. S I=0 F S I=$O(@(GLOB_LOC_","_I_")")) Q:'+I S DA(1)=IEN,DA=I,DR=".01///@",DIE="^ORD("_FILE_",DA(1),"_LOC_"," D ^DIE
  1. Q
  1. ;
  1. RELEVNTS(DA) ;Check to see if release event is currently being pointed to
  1. N DFN,EVENT
  1. S (DFN,EVENT)=0
  1. F S DFN=$O(^ORE(100.2,"AE",DFN)) Q:'+DFN I $D(^ORE(100.2,"AE",DFN,DA)) S EVENT=1 Q
  1. Q EVENT