OREV2 ;SLC/DAN Event delayed orders set up ;10/22/03 09:06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141,208**;Dec 17, 1997
;DBIA reference section
;10060- ^VA(200
;2336 - XPAREDIT
;10026- DIR
;10116- VALM1
;2052 - DID
;10015- DIQ
;10117- VALM10
;10103- XLFDT
;10104- XLFSTR
DET ;Detailed display
N DIC,Y,ORJ,ORTMP,DA,CNT
S CNT=1,VALMBCK="R" K ^UTILITY("DIQ1",$J),^TMP("ORCXPND",$J),^TMP("VALM VIDEO",$J)
I $G(ORNMBR)="" S ORNMBR=$$ORDERS^OREV1("display")
F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ),DA=$O(^TMP("OREDO",$J,"IDX",ORTMP,0)) D
.I ORJ'=1 S ^TMP("ORCXPND",$J,CNT,0)=$$REPEAT^XLFSTR("*",79),CNT=CNT+1 S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
.D SETG(DA)
S VALMCNT=CNT-1 S:VALMCNT=0 VALMBCK="Q" S:ORNMBR="^" VALMQUIT="Q"
Q
;
SETG(IEN) ;Set details into global
N DIC,DA,ORI,DR,GLOB,NAME,I,HASPRNT,ETYPE,PIECE
K ^UTILITY("DIQ1",$J)
S (DIC,GLOB)=$S(ORTYPE="E":100.5,1:100.6)
S DA=IEN
I '$D(@("^ORD("_GLOB_","_DA_",0)")) Q
I ORTYPE="E" D
.S HASPRNT=+$P($G(^ORD(100.5,IEN,0)),U,12)
.S ETYPE=$P(^ORD(100.5,$S(HASPRNT:HASPRNT,1:IEN),0),U,2)
.I HASPRNT D Q
..S ^TMP("ORCXPND",$J,CNT,0)="This is a CHILD entry. (p) indicates value is from its parent entry.",CNT=CNT+1,^TMP("ORCXPND",$J,CNT,0)="",CNT=CNT+1
..S DR=".01;.1;1;5;8;9;13;14"
..D EN^DIQ1
..S DA=HASPRNT ;Get parent information to display with child
..S DR="2;3;4;6"_$S("^A^D^T^"[("^"_ETYPE_"^"):";7",1:"")
..D EN^DIQ1
..S PIECE="" F I=1:1:$L(DR,";") S PIECE=$P(DR,";",I) S ^UTILITY("DIQ1",$J,GLOB,IEN,PIECE)=^UTILITY("DIQ1",$J,GLOB,DA,PIECE)
..S DA=IEN ;Reset DA to child IEN
.;
.S DR=".01:6"_$S("^A^T^D^"[("^"_ETYPE_"^"):";7:9",1:";8:9")_";13"
.D EN^DIQ1
I ORTYPE="A" D
.S ETYPE=$P(^ORD(100.6,DA,0),U,2)
.S DR=".01:"_$S("^D^T^"[("^"_$P(^ORD(100.6,IEN,0),U,2)_"^")&($$ASKOBS^OREV1):"6",1:"5")
.D EN^DIQ1
S ORI=0 F S ORI=$O(^UTILITY("DIQ1",$J,GLOB,DA,ORI)) Q:ORI="" D
.S NAME=$$GET1^DID(GLOB,ORI,,"LABEL")
.I NAME="DIVISION" S NAME=$S(ETYPE="A":"ADMIT TO",ETYPE="D":"DISCHARGE FROM",ETYPE="T":"TRANS TO/WITHIN",ETYPE="O":"SURGERY WITHIN",ETYPE="S":"TR SP CHANGE WITHIN",1:"MAN. REL. WITHIN")_" "_NAME
.S:$G(HASPRNT)&("^2^3^4^6^7^"[("^"_ORI_"^")) NAME=NAME_" (P)"
.S NAME=NAME_":"
.S ^TMP("ORCXPND",$J,CNT,0)=$$LJ^XLFSTR($E(NAME)_$$LOW^XLFSTR($E(NAME,2,$L(NAME))),30)_$G(^UTILITY("DIQ1",$J,GLOB,IEN,ORI)),CNT=CNT+1
I ORTYPE="E",$D(^ORD(100.5,"DAD",DA)) D GETCHILD ;If parent then show children
D GETMULT($S($G(HASPRNT):HASPRNT,1:IEN))
I $G(^TMP("ORHIST",$J,DUZ)) D GETHIST(ORTYPE),GETAHIST(ORTYPE)
K ^UTILITY("DIQ1",$J)
Q
;
GETMULT(IEN) ;Retrieve values from multiples
N ORK,I,J,DCNT,DEF,GLOB,LOC0,ORI,SUB
;Multiples for release event file
I ORTYPE="E" D Q
.F ORK="LOC","TS" D
..S GLOB=$S(ORK="LOC":"^DIC(42,",1:"^DIC(45.7,")
..I $O(^ORD(100.5,IEN,ORK,0))>0 D
...S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
...S ^TMP("ORCXPND",$J,CNT,0)=$S(ORK="LOC":"Included Locations",1:"Included Treating Specialties")_$S($G(HASPRNT):" (p)",1:"")_":"
...D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
...S CNT=CNT+1
...S ORI=0 F S ORI=$O(^ORD(100.5,IEN,ORK,ORI)) Q:'+ORI D
....S DEF=$P(^ORD(100.5,IEN,ORK,ORI,0),"^",2) ;Is this the default?
....S ^TMP("ORCXPND",$J,CNT,0)=$P($G(@(GLOB_+$P(^ORD(100.5,IEN,ORK,ORI,0),"^")_",0)")),"^")_$S(DEF:" (Default)",1:""),CNT=CNT+1
;Multiples for auto-dc file
;Get movements, divisions, packages, display groups, and orderable items
F SUB=3,6,7,10,8 D
.I $O(^ORD(100.6,IEN,SUB,0))>0 D
..S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
..S ^TMP("ORCXPND",$J,CNT,0)=$S(SUB=3:"Movement Types:",SUB=6:"From Divisions:",SUB=7:"Included Packages:",SUB=10:"Excluded Display Groups:",1:"Excluded Orderable Items:")
..D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
..S CNT=CNT+1
..S GLOB=$S(SUB=3:"^DG(405.2,",SUB=6:"^DIC(4,",SUB=7:"^DIC(9.4,",SUB=10:"^ORD(100.98,",1:"^ORD(101.43,")
..S I=0 F S I=$O(^ORD(100.6,IEN,SUB,I)) Q:'+I D
...S ^TMP("ORCXPND",$J,CNT,0)=$$GET1^DIQ(+$P(GLOB,"(",2),+$P(^ORD(100.6,IEN,SUB,I,0),U)_",",.01,"")
...I SUB=8,$G(@(GLOB_+$P(^ORD(100.6,IEN,SUB,I,0),U)_",.1)")) S ^TMP("ORCXPND",$J,CNT,0)=^TMP("ORCXPND",$J,CNT,0)_" (* INACTIVE *)"
...S CNT=CNT+1
;
;Get Treating Specialties
I $O(^ORD(100.6,IEN,4,0))>0 D
.S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
.S ^TMP("ORCXPND",$J,CNT,0)="Excluding From Treating Specialties: To Treating Specialties:"
.D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
.S CNT=CNT+1
.S GLOB="^DIC(45.7,"
.S I=0 F S I=$O(^ORD(100.6,IEN,4,I)) Q:'+I D
..S ^TMP("ORCXPND",$J,CNT,0)=$$LJ^XLFSTR($P($G(@(GLOB_+$P(^ORD(100.6,IEN,4,I,0),U)_",0)")),U),40)
..S DCNT=0
..S J=0 F S J=$O(^ORD(100.6,IEN,4,I,1,J)) Q:'+J D
...S:DCNT'=0 CNT=CNT+1
...S ^TMP("ORCXPND",$J,CNT,0)=$S(DCNT=0:^TMP("ORCXPND",$J,CNT,0),1:$$REPEAT^XLFSTR(" ",40))_$P($G(@(GLOB_+$P(^ORD(100.6,IEN,4,I,1,J,0),U)_",0)")),U)
...S DCNT=1
..S CNT=CNT+1
;Locations
I $O(^ORD(100.6,IEN,5,0)) D
.S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
.S ^TMP("ORCXPND",$J,CNT,0)="Including From Locations:"_$$REPEAT^XLFSTR(" ",15)_"To Locations:"
.D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
.S CNT=CNT+1
.S GLOB="^SC("
.S I=0 F S I=$O(^ORD(100.6,IEN,5,I)) Q:'+I D
..S LOC0=^ORD(100.6,IEN,5,I,0)
..S ^TMP("ORCXPND",$J,CNT,0)=$$LJ^XLFSTR($S($P(LOC0,U,2)=1:"* (All Locations)",1:$P($G(@(GLOB_+$P(LOC0,U,3)_",0)")),U)),40)
..S ^TMP("ORCXPND",$J,CNT,0)=^TMP("ORCXPND",$J,CNT,0)_$S($P(LOC0,U,4)=1:"* (All Locations)",1:$P($G(@(GLOB_+$P(LOC0,U,5)_",0)")),U)),CNT=CNT+1
Q
;
GETHIST(TYPE) ;Print activation history on detailed report
N ORGLOB,I,VALUE
S ORGLOB="^ORD(100."_$S(ORTYPE="E":"5,",1:"6,")
I $D(@(ORGLOB_IEN_",2)")) S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1,^TMP("ORCXPND",$J,CNT,0)="Activation History:" D
.D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
.S CNT=CNT+1
S I=0 F S I=$O(@(ORGLOB_IEN_",2,"_I_")")) Q:'+I D
.S VALUE=$G(^(I,0)) Q:VALUE=""
.S ^TMP("ORCXPND",$J,CNT,0)="Activated: "_$$FMTE^XLFDT($P(VALUE,U),1)_" Inactivated: "_$$FMTE^XLFDT($P(VALUE,U,2),1),CNT=CNT+1
Q
;
GETAHIST(TYPE) ;Print audit history on detailed report
N ORGLOB,ORI,VALUE,DIC,DR,DA,DIQ,NAME
S ORGLOB="^ORD(100."_$S(ORTYPE="E":"5,",1:"6,")
I $D(@(ORGLOB_IEN_",9)")) S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1,^TMP("ORCXPND",$J,CNT,0)="Add/Edit History:" D
.D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
.S CNT=CNT+1
S ORI=0 F S ORI=$O(@(ORGLOB_IEN_",9,"_ORI_")")) Q:'+ORI D
.S VALUE=$G(^(ORI,0)) Q:VALUE=""
.K NAME S DIC=200,DR=".01",DA=+$P(VALUE,U,2),DIQ="NAME",DIQ(0)="E" D EN^DIQ1
.S ^TMP("ORCXPND",$J,CNT,0)=$S($P(VALUE,U,3)="N":"Added",1:"Edited")_" on "_$$FMTE^XLFDT($P(VALUE,U),1)_" by "_$G(NAME(200,DA,.01,"E")),CNT=CNT+1
Q
;
IWT(DA) ;Function to determine if MAS MOVEMENT Interward transfer is being used by itself. It may not be used in conjunction with other transfer types
N IWT
S IWT=0
I $P($G(^ORD(100.6,DA,0)),U,2)="T",$P($G(^ORD(100.6,DA,3,0)),U,4)=1,$D(^ORD(100.6,DA,3,"B",4)) S IWT=1
Q IWT
;
INCHIST ;Toggles audit and activation histories for inclusion on the detailed display
N INC,DIR,Y
S INC=$G(^TMP("ORHIST",$J,DUZ))
S VALMBCK="R" D FULL^VALM1
W !!,"Currently, the audit and activation histories are "_$S('INC:"not ",1:"")_"appearing",!,"on the detailed display.",!
S DIR(0)="Y",DIR("A")="Do you want to "_$S('INC:"include them on",1:"remove them from")_" the detailed display",DIR("B")="N" D ^DIR
I Y'=1 W !,"Nothing changed!" Q
W !,"Histories are now "_$S('INC:"included.",1:"removed.")
I 'INC S ^TMP("ORHIST",$J,DUZ)=1
I INC K ^TMP("ORHIST",$J,DUZ)
Q
;
FULLDSP ;Toggle between expanded and truncated display
N DSP,DIR,Y,DIRUT
S DSP=$G(^TMP("ORDSP",$J,DUZ))
W !!,"Currently, the display is "_$S('DSP:"truncated.",1:"expanded."),!
S DIR(0)="Y",DIR("A")="Do you want to "_$S(DSP:"truncate",1:"expand")_" this display",DIR("B")="N" D ^DIR K DIR
W:Y'=1 !,"Nothing changed!",! Q:$D(DIRUT)
W:Y=1 !,"List is now "_$S('DSP:"expanded.",1:"truncated."),!
I Y&('DSP) S ^TMP("ORDSP",$J,DUZ)=1
I Y&(DSP) K ^TMP("ORDSP",$J,DUZ)
S DIR(0)="Y",DIR("A")="Terminal emulator in 80 column mode",DIR("B")="Y"
S DIR("?")="Enter yes for 80 column or no for 132 column mode. Display will be updated to relfect your answer."
D ^DIR Q:$D(DIRUT)
S VALMWD=$S(Y=1:80,1:132)
Q
;
LIST ;Change which entries appear in list
N LST,Y,DIR,DIRUT
S LST=$G(^TMP("ORLIST",$J,DUZ))
W !!,"Currently, the list includes "_$S(LST="A":"only active",LST="I":"only inactive",1:"all")_" entries."
S DIR(0)="SO^1:Active entries only;2:Inactive entries only;3:All entries",DIR("A")="Select which entries should appear on the list"
D ^DIR
Q:+Y'>0
I Y=3 K ^TMP("ORLIST",$J,DUZ) Q
S ^TMP("ORLIST",$J,DUZ)=$E(Y(0))
I LST'=$G(^TMP("ORLIST",$J,DUZ)) S VALMBG=1
Q
;
CD ;Change display
S VALMBCK="R" D FULL^VALM1
D FULLDSP,LIST
Q
;
GETCHILD ;
N I
S ^TMP("ORCXPND",$J,CNT,0)="",CNT=CNT+1
S ^TMP("ORCXPND",$J,CNT,0)="Child events:"
D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
S CNT=CNT+1
S I=0 F S I=$O(^ORD(100.5,"DAD",DA,I)) Q:'+I S ^TMP("ORCXPND",$J,CNT,0)=$P(^ORD(100.5,I,0),U),CNT=CNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOREV2 9352 printed Oct 16, 2024@18:31:14 Page 2
OREV2 ;SLC/DAN Event delayed orders set up ;10/22/03 09:06
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141,208**;Dec 17, 1997
+2 ;DBIA reference section
+3 ;10060- ^VA(200
+4 ;2336 - XPAREDIT
+5 ;10026- DIR
+6 ;10116- VALM1
+7 ;2052 - DID
+8 ;10015- DIQ
+9 ;10117- VALM10
+10 ;10103- XLFDT
+11 ;10104- XLFSTR
DET ;Detailed display
+1 NEW DIC,Y,ORJ,ORTMP,DA,CNT
+2 SET CNT=1
SET VALMBCK="R"
KILL ^UTILITY("DIQ1",$JOB),^TMP("ORCXPND",$JOB),^TMP("VALM VIDEO",$JOB)
+3 IF $GET(ORNMBR)=""
SET ORNMBR=$$ORDERS^OREV1("display")
+4 FOR ORJ=1:1:$LENGTH(ORNMBR,",")-1
SET ORTMP=$PIECE(ORNMBR,",",ORJ)
SET DA=$ORDER(^TMP("OREDO",$JOB,"IDX",ORTMP,0))
Begin DoDot:1
+5 IF ORJ'=1
SET ^TMP("ORCXPND",$JOB,CNT,0)=$$REPEAT^XLFSTR("*",79)
SET CNT=CNT+1
SET ^TMP("ORCXPND",$JOB,CNT,0)=" "
SET CNT=CNT+1
+6 DO SETG(DA)
End DoDot:1
+7 SET VALMCNT=CNT-1
if VALMCNT=0
SET VALMBCK="Q"
if ORNMBR="^"
SET VALMQUIT="Q"
+8 QUIT
+9 ;
SETG(IEN) ;Set details into global
+1 NEW DIC,DA,ORI,DR,GLOB,NAME,I,HASPRNT,ETYPE,PIECE
+2 KILL ^UTILITY("DIQ1",$JOB)
+3 SET (DIC,GLOB)=$SELECT(ORTYPE="E":100.5,1:100.6)
+4 SET DA=IEN
+5 IF '$DATA(@("^ORD("_GLOB_","_DA_",0)"))
QUIT
+6 IF ORTYPE="E"
Begin DoDot:1
+7 SET HASPRNT=+$PIECE($GET(^ORD(100.5,IEN,0)),U,12)
+8 SET ETYPE=$PIECE(^ORD(100.5,$SELECT(HASPRNT:HASPRNT,1:IEN),0),U,2)
+9 IF HASPRNT
Begin DoDot:2
+10 SET ^TMP("ORCXPND",$JOB,CNT,0)="This is a CHILD entry. (p) indicates value is from its parent entry."
SET CNT=CNT+1
SET ^TMP("ORCXPND",$JOB,CNT,0)=""
SET CNT=CNT+1
+11 SET DR=".01;.1;1;5;8;9;13;14"
+12 DO EN^DIQ1
+13 ;Get parent information to display with child
SET DA=HASPRNT
+14 SET DR="2;3;4;6"_$SELECT("^A^D^T^"[("^"_ETYPE_"^"):";7",1:"")
+15 DO EN^DIQ1
+16 SET PIECE=""
FOR I=1:1:$LENGTH(DR,";")
SET PIECE=$PIECE(DR,";",I)
SET ^UTILITY("DIQ1",$JOB,GLOB,IEN,PIECE)=^UTILITY("DIQ1",$JOB,GLOB,DA,PIECE)
+17 ;Reset DA to child IEN
SET DA=IEN
End DoDot:2
QUIT
+18 ;
+19 SET DR=".01:6"_$SELECT("^A^T^D^"[("^"_ETYPE_"^"):";7:9",1:";8:9")_";13"
+20 DO EN^DIQ1
End DoDot:1
+21 IF ORTYPE="A"
Begin DoDot:1
+22 SET ETYPE=$PIECE(^ORD(100.6,DA,0),U,2)
+23 SET DR=".01:"_$SELECT("^D^T^"[("^"_$PIECE(^ORD(100.6,IEN,0),U,2)_"^")&($$ASKOBS^OREV1):"6",1:"5")
+24 DO EN^DIQ1
End DoDot:1
+25 SET ORI=0
FOR
SET ORI=$ORDER(^UTILITY("DIQ1",$JOB,GLOB,DA,ORI))
if ORI=""
QUIT
Begin DoDot:1
+26 SET NAME=$$GET1^DID(GLOB,ORI,,"LABEL")
+27 IF NAME="DIVISION"
SET NAME=$SELECT(ETYPE="A":"ADMIT TO",ETYPE="D":"DISCHARGE FROM",ETYPE="T":"TRANS TO/WITHIN",ETYPE="O":"SURGERY WITHIN",ETYPE="S":"TR SP CHANGE WITHIN",1:"MAN. REL. WITHIN")_" "_NAME
+28 if $GET(HASPRNT)&("^2^3^4^6^7^"[("^"_ORI_"^"))
SET NAME=NAME_" (P)"
+29 SET NAME=NAME_":"
+30 SET ^TMP("ORCXPND",$JOB,CNT,0)=$$LJ^XLFSTR($EXTRACT(NAME)_$$LOW^XLFSTR($EXTRACT(NAME,2,$LENGTH(NAME))),30)_$GET(^UTILITY("DIQ1",$JOB,GLOB,IEN,ORI))
SET CNT=CNT+1
End DoDot:1
+31 ;If parent then show children
IF ORTYPE="E"
IF $DATA(^ORD(100.5,"DAD",DA))
DO GETCHILD
+32 DO GETMULT($SELECT($GET(HASPRNT):HASPRNT,1:IEN))
+33 IF $GET(^TMP("ORHIST",$JOB,DUZ))
DO GETHIST(ORTYPE)
DO GETAHIST(ORTYPE)
+34 KILL ^UTILITY("DIQ1",$JOB)
+35 QUIT
+36 ;
GETMULT(IEN) ;Retrieve values from multiples
+1 NEW ORK,I,J,DCNT,DEF,GLOB,LOC0,ORI,SUB
+2 ;Multiples for release event file
+3 IF ORTYPE="E"
Begin DoDot:1
+4 FOR ORK="LOC","TS"
Begin DoDot:2
+5 SET GLOB=$SELECT(ORK="LOC":"^DIC(42,",1:"^DIC(45.7,")
+6 IF $ORDER(^ORD(100.5,IEN,ORK,0))>0
Begin DoDot:3
+7 SET ^TMP("ORCXPND",$JOB,CNT,0)=" "
SET CNT=CNT+1
+8 SET ^TMP("ORCXPND",$JOB,CNT,0)=$SELECT(ORK="LOC":"Included Locations",1:"Included Treating Specialties")_$SELECT($GET(HASPRNT):" (p)",1:"")_":"
+9 if $DATA(IOUON)&($DATA(IOUOFF))
DO CNTRL^VALM10(CNT,1,$LENGTH(^(0)),IOUON,IOUOFF)
+10 SET CNT=CNT+1
+11 SET ORI=0
FOR
SET ORI=$ORDER(^ORD(100.5,IEN,ORK,ORI))
if '+ORI
QUIT
Begin DoDot:4
+12 ;Is this the default?
SET DEF=$PIECE(^ORD(100.5,IEN,ORK,ORI,0),"^",2)
+13 SET ^TMP("ORCXPND",$JOB,CNT,0)=$PIECE($GET(@(GLOB_+$PIECE(^ORD(100.5,IEN,ORK,ORI,0),"^")_",0)")),"^")_$SELECT(DEF:" (Default)",1:"")
SET CNT=CNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+14 ;Multiples for auto-dc file
+15 ;Get movements, divisions, packages, display groups, and orderable items
+16 FOR SUB=3,6,7,10,8
Begin DoDot:1
+17 IF $ORDER(^ORD(100.6,IEN,SUB,0))>0
Begin DoDot:2
+18 SET ^TMP("ORCXPND",$JOB,CNT,0)=" "
SET CNT=CNT+1
+19 SET ^TMP("ORCXPND",$JOB,CNT,0)=$SELECT(SUB=3:"Movement Types:",SUB=6:"From Divisions:",SUB=7:"Included Packages:",SUB=10:"Excluded Display Groups:",1:"Excluded Orderable Items:")
+20 if $DATA(IOUON)&($DATA(IOUOFF))
DO CNTRL^VALM10(CNT,1,$LENGTH(^(0)),IOUON,IOUOFF)
+21 SET CNT=CNT+1
+22 SET GLOB=$SELECT(SUB=3:"^DG(405.2,",SUB=6:"^DIC(4,",SUB=7:"^DIC(9.4,",SUB=10:"^ORD(100.98,",1:"^ORD(101.43,")
+23 SET I=0
FOR
SET I=$ORDER(^ORD(100.6,IEN,SUB,I))
if '+I
QUIT
Begin DoDot:3
+24 SET ^TMP("ORCXPND",$JOB,CNT,0)=$$GET1^DIQ(+$PIECE(GLOB,"(",2),+$PIECE(^ORD(100.6,IEN,SUB,I,0),U)_",",.01,"")
+25 IF SUB=8
IF $GET(@(GLOB_+$PIECE(^ORD(100.6,IEN,SUB,I,0),U)_",.1)"))
SET ^TMP("ORCXPND",$JOB,CNT,0)=^TMP("ORCXPND",$JOB,CNT,0)_" (* INACTIVE *)"
+26 SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+27 ;
+28 ;Get Treating Specialties
+29 IF $ORDER(^ORD(100.6,IEN,4,0))>0
Begin DoDot:1
+30 SET ^TMP("ORCXPND",$JOB,CNT,0)=" "
SET CNT=CNT+1
+31 SET ^TMP("ORCXPND",$JOB,CNT,0)="Excluding From Treating Specialties: To Treating Specialties:"
+32 if $DATA(IOUON)&($DATA(IOUOFF))
DO CNTRL^VALM10(CNT,1,$LENGTH(^(0)),IOUON,IOUOFF)
+33 SET CNT=CNT+1
+34 SET GLOB="^DIC(45.7,"
+35 SET I=0
FOR
SET I=$ORDER(^ORD(100.6,IEN,4,I))
if '+I
QUIT
Begin DoDot:2
+36 SET ^TMP("ORCXPND",$JOB,CNT,0)=$$LJ^XLFSTR($PIECE($GET(@(GLOB_+$PIECE(^ORD(100.6,IEN,4,I,0),U)_",0)")),U),40)
+37 SET DCNT=0
+38 SET J=0
FOR
SET J=$ORDER(^ORD(100.6,IEN,4,I,1,J))
if '+J
QUIT
Begin DoDot:3
+39 if DCNT'=0
SET CNT=CNT+1
+40 SET ^TMP("ORCXPND",$JOB,CNT,0)=$SELECT(DCNT=0:^TMP("ORCXPND",$JOB,CNT,0),1:$$REPEAT^XLFSTR(" ",40))_$PIECE($GET(@(GLOB_+$PIECE(^ORD(100.6,IEN,4,I,1,J,0),U)_",0)")),U)
+41 SET DCNT=1
End DoDot:3
+42 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+43 ;Locations
+44 IF $ORDER(^ORD(100.6,IEN,5,0))
Begin DoDot:1
+45 SET ^TMP("ORCXPND",$JOB,CNT,0)=" "
SET CNT=CNT+1
+46 SET ^TMP("ORCXPND",$JOB,CNT,0)="Including From Locations:"_$$REPEAT^XLFSTR(" ",15)_"To Locations:"
+47 if $DATA(IOUON)&($DATA(IOUOFF))
DO CNTRL^VALM10(CNT,1,$LENGTH(^(0)),IOUON,IOUOFF)
+48 SET CNT=CNT+1
+49 SET GLOB="^SC("
+50 SET I=0
FOR
SET I=$ORDER(^ORD(100.6,IEN,5,I))
if '+I
QUIT
Begin DoDot:2
+51 SET LOC0=^ORD(100.6,IEN,5,I,0)
+52 SET ^TMP("ORCXPND",$JOB,CNT,0)=$$LJ^XLFSTR($SELECT($PIECE(LOC0,U,2)=1:"* (All Locations)",1:$PIECE($GET(@(GLOB_+$PIECE(LOC0,U,3)_",0)")),U)),40)
+53 SET ^TMP("ORCXPND",$JOB,CNT,0)=^TMP("ORCXPND",$JOB,CNT,0)_$SELECT($PIECE(LOC0,U,4)=1:"* (All Locations)",1:$PIECE($GET(@(GLOB_+$PIECE(LOC0,U,5)_",0)")),U))
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+54 QUIT
+55 ;
GETHIST(TYPE) ;Print activation history on detailed report
+1 NEW ORGLOB,I,VALUE
+2 SET ORGLOB="^ORD(100."_$SELECT(ORTYPE="E":"5,",1:"6,")
+3 IF $DATA(@(ORGLOB_IEN_",2)"))
SET ^TMP("ORCXPND",$JOB,CNT,0)=" "
SET CNT=CNT+1
SET ^TMP("ORCXPND",$JOB,CNT,0)="Activation History:"
Begin DoDot:1
+4 if $DATA(IOUON)&($DATA(IOUOFF))
DO CNTRL^VALM10(CNT,1,$LENGTH(^(0)),IOUON,IOUOFF)
+5 SET CNT=CNT+1
End DoDot:1
+6 SET I=0
FOR
SET I=$ORDER(@(ORGLOB_IEN_",2,"_I_")"))
if '+I
QUIT
Begin DoDot:1
+7 SET VALUE=$GET(^(I,0))
if VALUE=""
QUIT
+8 SET ^TMP("ORCXPND",$JOB,CNT,0)="Activated: "_$$FMTE^XLFDT($PIECE(VALUE,U),1)_" Inactivated: "_$$FMTE^XLFDT($PIECE(VALUE,U,2),1)
SET CNT=CNT+1
End DoDot:1
+9 QUIT
+10 ;
GETAHIST(TYPE) ;Print audit history on detailed report
+1 NEW ORGLOB,ORI,VALUE,DIC,DR,DA,DIQ,NAME
+2 SET ORGLOB="^ORD(100."_$SELECT(ORTYPE="E":"5,",1:"6,")
+3 IF $DATA(@(ORGLOB_IEN_",9)"))
SET ^TMP("ORCXPND",$JOB,CNT,0)=" "
SET CNT=CNT+1
SET ^TMP("ORCXPND",$JOB,CNT,0)="Add/Edit History:"
Begin DoDot:1
+4 if $DATA(IOUON)&($DATA(IOUOFF))
DO CNTRL^VALM10(CNT,1,$LENGTH(^(0)),IOUON,IOUOFF)
+5 SET CNT=CNT+1
End DoDot:1
+6 SET ORI=0
FOR
SET ORI=$ORDER(@(ORGLOB_IEN_",9,"_ORI_")"))
if '+ORI
QUIT
Begin DoDot:1
+7 SET VALUE=$GET(^(ORI,0))
if VALUE=""
QUIT
+8 KILL NAME
SET DIC=200
SET DR=".01"
SET DA=+$PIECE(VALUE,U,2)
SET DIQ="NAME"
SET DIQ(0)="E"
DO EN^DIQ1
+9 SET ^TMP("ORCXPND",$JOB,CNT,0)=$SELECT($PIECE(VALUE,U,3)="N":"Added",1:"Edited")_" on "_$$FMTE^XLFDT($PIECE(VALUE,U),1)_" by "_$GET(NAME(200,DA,.01,"E"))
SET CNT=CNT+1
End DoDot:1
+10 QUIT
+11 ;
IWT(DA) ;Function to determine if MAS MOVEMENT Interward transfer is being used by itself. It may not be used in conjunction with other transfer types
+1 NEW IWT
+2 SET IWT=0
+3 IF $PIECE($GET(^ORD(100.6,DA,0)),U,2)="T"
IF $PIECE($GET(^ORD(100.6,DA,3,0)),U,4)=1
IF $DATA(^ORD(100.6,DA,3,"B",4))
SET IWT=1
+4 QUIT IWT
+5 ;
INCHIST ;Toggles audit and activation histories for inclusion on the detailed display
+1 NEW INC,DIR,Y
+2 SET INC=$GET(^TMP("ORHIST",$JOB,DUZ))
+3 SET VALMBCK="R"
DO FULL^VALM1
+4 WRITE !!,"Currently, the audit and activation histories are "_$SELECT('INC:"not ",1:"")_"appearing",!,"on the detailed display.",!
+5 SET DIR(0)="Y"
SET DIR("A")="Do you want to "_$SELECT('INC:"include them on",1:"remove them from")_" the detailed display"
SET DIR("B")="N"
DO ^DIR
+6 IF Y'=1
WRITE !,"Nothing changed!"
QUIT
+7 WRITE !,"Histories are now "_$SELECT('INC:"included.",1:"removed.")
+8 IF 'INC
SET ^TMP("ORHIST",$JOB,DUZ)=1
+9 IF INC
KILL ^TMP("ORHIST",$JOB,DUZ)
+10 QUIT
+11 ;
FULLDSP ;Toggle between expanded and truncated display
+1 NEW DSP,DIR,Y,DIRUT
+2 SET DSP=$GET(^TMP("ORDSP",$JOB,DUZ))
+3 WRITE !!,"Currently, the display is "_$SELECT('DSP:"truncated.",1:"expanded."),!
+4 SET DIR(0)="Y"
SET DIR("A")="Do you want to "_$SELECT(DSP:"truncate",1:"expand")_" this display"
SET DIR("B")="N"
DO ^DIR
KILL DIR
+5 if Y'=1
WRITE !,"Nothing changed!",!
if $DATA(DIRUT)
QUIT
+6 if Y=1
WRITE !,"List is now "_$SELECT('DSP:"expanded.",1:"truncated."),!
+7 IF Y&('DSP)
SET ^TMP("ORDSP",$JOB,DUZ)=1
+8 IF Y&(DSP)
KILL ^TMP("ORDSP",$JOB,DUZ)
+9 SET DIR(0)="Y"
SET DIR("A")="Terminal emulator in 80 column mode"
SET DIR("B")="Y"
+10 SET DIR("?")="Enter yes for 80 column or no for 132 column mode. Display will be updated to relfect your answer."
+11 DO ^DIR
if $DATA(DIRUT)
QUIT
+12 SET VALMWD=$SELECT(Y=1:80,1:132)
+13 QUIT
+14 ;
LIST ;Change which entries appear in list
+1 NEW LST,Y,DIR,DIRUT
+2 SET LST=$GET(^TMP("ORLIST",$JOB,DUZ))
+3 WRITE !!,"Currently, the list includes "_$SELECT(LST="A":"only active",LST="I":"only inactive",1:"all")_" entries."
+4 SET DIR(0)="SO^1:Active entries only;2:Inactive entries only;3:All entries"
SET DIR("A")="Select which entries should appear on the list"
+5 DO ^DIR
+6 if +Y'>0
QUIT
+7 IF Y=3
KILL ^TMP("ORLIST",$JOB,DUZ)
QUIT
+8 SET ^TMP("ORLIST",$JOB,DUZ)=$EXTRACT(Y(0))
+9 IF LST'=$GET(^TMP("ORLIST",$JOB,DUZ))
SET VALMBG=1
+10 QUIT
+11 ;
CD ;Change display
+1 SET VALMBCK="R"
DO FULL^VALM1
+2 DO FULLDSP
DO LIST
+3 QUIT
+4 ;
GETCHILD ;
+1 NEW I
+2 SET ^TMP("ORCXPND",$JOB,CNT,0)=""
SET CNT=CNT+1
+3 SET ^TMP("ORCXPND",$JOB,CNT,0)="Child events:"
+4 if $DATA(IOUON)&($DATA(IOUOFF))
DO CNTRL^VALM10(CNT,1,$LENGTH(^(0)),IOUON,IOUOFF)
+5 SET CNT=CNT+1
+6 SET I=0
FOR
SET I=$ORDER(^ORD(100.5,"DAD",DA,I))
if '+I
QUIT
SET ^TMP("ORCXPND",$JOB,CNT,0)=$PIECE(^ORD(100.5,I,0),U)
SET CNT=CNT+1
+7 QUIT
