ORCMEDT7 ;SLC/JM-QO,Edit Quick Orders By User ;2/1/06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**245**;Dec 17, 1997;Build 2
Q
QCKBYUSR ; Edit quick orders by user
N ORDGINFO,ORTEXT,ORIEN,ORFMDATA,ORUSER,ORDG,ORLINE0
K ^TMP("ORWDQUSR",$J)
S ORUSER=0
F S ORDGINFO=$$QCKUSRDG(ORUSER) Q:ORDGINFO=0 S:ORDGINFO<0 ORUSER=0 I +ORDGINFO>0,$D(^ORD(101.41,+ORDGINFO,0)) D
. S ORIEN=$P(ORDGINFO,U,1)
. S ORFMDATA=$P(ORDGINFO,U,2)
. S ORUSER=$P(ORDGINFO,U,3)
. S ORLINE0=$G(^ORD(101.41,ORIEN,0))
. S ORTEXT=$P(ORLINE0,U,2)
. S ORDG=+$P(ORLINE0,U,5)
. D QCK0^ORCMEDT1(ORIEN) ; edit quick order
. D VERIFYDA(.ORFMDATA,ORIEN)
. I +ORFMDATA D
. . ; If quick order not deleted, and display text changes, change 101.44 display text to match
. . I $D(^ORD(101.41,ORIEN,0)),ORTEXT'=$P(^ORD(101.41,ORIEN,0),U,2) D
. . . N DIE,DA,DR,DIDEL
. . . S DA(1)=$P(ORFMDATA,";",1)
. . . S DIE="^ORD(101.44,"_DA(1)_",10,"
. . . S DA=$P(ORFMDATA,";",2)
. . . ; 101.44 Display text holds 132 chars, 101.41 only 80. so this is ok
. . . S DR="2///"_$P(^ORD(101.41,ORIEN,0),U,2)
. . . D ^DIE
. K ^TMP("ORWDQUSR",$J,"A",ORUSER) ; Force reload of user Quick Order info
. W !
K ^TMP("ORWDQUSR",$J)
Q
QCKUSRDG(ORLSTUSR) ; Get quick order dialog by user
N DIC,DIR,DA,X,Y,ORIDX,ORUSER,ORLEN,ORPRE,ORDIALOG,ORHEADER,ORGROUP,ORCOUNT,USERNAME
N DTOUT,DUOUT,DIROUT,DIRUT,OREXIT,ORINPUT,ORDGNAME,ORDGIEN,ORLASTGP,ORFMDATA,ORFIRST
S ORDIALOG=0
S ORUSER=$$GETUSER(ORLSTUSR)
I ORUSER>0 D
. S ORPRE="ORWDQ USR"_ORUSER,ORLEN=$L(ORPRE)
. S ORIDX=$O(^ORD(101.44,"B",ORPRE))
. I $E(ORIDX,1,ORLEN)=ORPRE D I 1
. . D QULIST(ORUSER)
. . S USERNAME=$P($G(^VA(200,ORUSER,0)),U,1)
. . S ORHEADER=USERNAME_" personal quick orders:"
. . S ORCOUNT=0,ORIDX=0,OREXIT=0,ORLASTGP=U,ORFIRST=1
. . F S ORIDX=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX)) Q:'+ORIDX D Q:+OREXIT!(ORDIALOG>0)
. . . S ORCOUNT=ORCOUNT+1
. . . I ORCOUNT=1 D
. . . . I ORFIRST S ORFIRST=0 W !,!
. . . . W !,ORHEADER,!
. . . S ORGROUP=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX,""))
. . . S ORDGIEN=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX,ORGROUP,""))
. . . S ORFMDATA=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX,ORGROUP,ORDGIEN,""))
. . . S ORDGNAME=$G(^TMP("ORWDQUSR",$J,"A",ORUSER,ORIDX,ORGROUP,ORDGIEN,ORFMDATA))
. . . I (ORCOUNT=1)!(ORGROUP'=ORLASTGP) D
. . . . S ORLASTGP=ORGROUP
. . . . S ORCOUNT=ORCOUNT+1
. . . . W ?4,ORGROUP,!
. . . W ?7,ORIDX,?12,ORDGNAME,!
. . . I ORCOUNT'<18 D
. . . . S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, OR"
. . . . S ORDIALOG=$$QUIDX()
. . . . S ORCOUNT=0
. . I ORDIALOG'>0,'+OREXIT D
. . . S ORIDX=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,999999),-1)
. . . I ORIDX<1 D I 1
. . . . ; If user had quick orders, but doesn't any more, there will be false positives in "B" xref
. . . . D QULIST(0)
. . . . K ^TMP("ORWDQUSR",$J,"B",USERNAME)
. . . . D SHOWUSRS
. . . E D
. . . . S DIR("A",1)=""
. . . . S ORDIALOG=$$QUIDX()
. E D SHOWUSRS
Q ORDIALOG
GETUSER(ORUSER) ;
I +ORUSER Q ORUSER
N DIC,Y,X,DLAYGO,DINUM
S DIC="^VA(200,",DIC(0)="AEMQ"
D ^DIC
Q +Y
SHOWUSRS ;
S ORDIALOG=-1 ; Repeats loop
W !,!,$P($G(^VA(200,ORUSER,0)),U,1)_" does not have any personal quick orders."
S DIR("A")="Would you like to see a list of users with personal quick orders"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR
I +Y D I 1
. W !,!," Choose from:",!
. D QULIST(0)
. S ORUSER="",ORIDX=2,OREXIT=0
. F S ORUSER=$O(^TMP("ORWDQUSR",$J,"B",ORUSER)) Q:OREXIT!(ORUSER="") D Q:OREXIT
. . W " ",ORUSER,!
. . S ORIDX=ORIDX+1
. . I ORIDX=22 D
. . . S ORIDX=0
. . . R " '^' TO STOP: ",ORINPUT:$G(DTIME,300)
. . . E S OREXIT=1
. . . W $C(13),$J("",20),$C(13) Q:OREXIT
. . . I ORINPUT[U S OREXIT=1
E I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ORDIALOG=0
Q
QUIDX() ; Get quick order dialog info
N ORGROUP,ORDGIEN,ORFMDATA,ORRESULT
S DIR("A")="CHOOSE 1-"_ORIDX_": "
S DIR(0)="NOA^1:"_ORIDX
D ^DIR
I +Y>0,+Y'>ORIDX D Q ORRESULT
. S ORGROUP=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,+Y,""))
. S ORDGIEN=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,+Y,ORGROUP,""))
. I $$CONFLICT(ORUSER,ORDGIEN) S OREXIT=1,ORRESULT=-1 Q
. S ORFMDATA=$O(^TMP("ORWDQUSR",$J,"A",ORUSER,+Y,ORGROUP,ORDGIEN,""))
. S ORRESULT=ORDGIEN_U_ORFMDATA_U_ORUSER
W !
I Y[U S OREXIT=1
Q -1 ; -1 Value repeats the enter name loop / 0 exits loop
QULIST(ORUSER) ; Build user info
N PRE,ID,LEN
S PRE="ORWDQ USR"
I ORUSER=0 D Q
. ; "B" node is list of all users with Quick Orders
. I $D(^TMP("ORWDQUSR",$J,"B")) Q
. N LASTUSER,USERNAME,USER
. S LASTUSER=0,ID=PRE,LEN=$L(PRE)
. F S ID=$O(^ORD(101.44,"B",ID)) Q:($E(ID,1,LEN)'=PRE) D
. . S USER=$P($E(ID,LEN+1,999)," ")
. . I USER'=LASTUSER D
. . . S LASTUSER=USER
. . . S USERNAME=$P($G(^VA(200,USER,0)),U,1)
. . . S ^TMP("ORWDQUSR",$J,"B",USERNAME)=""
. Q
;
; "A" node is list of quick orders for an individual user
; Temp array nodes are "ORWDQUSR",$J,"A"
; User IEN, Index Number, Display Group, Quick Order IEN, 101.44 IEN
; Data value is Quick Order Name - (Name can be 132 chars so can't be node)
;
I $D(^TMP("ORWDQUSR",$J,"A",ORUSER)) Q
N GROUP,IDX,NUMBER,QOINDEX,QCKORDER,ORFMDATA
S PRE=PRE_ORUSER,ID=PRE,NUMBER=0,LEN=$L(PRE)
F S ID=$O(^ORD(101.44,"B",ID)) Q:($E(ID,1,LEN)'=PRE) D
. S GROUP=$P(ID," ",3,999)
. S GROUP=$O(^ORD(100.98,"B",GROUP,0))
. I +GROUP S GROUP=$P($G(^ORD(100.98,GROUP,0)),U,1)
. S IDX=$O(^ORD(101.44,"B",ID,0)),QOINDEX=0
. F S QOINDEX=$O(^ORD(101.44,IDX,10,QOINDEX)) Q:'+QOINDEX D
. . S QCKORDER=$G(^ORD(101.44,IDX,10,QOINDEX,0))
. . I +QCKORDER,+$D(^ORD(101.41,+QCKORDER)) D
. . . S NUMBER=NUMBER+1
. . . S ORFMDATA=IDX_";"_QOINDEX
. . . S ^TMP("ORWDQUSR",$J,"A",ORUSER,NUMBER,GROUP,$P(QCKORDER,U,1),ORFMDATA)=$P(QCKORDER,U,2)
Q
VERIFYDA(ORFMDATA,ORIEN) ;
; Make sure FileMan pointers are still correct
; - may have changes via CPRS GUI or QCK0^ORCMEDT1(ORIEN)
N IDX1,IDX2,IEN
S IDX1=$P(ORFMDATA,";",1)
S IDX2=$P(ORFMDATA,";",2)
S IEN=$P($G(^ORD(101.44,IDX1,10,IDX2,0)),U,1)
I IEN=ORIEN Q
S ORFMDATA=""
S IDX2=0
F S IDX2=$O(^ORD(101.44,IDX1,10,IDX2)) Q:'+IDX2 D Q:+ORFMDATA
. I $P($G(^ORD(101.44,IDX1,10,IDX2,0)),U,1)=ORIEN S ORFMDATA=IDX1_";"_IDX2
Q
CONFLICT(ORUSER,DIALOG) ; Determine if another user shares the personal quick order
N DG,OTHERS,USR,NAME,ABORT,DIR,Y,DA,X,DTOUT,DUOUT,DIROUT,DIRUT,COUNT,TEMP
S (DG,ABORT)=0
F S DG=$O(^ORD(101.44,"C",DIALOG,DG)) Q:'+DG D
. S USR=$P($G(^ORD(101.44,DG,0)),U,1)
. I $P(USR," ",1)="ORWDQ" D
. . S USR=$P(USR," ",2)
. . I $E(USR,1,3)="USR" D
. . . S USR=$E(USR,4,999)
. . . I USR'=ORUSER D
. . . . S NAME=$P($G(^VA(200,USR,0)),U,1)
. . . . S OTHERS(NAME)=""
I $D(OTHERS) D
. S OTHERS($P($G(^VA(200,ORUSER,0)),U,1))=""
. W !,$C(7),!,!
. W " *********************",!
. W " ***** WARNING *****",!
. W " *********************",!,!
. W " Multiple users share this personal quick order.",!
. W " Modifying this personal quick order will change",!
. W " it for all of the following users:",!,!
. S NAME="",COUNT=7
. F S NAME=$O(OTHERS(NAME)) Q:NAME="" D Q:ABORT
. . S COUNT=COUNT+1
. . I COUNT>20 D Q:ABORT
. . . S COUNT=0,TEMP=""
. . . W !
. . . R " Press <RETURN> to continue, '^' to exit: ",TEMP:$G(DTIME,300)
. . . E S ABORT=1
. . . W $C(13),$J("",50),$C(13) Q:ABORT
. . . I (TEMP[U)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S ABORT=1
. . W " ",NAME,!
. I 'ABORT D
. . S DIR("A")="Are you sure you want to edit this personal quick order? "
. . S DIR(0)="YA",DIR("B")="NO" W ! D ^DIR
. . W !
. . I '+Y S ABORT=1
Q ABORT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCMEDT7 7753 printed Sep 23, 2025@20:04:59 Page 2
ORCMEDT7 ;SLC/JM-QO,Edit Quick Orders By User ;2/1/06
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**245**;Dec 17, 1997;Build 2
+2 QUIT
QCKBYUSR ; Edit quick orders by user
+1 NEW ORDGINFO,ORTEXT,ORIEN,ORFMDATA,ORUSER,ORDG,ORLINE0
+2 KILL ^TMP("ORWDQUSR",$JOB)
+3 SET ORUSER=0
+4 FOR
SET ORDGINFO=$$QCKUSRDG(ORUSER)
if ORDGINFO=0
QUIT
if ORDGINFO<0
SET ORUSER=0
IF +ORDGINFO>0
IF $DATA(^ORD(101.41,+ORDGINFO,0))
Begin DoDot:1
+5 SET ORIEN=$PIECE(ORDGINFO,U,1)
+6 SET ORFMDATA=$PIECE(ORDGINFO,U,2)
+7 SET ORUSER=$PIECE(ORDGINFO,U,3)
+8 SET ORLINE0=$GET(^ORD(101.41,ORIEN,0))
+9 SET ORTEXT=$PIECE(ORLINE0,U,2)
+10 SET ORDG=+$PIECE(ORLINE0,U,5)
+11 ; edit quick order
DO QCK0^ORCMEDT1(ORIEN)
+12 DO VERIFYDA(.ORFMDATA,ORIEN)
+13 IF +ORFMDATA
Begin DoDot:2
+14 ; If quick order not deleted, and display text changes, change 101.44 display text to match
+15 IF $DATA(^ORD(101.41,ORIEN,0))
IF ORTEXT'=$PIECE(^ORD(101.41,ORIEN,0),U,2)
Begin DoDot:3
+16 NEW DIE,DA,DR,DIDEL
+17 SET DA(1)=$PIECE(ORFMDATA,";",1)
+18 SET DIE="^ORD(101.44,"_DA(1)_",10,"
+19 SET DA=$PIECE(ORFMDATA,";",2)
+20 ; 101.44 Display text holds 132 chars, 101.41 only 80. so this is ok
+21 SET DR="2///"_$PIECE(^ORD(101.41,ORIEN,0),U,2)
+22 DO ^DIE
End DoDot:3
End DoDot:2
+23 ; Force reload of user Quick Order info
KILL ^TMP("ORWDQUSR",$JOB,"A",ORUSER)
+24 WRITE !
End DoDot:1
+25 KILL ^TMP("ORWDQUSR",$JOB)
+26 QUIT
QCKUSRDG(ORLSTUSR) ; Get quick order dialog by user
+1 NEW DIC,DIR,DA,X,Y,ORIDX,ORUSER,ORLEN,ORPRE,ORDIALOG,ORHEADER,ORGROUP,ORCOUNT,USERNAME
+2 NEW DTOUT,DUOUT,DIROUT,DIRUT,OREXIT,ORINPUT,ORDGNAME,ORDGIEN,ORLASTGP,ORFMDATA,ORFIRST
+3 SET ORDIALOG=0
+4 SET ORUSER=$$GETUSER(ORLSTUSR)
+5 IF ORUSER>0
Begin DoDot:1
+6 SET ORPRE="ORWDQ USR"_ORUSER
SET ORLEN=$LENGTH(ORPRE)
+7 SET ORIDX=$ORDER(^ORD(101.44,"B",ORPRE))
+8 IF $EXTRACT(ORIDX,1,ORLEN)=ORPRE
Begin DoDot:2
+9 DO QULIST(ORUSER)
+10 SET USERNAME=$PIECE($GET(^VA(200,ORUSER,0)),U,1)
+11 SET ORHEADER=USERNAME_" personal quick orders:"
+12 SET ORCOUNT=0
SET ORIDX=0
SET OREXIT=0
SET ORLASTGP=U
SET ORFIRST=1
+13 FOR
SET ORIDX=$ORDER(^TMP("ORWDQUSR",$JOB,"A",ORUSER,ORIDX))
if '+ORIDX
QUIT
Begin DoDot:3
+14 SET ORCOUNT=ORCOUNT+1
+15 IF ORCOUNT=1
Begin DoDot:4
+16 IF ORFIRST
SET ORFIRST=0
WRITE !,!
+17 WRITE !,ORHEADER,!
End DoDot:4
+18 SET ORGROUP=$ORDER(^TMP("ORWDQUSR",$JOB,"A",ORUSER,ORIDX,""))
+19 SET ORDGIEN=$ORDER(^TMP("ORWDQUSR",$JOB,"A",ORUSER,ORIDX,ORGROUP,""))
+20 SET ORFMDATA=$ORDER(^TMP("ORWDQUSR",$JOB,"A",ORUSER,ORIDX,ORGROUP,ORDGIEN,""))
+21 SET ORDGNAME=$GET(^TMP("ORWDQUSR",$JOB,"A",ORUSER,ORIDX,ORGROUP,ORDGIEN,ORFMDATA))
+22 IF (ORCOUNT=1)!(ORGROUP'=ORLASTGP)
Begin DoDot:4
+23 SET ORLASTGP=ORGROUP
+24 SET ORCOUNT=ORCOUNT+1
+25 WRITE ?4,ORGROUP,!
End DoDot:4
+26 WRITE ?7,ORIDX,?12,ORDGNAME,!
+27 IF ORCOUNT'<18
Begin DoDot:4
+28 SET DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, OR"
+29 SET ORDIALOG=$$QUIDX()
+30 SET ORCOUNT=0
End DoDot:4
End DoDot:3
if +OREXIT!(ORDIALOG>0)
QUIT
+31 IF ORDIALOG'>0
IF '+OREXIT
Begin DoDot:3
+32 SET ORIDX=$ORDER(^TMP("ORWDQUSR",$JOB,"A",ORUSER,999999),-1)
+33 IF ORIDX<1
Begin DoDot:4
+34 ; If user had quick orders, but doesn't any more, there will be false positives in "B" xref
+35 DO QULIST(0)
+36 KILL ^TMP("ORWDQUSR",$JOB,"B",USERNAME)
+37 DO SHOWUSRS
End DoDot:4
IF 1
+38 IF '$TEST
Begin DoDot:4
+39 SET DIR("A",1)=""
+40 SET ORDIALOG=$$QUIDX()
End DoDot:4
End DoDot:3
End DoDot:2
IF 1
+41 IF '$TEST
DO SHOWUSRS
End DoDot:1
+42 QUIT ORDIALOG
GETUSER(ORUSER) ;
+1 IF +ORUSER
QUIT ORUSER
+2 NEW DIC,Y,X,DLAYGO,DINUM
+3 SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
+4 DO ^DIC
+5 QUIT +Y
SHOWUSRS ;
+1 ; Repeats loop
SET ORDIALOG=-1
+2 WRITE !,!,$PIECE($GET(^VA(200,ORUSER,0)),U,1)_" does not have any personal quick orders."
+3 SET DIR("A")="Would you like to see a list of users with personal quick orders"
+4 SET DIR(0)="Y"
SET DIR("B")="YES"
+5 DO ^DIR
+6 IF +Y
Begin DoDot:1
+7 WRITE !,!," Choose from:",!
+8 DO QULIST(0)
+9 SET ORUSER=""
SET ORIDX=2
SET OREXIT=0
+10 FOR
SET ORUSER=$ORDER(^TMP("ORWDQUSR",$JOB,"B",ORUSER))
if OREXIT!(ORUSER="")
QUIT
Begin DoDot:2
+11 WRITE " ",ORUSER,!
+12 SET ORIDX=ORIDX+1
+13 IF ORIDX=22
Begin DoDot:3
+14 SET ORIDX=0
+15 READ " '^' TO STOP: ",ORINPUT:$GET(DTIME,300)
+16 IF '$TEST
SET OREXIT=1
+17 WRITE $CHAR(13),$JUSTIFY("",20),$CHAR(13)
if OREXIT
QUIT
+18 IF ORINPUT[U
SET OREXIT=1
End DoDot:3
End DoDot:2
if OREXIT
QUIT
End DoDot:1
IF 1
+19 IF '$TEST
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET ORDIALOG=0
+20 QUIT
QUIDX() ; Get quick order dialog info
+1 NEW ORGROUP,ORDGIEN,ORFMDATA,ORRESULT
+2 SET DIR("A")="CHOOSE 1-"_ORIDX_": "
+3 SET DIR(0)="NOA^1:"_ORIDX
+4 DO ^DIR
+5 IF +Y>0
IF +Y'>ORIDX
Begin DoDot:1
+6 SET ORGROUP=$ORDER(^TMP("ORWDQUSR",$JOB,"A",ORUSER,+Y,""))
+7 SET ORDGIEN=$ORDER(^TMP("ORWDQUSR",$JOB,"A",ORUSER,+Y,ORGROUP,""))
+8 IF $$CONFLICT(ORUSER,ORDGIEN)
SET OREXIT=1
SET ORRESULT=-1
QUIT
+9 SET ORFMDATA=$ORDER(^TMP("ORWDQUSR",$JOB,"A",ORUSER,+Y,ORGROUP,ORDGIEN,""))
+10 SET ORRESULT=ORDGIEN_U_ORFMDATA_U_ORUSER
End DoDot:1
QUIT ORRESULT
+11 WRITE !
+12 IF Y[U
SET OREXIT=1
+13 ; -1 Value repeats the enter name loop / 0 exits loop
QUIT -1
QULIST(ORUSER) ; Build user info
+1 NEW PRE,ID,LEN
+2 SET PRE="ORWDQ USR"
+3 IF ORUSER=0
Begin DoDot:1
+4 ; "B" node is list of all users with Quick Orders
+5 IF $DATA(^TMP("ORWDQUSR",$JOB,"B"))
QUIT
+6 NEW LASTUSER,USERNAME,USER
+7 SET LASTUSER=0
SET ID=PRE
SET LEN=$LENGTH(PRE)
+8 FOR
SET ID=$ORDER(^ORD(101.44,"B",ID))
if ($EXTRACT(ID,1,LEN)'=PRE)
QUIT
Begin DoDot:2
+9 SET USER=$PIECE($EXTRACT(ID,LEN+1,999)," ")
+10 IF USER'=LASTUSER
Begin DoDot:3
+11 SET LASTUSER=USER
+12 SET USERNAME=$PIECE($GET(^VA(200,USER,0)),U,1)
+13 SET ^TMP("ORWDQUSR",$JOB,"B",USERNAME)=""
End DoDot:3
End DoDot:2
+14 QUIT
End DoDot:1
QUIT
+15 ;
+16 ; "A" node is list of quick orders for an individual user
+17 ; Temp array nodes are "ORWDQUSR",$J,"A"
+18 ; User IEN, Index Number, Display Group, Quick Order IEN, 101.44 IEN
+19 ; Data value is Quick Order Name - (Name can be 132 chars so can't be node)
+20 ;
+21 IF $DATA(^TMP("ORWDQUSR",$JOB,"A",ORUSER))
QUIT
+22 NEW GROUP,IDX,NUMBER,QOINDEX,QCKORDER,ORFMDATA
+23 SET PRE=PRE_ORUSER
SET ID=PRE
SET NUMBER=0
SET LEN=$LENGTH(PRE)
+24 FOR
SET ID=$ORDER(^ORD(101.44,"B",ID))
if ($EXTRACT(ID,1,LEN)'=PRE)
QUIT
Begin DoDot:1
+25 SET GROUP=$PIECE(ID," ",3,999)
+26 SET GROUP=$ORDER(^ORD(100.98,"B",GROUP,0))
+27 IF +GROUP
SET GROUP=$PIECE($GET(^ORD(100.98,GROUP,0)),U,1)
+28 SET IDX=$ORDER(^ORD(101.44,"B",ID,0))
SET QOINDEX=0
+29 FOR
SET QOINDEX=$ORDER(^ORD(101.44,IDX,10,QOINDEX))
if '+QOINDEX
QUIT
Begin DoDot:2
+30 SET QCKORDER=$GET(^ORD(101.44,IDX,10,QOINDEX,0))
+31 IF +QCKORDER
IF +$DATA(^ORD(101.41,+QCKORDER))
Begin DoDot:3
+32 SET NUMBER=NUMBER+1
+33 SET ORFMDATA=IDX_";"_QOINDEX
+34 SET ^TMP("ORWDQUSR",$JOB,"A",ORUSER,NUMBER,GROUP,$PIECE(QCKORDER,U,1),ORFMDATA)=$PIECE(QCKORDER,U,2)
End DoDot:3
End DoDot:2
End DoDot:1
+35 QUIT
VERIFYDA(ORFMDATA,ORIEN) ;
+1 ; Make sure FileMan pointers are still correct
+2 ; - may have changes via CPRS GUI or QCK0^ORCMEDT1(ORIEN)
+3 NEW IDX1,IDX2,IEN
+4 SET IDX1=$PIECE(ORFMDATA,";",1)
+5 SET IDX2=$PIECE(ORFMDATA,";",2)
+6 SET IEN=$PIECE($GET(^ORD(101.44,IDX1,10,IDX2,0)),U,1)
+7 IF IEN=ORIEN
QUIT
+8 SET ORFMDATA=""
+9 SET IDX2=0
+10 FOR
SET IDX2=$ORDER(^ORD(101.44,IDX1,10,IDX2))
if '+IDX2
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^ORD(101.44,IDX1,10,IDX2,0)),U,1)=ORIEN
SET ORFMDATA=IDX1_";"_IDX2
End DoDot:1
if +ORFMDATA
QUIT
+12 QUIT
CONFLICT(ORUSER,DIALOG) ; Determine if another user shares the personal quick order
+1 NEW DG,OTHERS,USR,NAME,ABORT,DIR,Y,DA,X,DTOUT,DUOUT,DIROUT,DIRUT,COUNT,TEMP
+2 SET (DG,ABORT)=0
+3 FOR
SET DG=$ORDER(^ORD(101.44,"C",DIALOG,DG))
if '+DG
QUIT
Begin DoDot:1
+4 SET USR=$PIECE($GET(^ORD(101.44,DG,0)),U,1)
+5 IF $PIECE(USR," ",1)="ORWDQ"
Begin DoDot:2
+6 SET USR=$PIECE(USR," ",2)
+7 IF $EXTRACT(USR,1,3)="USR"
Begin DoDot:3
+8 SET USR=$EXTRACT(USR,4,999)
+9 IF USR'=ORUSER
Begin DoDot:4
+10 SET NAME=$PIECE($GET(^VA(200,USR,0)),U,1)
+11 SET OTHERS(NAME)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 IF $DATA(OTHERS)
Begin DoDot:1
+13 SET OTHERS($PIECE($GET(^VA(200,ORUSER,0)),U,1))=""
+14 WRITE !,$CHAR(7),!,!
+15 WRITE " *********************",!
+16 WRITE " ***** WARNING *****",!
+17 WRITE " *********************",!,!
+18 WRITE " Multiple users share this personal quick order.",!
+19 WRITE " Modifying this personal quick order will change",!
+20 WRITE " it for all of the following users:",!,!
+21 SET NAME=""
SET COUNT=7
+22 FOR
SET NAME=$ORDER(OTHERS(NAME))
if NAME=""
QUIT
Begin DoDot:2
+23 SET COUNT=COUNT+1
+24 IF COUNT>20
Begin DoDot:3
+25 SET COUNT=0
SET TEMP=""
+26 WRITE !
+27 READ " Press <RETURN> to continue, '^' to exit: ",TEMP:$GET(DTIME,300)
+28 IF '$TEST
SET ABORT=1
+29 WRITE $CHAR(13),$JUSTIFY("",50),$CHAR(13)
if ABORT
QUIT
+30 IF (TEMP[U)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET ABORT=1
End DoDot:3
if ABORT
QUIT
+31 WRITE " ",NAME,!
End DoDot:2
if ABORT
QUIT
+32 IF 'ABORT
Begin DoDot:2
+33 SET DIR("A")="Are you sure you want to edit this personal quick order? "
+34 SET DIR(0)="YA"
SET DIR("B")="NO"
WRITE !
DO ^DIR
+35 WRITE !
+36 IF '+Y
SET ABORT=1
End DoDot:2
End DoDot:1
+37 QUIT ABORT
