- 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
- 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
