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

OREV4.m

Go to the documentation of this file.
  1. OREV4 ;SLC/DAN Event delayed orders cont ;08/03/15 15:25
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,367,377**;Dec 17, 1997;Build 582
  1. ;DBIA reference section
  1. ;10006 - DIC
  1. ;10018 - DIE
  1. ;10013 - DIK
  1. ;10103 - XLFDT
  1. ;2056 - DIQ
  1. ;2263 - XPAR
  1. ;
  1. N Y,DIC,ZTSAVE,IEN
  1. S DIC="^ORE(100.2,",DIC(0)="AEMQ" D ^DIC
  1. Q:Y=-1 ;Quit if no selection made
  1. S IEN=+Y
  1. W !
  1. S ZTSAVE("IEN")="",ZTSAVE("DIC")="",ZTSAVE("IO*")=""
  1. D QUE^ORUTL1("DQI^OREV4","Patient event inquiry",.ZTSAVE) ;Get device to print on
  1. Q
  1. ;
  1. DQI ;Tasked entry point or continue if not queued
  1. U IO
  1. S DA=IEN
  1. D EN^DIQ
  1. Q
  1. ;
  1. CHKPRM ;Checks to see if event is defined in either the OREVNT DEFAULT
  1. ;or the OREVNT COMMON LIST parameter. If so, then it will be removed
  1. ;from the parameters as PARENT type events are not allowed in these
  1. ;parameters. This API is called when an event becomes a parent.
  1. N DIC,Y,X,PRMC,PRMD,PARAM,I,J
  1. S DIC=8989.51,DIC(0)="MX",X="OREVNT COMMON LIST" D ^DIC
  1. Q:Y=-1 ;Parameter doesn't exist
  1. S PRMC=+Y
  1. S X="OREVNT DEFAULT" D ^DIC
  1. Q:Y=-1 ;Parameter doesn't exist
  1. S PRMD=+Y
  1. F PARAM=PRMC,PRMD D
  1. .K ORLST
  1. .D ENVAL^XPAR(.ORLST,PRMC) ;get list of values
  1. .Q:ORLST=0 ;No values
  1. .S I="" F S I=$O(ORLST(I)) Q:I="" D
  1. ..S J="" F S J=$O(ORLST(I,J)) Q:J="" D
  1. ...I ORLST(I,J)=DA D EN^XPAR(I,PARAM,J,"@") ;delete event from parameter
  1. Q
  1. ;
  1. DELAYED(DFN) ;Display list of delayed events for a patient, identified by DFN
  1. N EVT,IFN,DISP
  1. I '$D(^ORE(100.2,"AE",DFN)) Q ;Quit if no delayed orders exist for the patient
  1. S EVT=0,DISP=0
  1. F S EVT=$O(^ORE(100.2,"AE",DFN,EVT)) Q:'+EVT D
  1. .S IFN=$O(^ORE(100.2,"AE",DFN,EVT,0))
  1. .Q:$$LAPSED^OREVNTX(IFN) ;quit if event has lapsed
  1. .W:'DISP !!,"Delayed orders exist for this patient!",$C(7) S DISP=1
  1. .W !,"EVENT: ",$P($G(^ORD(100.5,+$P(^ORE(100.2,IFN,0),U,2),0)),U,8),", created on ",$$FMTE^XLFDT($P(^ORE(100.2,IFN,0),U,5),1)
  1. Q
  1. ;
  1. PARENTOK() ;This function determines if the event can be a parent
  1. ;if an event has future delayed orders tied to it then it can't be
  1. ;a parent
  1. N OK,SUB,RIEN,PIEN
  1. S OK=1
  1. S SUB="^ORE(100.2,""AE"")"
  1. F S SUB=$Q(@SUB) Q:SUB'["AE"!('OK) D
  1. .S RIEN=$P(SUB,",",4) ;Release event ID
  1. .S PIEN=+$P(SUB,",",5) ;Patient event ID -- p.367 added "+" to prevent PIEN from containing ")"
  1. .Q:$$LAPSED^OREVNTX(PIEN) ;quit if event has lapsed
  1. .I RIEN=DA W !!,"You may not make ",$P($G(^ORD(100.5,DA,0)),U)," a parent",!,"at this time because there are unprocessed delayed orders assigned to it." H 3 S OK=0
  1. Q OK
  1. ;
  1. ACTSURG(ORTYPE,DA) ;Function returns 1 if an active surgery event already exists
  1. N ACT,DIV,I
  1. S ACT=0
  1. I ORTYPE="E" D
  1. .S DIV=$P($G(^ORD(100.5,DA,0)),U,3)
  1. .S I=0 F S I=$O(^ORD(100.5,"ADT","O",I)) Q:'+I I DA'=I I DIV=$P($G(^ORD(100.5,I,0)),U,3)&('$G(^ORD(100.5,I,1))) S ACT=1
  1. .Q
  1. I ORTYPE="A" D
  1. .S DIV=$P($G(^ORD(100.6,DA,0)),U,3)
  1. .S I=0 F S I=$O(^ORD(100.6,"AE",DIV,"O",I)) Q:'+I I I'=DA S ACT=1
  1. .Q
  1. Q ACT
  1. ;
  1. FROMTO(MUL,SUB1,SUB2) ;Check FROM - TO entries in file 100.6
  1. N DA,DIK,LOC0,X,Y,DEL,ERR
  1. I MUL="S" D Q
  1. .I '$D(^ORD(100.6,SUB1,4,SUB2,1,"B")) D ;Check for TO entries in specialties multiple
  1. ..W !!,"ERROR - Missing TO entry - ",$P($G(^DIC(45.7,$P(^ORD(100.6,SUB1,4,SUB2,0),U),0)),U)," DELETED.",!
  1. ..S DA(1)=SUB1,DA=SUB2,DIK="^ORD(100.6,"_DA(1)_",4," D ^DIK
  1. ;
  1. I MUL="L" D
  1. .S LOC0=^ORD(100.6,SUB1,5,SUB2,0)
  1. .I +$P(LOC0,U,2)=0&($P(LOC0,U,3)="") S DEL=1,ERR=1
  1. .I +$P(LOC0,U,4)=0&($P(LOC0,U,5)="") S DEL=1,ERR=1
  1. .I $G(ERR) W !!,"ERROR - Missing FROM or TO location - '",$P(LOC0,U),"' DELETED.",! Q
  1. .I $P(LOC0,U,2) D CLEAR(SUB1,SUB2,2) ;If user selects "all" clear "from" field
  1. .I $P(LOC0,U,4) D CLEAR(SUB1,SUB2,4) ;If user selects "all" clear "to" field
  1. .I $P(LOC0,U,2)&($P(LOC0,U,4)) W !!,"WARNING - You've defined a 'FROM ALL' locations to 'TO ALL' locations entry",!,"and it will supercede all other entries.",! Q
  1. .I $O(^ORD(100.6,SUB1,5,"ADC",$S($P(LOC0,U,2)=1:"ALL",1:$P(LOC0,U,3)),$S($P(LOC0,U,4)=1:"ALL",1:$P(LOC0,U,5)),SUB2)) S DEL=1,ERR=1
  1. .I $O(^ORD(100.6,SUB1,5,"ADC",$S($P(LOC0,U,2)=1:"ALL",1:$P(LOC0,U,3)),$S($P(LOC0,U,4)=1:"ALL",1:$P(LOC0,U,5)),SUB2),-1) S DEL=1,ERR=1
  1. .I $G(ERR) W !!,"ERROR - Duplicate entry exists - '",$P(LOC0,U),"' DELETED.",!
  1. I $G(DEL) S DIK="^ORD(100.6,"_SUB1_",5,",DA=SUB2,DA(1)=SUB1 D ^DIK
  1. Q
  1. ;
  1. CLEAR(TENT,MENT,FIELD) ;Clear selected fields
  1. N DA,DIE,Y,X,FILE
  1. S FILE(100.62,MENT_","_TENT_",",FIELD)="@" D FILE^DIE("","FILE")
  1. Q
  1. ;
  1. EXCOI(IEN) ;
  1. ;
  1. EXCOI1 ;
  1. ;Protect FileMan variables
  1. W !,"EXCEPT ORDERABLE ITEMS"
  1. N D,D0,DA,DC,DDES,DE,DG,DH,DI,DIC,DIDEL,DIE,DIEDA,DIEL,DIEN,DIR,DIETMP
  1. N DIEXREF,DIFLD,DIEIENS,DINUSE,DIP,DISYS,DK,DL,DM,DP,DQ,DR,DU
  1. ;
  1. N ADD,C,ARRAY,EXIT,DISPLAY,EDIT,EXCLUDE,HELP,IND,LIST,NAME,NODE,NUM,OI,OINODE,PROMPT,RESULT,SEQ,SARRAY,TEMP,VAL,X,Y
  1. ;find existing OI, capture ones that cannot be remove
  1. S C=0,EXIT=""
  1. S SEQ=0 F S SEQ=$O(^ORD(100.6,IEN,8,SEQ)) Q:SEQ'>0 D
  1. .S NODE=$G(^ORD(100.6,IEN,8,SEQ,0)),OI=$P(NODE,U) Q:OI'>0
  1. .S OINODE=$G(^ORD(101.43,OI,0))
  1. .S NAME=$P(OINODE,U) Q:NAME="" Q:$P(OINODE,U,5)'>0
  1. .S DISPLAY=$P($G(^ORD(100.98,$P(OINODE,U,5),0)),U) Q:DISPLAY=""
  1. .I +$P(NODE,U,2)'=1 S EDIT(NAME,OI)=SEQ_U_DISPLAY Q
  1. .S EXCLUDE(NAME,OI)=SEQ_U_DISPLAY
  1. ;
  1. I '$D(EXCLUDE),'$D(EDIT) S ADD=$$ADD(IEN) G:ADD=1 EXCOI1 G:ADD=0 EXCOIX
  1. S VAL="" I $D(EDIT) D
  1. .S TEMP="S^A:New Orderablle Item to Exclude Orderable Item List;D:Delete exisitng Exclude Orderable Item;Q:Quit",PROMPT="Delete/Add'"
  1. .S VAL=$$ASK(TEMP,PROMPT,1)
  1. I VAL="Q" G EXCOIX
  1. I VAL="A" D ADD(IEN) G EXCOI1
  1. ;
  1. I $D(EXCLUDE) D
  1. .W !,"Cannot remove the following orderable item(s):"
  1. .S NAME="" F S NAME=$O(EXCLUDE(NAME)) Q:NAME="" D
  1. ..S OI=0 F S OI=$O(EXCLUDE(NAME,OI)) Q:OI'>0 W !," "_NAME_" ("_$P(EXCLUDE(NAME,OI),U,2)_")"
  1. .H 1
  1. ;
  1. I '$D(EDIT) S ADD=$$ADD(IEN) G:ADD=1 EXCOI1 G:ADD=0 EXCOIX
  1. W !!,"Can delete the following orderable item(s):"
  1. W !,"Deletion occurs immediately after selection"
  1. S NAME="" F S NAME=$O(EDIT(NAME)) Q:NAME="" D
  1. .S OI=0 F S OI=$O(EDIT(NAME,OI)) Q:OI'>0 D
  1. ..S NODE=$G(EDIT(NAME,OI)) S SEQ=$P(NODE,U) Q:SEQ'>0
  1. ..S C=C+1,ARRAY(C)=" "_$J(C,4)_" - "_NAME_" ("_$P(EDIT(NAME,OI),U,2)_")",SEQARRAY(C)=SEQ_U_OI_U_NAME_U_$P(EDIT(NAME,OI),U,2)
  1. ;
  1. M DIR("A")=ARRAY
  1. S DIR("A")="Select number to delete from 'Exclude Orderable Item List'"
  1. S DIR(0)="LO^1:"_C
  1. D ^DIR
  1. S NUM=$L(Y,",")-1
  1. I NUM=0 Q
  1. S LIST=Y
  1. F IND=1:1:NUM D
  1. .S SEQ=$P(LIST,",",IND)
  1. .S NODE=SEQARRAY(SEQ)
  1. .D DELETE(IEN,NODE)
  1. I EXIT=U G EXCOI1
  1. ;
  1. EXCOIX ;
  1. Q
  1. ;
  1. ASK(TEMP,PROMPT,HELP) ;
  1. N DIR,Y
  1. S DIR(0)=TEMP
  1. S DIR("A")=PROMPT
  1. S DIR("??")=U_"D HELP^OREV4("_HELP_")"
  1. D ^DIR
  1. Q Y
  1. ;
  1. ADD(IEN) ;
  1. N ARRAY,PROMPT,TEMP,VAL
  1. D LOOKUP(.ARRAY)
  1. I '$D(ARRAY) Q 0
  1. S VAL="" F S VAL=$O(ARRAY(VAL)) Q:VAL="" D
  1. .N DA,DIC,X,Y
  1. .S DA(1)=IEN,X=+VAL
  1. .S DIC="^ORD(100.6,"_DA(1)_",8,",DIC(0)="L"
  1. .D FILE^DICN
  1. .I Y=-1 W !,"Error adding OI "_$P(VAL,U,2)_" to Auto-DC Rule" H 1
  1. Q 1
  1. ;
  1. DELETE(IEN,NODE) ;
  1. W !,"Deleting Orderable Item: "_$P(NODE,U,3)
  1. N DA,DIK
  1. S DA(1)=IEN,DA=+NODE
  1. S DIK="^ORD(100.6,"_DA(1)_",8,"
  1. D ^DIK
  1. Q
  1. ;
  1. LOOKUP(ARRAY) ;
  1. N DIC,DUOUT,QUIT,Y
  1. S QUIT=0
  1. F D Q:QUIT=1
  1. .S DIC="^ORD(101.43,",DIC("S")="I '$G(^ORD(101.43,Y,.1))"
  1. .S DIC("A")="Select Orderable Item: ",DIC(0)="ABE"
  1. .D ^DIC
  1. .I $G(DUOUT)!(Y=-1) S QUIT=1 Q
  1. .S ARRAY(Y)=""
  1. Q
  1. ;
  1. HELP(HELP) ;
  1. W !,"Select A to add Orderable Item(s) to the 'Exclude Orderble Item List'. Select D "
  1. W !,"to delete Orderable Item(s) from the 'Exclude Orderable List'."
  1. Q
  1. ;
  1. FILESCR() ;
  1. I $G(ORMGR)=1 Q 1
  1. Q 0