ORCONV3 ; SLC/MKB - Convert diet orders, UD Order Sets ;6/20/97 11:24
;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
PTR(X) ; -- Returns ptr to 101.41 for prompt OR GTX X
Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0))
;
FH(ORIFN,ORPK) ; -- Called from Dietetics post-init
N ORVP,TYPE,ADM,IFN,ORDIALOG
S ORVP=$P($G(^OR(100,+$G(ORIFN),0)),U,2) Q:'ORVP
S TYPE=$E(ORPK),ADM=+$P(ORPK,";",2),IFN=+$P(ORPK,";",3)
D 1:TYPE="D",2:TYPE="E",3:TYPE="I",4:TYPE="N",7:TYPE="A",8:TYPE="T"
S ^OR(100,ORIFN,4)=ORPK,$P(^(0),U,5)=+ORDIALOG_";ORD(101.41,"
D RESPONSE^ORCSAVE
Q
1 ; -- Diet order
N OI,I,P,X,Y,FH0
S ORDIALOG=+$O(^ORD(101.41,"AB","FHW1",0)) D GETDLG1^ORCD(ORDIALOG)
S OI=$$PTR("ORDERABLE ITEM"),FH0=$G(^FHPT(+ORVP,"A",ADM,"DI",IFN,0))
S I=0 F P=2:1:6 S X=$P(FH0,U,P) Q:'X S Y=$O(^ORD(101.43,"ID",X_";99FHD",0)) S:Y I=I+1,ORDIALOG(OI,I)=Y
S:$P(FH0,U,9) ORDIALOG($$PTR("START DATE/TIME"),1)=$P(FH0,U,9)
S:$P(FH0,U,10) ORDIALOG($$PTR("STOP DATE/TIME"),1)=$P(FH0,U,10)
S:$L($P(FH0,U,8)) ORDIALOG($$PTR("DELIVERY"),1)=$P(FH0,U,8)
S X=$G(^FHPT(+ORVP,"A",ADM,"DI",IFN,1)) S:$L(X) ORDIALOG($$PTR("FREE TEXT 1"),1)=X
Q
2 ; -- Early/late tray
N ORPARAM,FH0,MEAL,TIME,I,X,Y,OI
S ORDIALOG=+$O(^ORD(101.41,"AB","FHW2",0)) D GETDLG1^ORCD(ORDIALOG)
S FH0=$G(^FHPT(+ORVP,"A",ADM,"EL",IFN,0)) D EN^FHWOR8(+ORVP,.ORPARAM)
S MEAL=$P(FH0,U,2),TIME=$P(FH0,U,3)
S I=$S(MEAL="B":1,MEAL="N":7,MEAL="E":13,1:0) I I D ;derive tray
. S X=$P(ORPARAM(1),U,I,I+5),Y=""
. F I=1:1:6 I $P(X,U,I)=TIME S Y=$S(I<4:"EARLY TRAY",1:"LATE TRAY")
. S:$L(Y) OI=+$O(^ORD(101.43,"S.E/L T",Y,0)),ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
S ORDIALOG($$PTR("MEAL"),1)=MEAL,ORDIALOG($$PTR("MEAL TIME"),1)=TIME
S:$L($P(FH0,U,4)) ORDIALOG($$PTR("YES/NO"),1)=($P(FH0,U,4)="Y")
S:$P(FH0,U) ORDIALOG($$PTR("START DATE"),1)=$P($P(FH0,U),".")
;S:$P(FH0,U,?) ORDIALOG($$PTR("STOP DATE"),1)=$P($P(FH0,U,?),".")
;S:$L($P(FH0,U,?)) ORDIALOG($$PTR("SCHEDULE"),1)=$P(FH0,U,?)
Q
3 ; -- Isolation
N OI,FH0 S FH0=$G(^FHPT(+ORVP,"A",ADM,0))
S ORDIALOG=+$O(^ORD(101.41,"AB","FHW3",0)) D GETDLG1^ORCD(ORDIALOG)
S OI=+$O(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0))
S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
S:$P(FH0,U,9) ORDIALOG($$PTR("ISOLATION TYPE"),1)=$P(FH0,U,9)
Q
4 ; -- NPO
S ORDIALOG=+$O(^ORD(101.41,"AB","FHW4",0)) D GETDLG1^ORCD(ORDIALOG)
N OI,FH0,X S FH0=$G(^FHPT(+ORVP,"A",ADM,"DI",IFN,0))
S OI=+$O(^ORD(101.43,"S.DIET","NPO",0))
S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
S:$P(FH0,U,9) ORDIALOG($$PTR("START DATE/TIME"),1)=$P(FH0,U,9)
S:$P(FH0,U,10) ORDIALOG($$PTR("STOP DATE/TIME"),1)=$P(FH0,U,10)
S X=$G(^FHPT(+ORVP,"A",ADM,"DI",IFN,1)) S:$L(X) ORDIALOG($$PTR("FREE TEXT 1"),1)=X
Q
7 ; -- Additional order
N FH0 S FH0=$G(^FHPT(+ORVP,"A",ADM,"OO",IFN,0))
S ORDIALOG=+$O(^ORD(101.41,"AB","FHW7",0)) D GETDLG1^ORCD(ORDIALOG)
S:$L($P(FH0,U,3)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(FH0,U,3)
Q
8 ; -- Tubefeeding
N PROD,OI,I,X,Y,FH0
S ORDIALOG=+$O(^ORD(101.41,"AB","FHW8",0)) D GETDLG1^ORCD(ORDIALOG)
S I=0 F S I=$O(^FHPT(+ORVP,"A",ADM,"TF",IFN,"P",I)) Q:I'>0 S FH0=$G(^(I,0)) D
. S PROD=+$P(FH0,U),OI=+$O(^ORD(101.43,"ID",PROD_";99FHT",0)) Q:'OI
. S ORDIALOG($$PTR("ORDERABLE ITEM"),I)=OI
. S:$P(FH0,U,2) ORDIALOG($$PTR("STRENGTH FH"),I)=$P(FH0,U,2)
. I $L($P(FH0,U,3)) D S ORDIALOG($$PTR("INSTRUCTIONS"),I)=Y
. . S X=$P(FH0,U,3),Y=$P(X,"/") Q:$L(X,"/")'>1 ;done
. . S X=$P(X,"/",2),Y=Y_"/"_$S(X="per Day":"QD",X="per Hour":"QH",X="Twice a Day":"BID",X="Three times a Day":"TID",X="Every 2 Hours":"Q2H",X="Every 3 Hours":"Q3H",X="Every 4 Hours":"Q4H",X="Every 6 Hours":"Q6H",1:"")
S FH0=$G(^FHPT(+ORVP,"A",ADM,"TF",IFN,0))
S:$L($P(FH0,U,5)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(FH0,U,5)
;S:$L($P(FH0,U,?)) ORDIALOG($$PTR("CANCEL FUTURE ORDERS"),1)=$P(FH0,U,?)
Q
;
PSJQOS ; -- Unit Dose Order Sets
N ORSETNM,DEFAULT,ORI,ORDA,DITEM,CNT,NODE1,NODE2,NODE3,OI,ORPKG,ORDG,ORTX
S ORSETNM=$G(^TMP("PSJQOS",$J,"NM")),ORDA=0 Q:'$L(ORSETNM)
S DEFAULT=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0)) Q:'DEFAULT
S ORPKG=$O(^DIC(9.4,"C","PSJ",0)),ORDG=$O(^ORD(100.98,"B","UD RX",0))
S ORI=0 F S ORI=$O(^TMP("PSJQOS",$J,ORI)) Q:ORI'>0 D
. S NODE1=$G(^TMP("PSJQOS",$J,ORI,1)),NODE2=$G(^(2)),NODE3=$G(^(3))
. S OI=+$O(^ORD(101.43,"ID",+NODE1_";99PSP",0)) Q:'OI S ORTX=$P($G(^ORD(101.43,OI,0)),U)
. S DITEM=$$PSJQ(ORTX,ORI) Q:'DITEM
. S ORDA=ORDA+1,ORDA(ORDA)=DITEM,CNT=0
. D SET^ORCONVRT("ORDERABLE ITEM",OI)
. D:NODE3 SET^ORCONVRT("DISPENSE DRUG",+NODE3)
. D:$L($P(NODE1,U,4)) SET^ORCONVRT("INSTRUCTIONS",$P(NODE1,U,4))
. D:$P(NODE1,U,2) SET^ORCONVRT("ROUTE",$P(NODE1,U,2))
. D:$L($P(NODE1,U,3)) SET^ORCONVRT("SCHEDULE",$P(NODE1,U,3))
. I $L(NODE2) K ORTX S ORTX(0)="^^1^"_DT_U,ORTX(1,0)=NODE2 D SET^ORCONVRT("WORD PROCESSING 1","ORTX")
. S:CNT ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
PS1 Q:ORDA'>0 I ORDA=1,$G(ORDA(1)) D Q ; Single quick order only
. N DIE,DA,DR,ORNM S DIE="^ORD(101.41,",ORNM="PSJQOS "_ORSETNM
. S DA=ORDA(1),DR=".01///^S X=ORNM;2///^S X=ORSETNM" D ^DIE
S DITEM=$$PSJQ(ORSETNM) I DITEM D ; Order set
. N I,X F I=1:1:ORDA S X=ORDA(I),^ORD(101.41,DITEM,10,I,0)=I_U_X,^ORD(101.41,DITEM,10,"B",I,I)="",^ORD(101.41,DITEM,10,"D",X,I)="",^ORD(101.41,"AD",X,DITEM,I)=""
. S ^ORD(101.41,DITEM,10,0)="^101.412AI^"_ORDA_U_ORDA
Q
;
PSJQ(NAME,ITM) ; -- Create new PSJQOS dialog
N X,Y,DIC,DLAYGO S:'$L(NAME) NAME=ORSETNM
S DIC="^ORD(101.41,",DIC(0)="LX",DLAYGO=101.41
S X="PSJQOS "_ORSETNM_$S($G(ITM):" "_ITM,1:"") D ^DIC S:Y'>0 Y=0
I $P(Y,U,3) D
. S X=$P(Y,U,2)_U_NAME_"^^"_$S($G(ITM):"Q",1:"O")_U_ORDG_"^2^"_ORPKG
. S ^ORD(101.41,+Y,0)=X,^ORD(101.41,"C",$$UP^XLFSTR(NAME),+Y)=""
. S:ORPKG ^ORD(101.41,"APKG",+ORPKG,+Y)=""
Q +Y
;
COLS ; -- Fix column position
N MENU,ITM,ROW,COL,POS,CW,ORCOL
S MENU=0 F S MENU=$O(^ORD(101.41,MENU)) Q:MENU'>0 I $P(^(MENU,0),U,4)="M" S CW=+$G(^(5)) D
. S:'CW CW=80 K ORCOL D SETCOL(CW) S ITM=0
. F S ITM=$O(^ORD(101.41,MENU,10,ITM)) Q:ITM'>0 S POS=$P(^(ITM,0),U) D
. . K ^ORD(101.41,MENU,10,"B",POS,ITM)
. . S ROW=$P(POS,"."),COL=$P(POS,".",2) S:'COL COL=1 S COL=ORCOL("B",COL)
. . S POS=ROW_"."_COL,$P(^ORD(101.41,MENU,10,ITM,0),U)=POS
. . S ^ORD(101.41,MENU,10,"B",POS,ITM)="" W "."
Q
;
SETCOL(WIDTH) ; -- Set ORCOL(#)=ColPos by WIDTH
N I,X S:'$G(WIDTH) WIDTH=80
F I=1:1 S X=(I-1)*WIDTH+1 Q:X'<240 S ORCOL(I)=X,ORCOL=I,ORCOL("B",X)=I
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCONV3 6454 printed Jan 18, 2025@03:30:03 Page 2
ORCONV3 ; SLC/MKB - Convert diet orders, UD Order Sets ;6/20/97 11:24
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
PTR(X) ; -- Returns ptr to 101.41 for prompt OR GTX X
+1 QUIT +$ORDER(^ORD(101.41,"AB",$EXTRACT("OR GTX "_X,1,63),0))
+2 ;
FH(ORIFN,ORPK) ; -- Called from Dietetics post-init
+1 NEW ORVP,TYPE,ADM,IFN,ORDIALOG
+2 SET ORVP=$PIECE($GET(^OR(100,+$GET(ORIFN),0)),U,2)
if 'ORVP
QUIT
+3 SET TYPE=$EXTRACT(ORPK)
SET ADM=+$PIECE(ORPK,";",2)
SET IFN=+$PIECE(ORPK,";",3)
+4 if TYPE="D"
DO 1
if TYPE="E"
DO 2
if TYPE="I"
DO 3
if TYPE="N"
DO 4
if TYPE="A"
DO 7
if TYPE="T"
DO 8
+5 SET ^OR(100,ORIFN,4)=ORPK
SET $PIECE(^(0),U,5)=+ORDIALOG_";ORD(101.41,"
+6 DO RESPONSE^ORCSAVE
+7 QUIT
1 ; -- Diet order
+1 NEW OI,I,P,X,Y,FH0
+2 SET ORDIALOG=+$ORDER(^ORD(101.41,"AB","FHW1",0))
DO GETDLG1^ORCD(ORDIALOG)
+3 SET OI=$$PTR("ORDERABLE ITEM")
SET FH0=$GET(^FHPT(+ORVP,"A",ADM,"DI",IFN,0))
+4 SET I=0
FOR P=2:1:6
SET X=$PIECE(FH0,U,P)
if 'X
QUIT
SET Y=$ORDER(^ORD(101.43,"ID",X_";99FHD",0))
if Y
SET I=I+1
SET ORDIALOG(OI,I)=Y
+5 if $PIECE(FH0,U,9)
SET ORDIALOG($$PTR("START DATE/TIME"),1)=$PIECE(FH0,U,9)
+6 if $PIECE(FH0,U,10)
SET ORDIALOG($$PTR("STOP DATE/TIME"),1)=$PIECE(FH0,U,10)
+7 if $LENGTH($PIECE(FH0,U,8))
SET ORDIALOG($$PTR("DELIVERY"),1)=$PIECE(FH0,U,8)
+8 SET X=$GET(^FHPT(+ORVP,"A",ADM,"DI",IFN,1))
if $LENGTH(X)
SET ORDIALOG($$PTR("FREE TEXT 1"),1)=X
+9 QUIT
2 ; -- Early/late tray
+1 NEW ORPARAM,FH0,MEAL,TIME,I,X,Y,OI
+2 SET ORDIALOG=+$ORDER(^ORD(101.41,"AB","FHW2",0))
DO GETDLG1^ORCD(ORDIALOG)
+3 SET FH0=$GET(^FHPT(+ORVP,"A",ADM,"EL",IFN,0))
DO EN^FHWOR8(+ORVP,.ORPARAM)
+4 SET MEAL=$PIECE(FH0,U,2)
SET TIME=$PIECE(FH0,U,3)
+5 ;derive tray
SET I=$SELECT(MEAL="B":1,MEAL="N":7,MEAL="E":13,1:0)
IF I
Begin DoDot:1
+6 SET X=$PIECE(ORPARAM(1),U,I,I+5)
SET Y=""
+7 FOR I=1:1:6
IF $PIECE(X,U,I)=TIME
SET Y=$SELECT(I<4:"EARLY TRAY",1:"LATE TRAY")
+8 if $LENGTH(Y)
SET OI=+$ORDER(^ORD(101.43,"S.E/L T",Y,0))
SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
End DoDot:1
+9 SET ORDIALOG($$PTR("MEAL"),1)=MEAL
SET ORDIALOG($$PTR("MEAL TIME"),1)=TIME
+10 if $LENGTH($PIECE(FH0,U,4))
SET ORDIALOG($$PTR("YES/NO"),1)=($PIECE(FH0,U,4)="Y")
+11 if $PIECE(FH0,U)
SET ORDIALOG($$PTR("START DATE"),1)=$PIECE($PIECE(FH0,U),".")
+12 ;S:$P(FH0,U,?) ORDIALOG($$PTR("STOP DATE"),1)=$P($P(FH0,U,?),".")
+13 ;S:$L($P(FH0,U,?)) ORDIALOG($$PTR("SCHEDULE"),1)=$P(FH0,U,?)
+14 QUIT
3 ; -- Isolation
+1 NEW OI,FH0
SET FH0=$GET(^FHPT(+ORVP,"A",ADM,0))
+2 SET ORDIALOG=+$ORDER(^ORD(101.41,"AB","FHW3",0))
DO GETDLG1^ORCD(ORDIALOG)
+3 SET OI=+$ORDER(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0))
+4 SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
+5 if $PIECE(FH0,U,9)
SET ORDIALOG($$PTR("ISOLATION TYPE"),1)=$PIECE(FH0,U,9)
+6 QUIT
4 ; -- NPO
+1 SET ORDIALOG=+$ORDER(^ORD(101.41,"AB","FHW4",0))
DO GETDLG1^ORCD(ORDIALOG)
+2 NEW OI,FH0,X
SET FH0=$GET(^FHPT(+ORVP,"A",ADM,"DI",IFN,0))
+3 SET OI=+$ORDER(^ORD(101.43,"S.DIET","NPO",0))
+4 SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
+5 if $PIECE(FH0,U,9)
SET ORDIALOG($$PTR("START DATE/TIME"),1)=$PIECE(FH0,U,9)
+6 if $PIECE(FH0,U,10)
SET ORDIALOG($$PTR("STOP DATE/TIME"),1)=$PIECE(FH0,U,10)
+7 SET X=$GET(^FHPT(+ORVP,"A",ADM,"DI",IFN,1))
if $LENGTH(X)
SET ORDIALOG($$PTR("FREE TEXT 1"),1)=X
+8 QUIT
7 ; -- Additional order
+1 NEW FH0
SET FH0=$GET(^FHPT(+ORVP,"A",ADM,"OO",IFN,0))
+2 SET ORDIALOG=+$ORDER(^ORD(101.41,"AB","FHW7",0))
DO GETDLG1^ORCD(ORDIALOG)
+3 if $LENGTH($PIECE(FH0,U,3))
SET ORDIALOG($$PTR("FREE TEXT 1"),1)=$PIECE(FH0,U,3)
+4 QUIT
8 ; -- Tubefeeding
+1 NEW PROD,OI,I,X,Y,FH0
+2 SET ORDIALOG=+$ORDER(^ORD(101.41,"AB","FHW8",0))
DO GETDLG1^ORCD(ORDIALOG)
+3 SET I=0
FOR
SET I=$ORDER(^FHPT(+ORVP,"A",ADM,"TF",IFN,"P",I))
if I'>0
QUIT
SET FH0=$GET(^(I,0))
Begin DoDot:1
+4 SET PROD=+$PIECE(FH0,U)
SET OI=+$ORDER(^ORD(101.43,"ID",PROD_";99FHT",0))
if 'OI
QUIT
+5 SET ORDIALOG($$PTR("ORDERABLE ITEM"),I)=OI
+6 if $PIECE(FH0,U,2)
SET ORDIALOG($$PTR("STRENGTH FH"),I)=$PIECE(FH0,U,2)
+7 IF $LENGTH($PIECE(FH0,U,3))
Begin DoDot:2
+8 ;done
SET X=$PIECE(FH0,U,3)
SET Y=$PIECE(X,"/")
if $LENGTH(X,"/")'>1
QUIT
+9 SET X=$PIECE(X,"/",2)
SET Y=Y_"/"_$SELECT(X="per Day":"QD",X="per Hour":"QH",X="Twice a Day":"BID",X="Three times a Day":"TID",X="Every 2 Hours":"Q2H",X="Every 3 Hours":"Q3H",X="Every 4 Hours":"Q4H",X="Every 6 Hours":"Q6H",1:"")
End DoDot:2
SET ORDIALOG($$PTR("INSTRUCTIONS"),I)=Y
End DoDot:1
+10 SET FH0=$GET(^FHPT(+ORVP,"A",ADM,"TF",IFN,0))
+11 if $LENGTH($PIECE(FH0,U,5))
SET ORDIALOG($$PTR("FREE TEXT 1"),1)=$PIECE(FH0,U,5)
+12 ;S:$L($P(FH0,U,?)) ORDIALOG($$PTR("CANCEL FUTURE ORDERS"),1)=$P(FH0,U,?)
+13 QUIT
+14 ;
PSJQOS ; -- Unit Dose Order Sets
+1 NEW ORSETNM,DEFAULT,ORI,ORDA,DITEM,CNT,NODE1,NODE2,NODE3,OI,ORPKG,ORDG,ORTX
+2 SET ORSETNM=$GET(^TMP("PSJQOS",$JOB,"NM"))
SET ORDA=0
if '$LENGTH(ORSETNM)
QUIT
+3 SET DEFAULT=$ORDER(^ORD(101.41,"AB","PSJ OR PAT OE",0))
if 'DEFAULT
QUIT
+4 SET ORPKG=$ORDER(^DIC(9.4,"C","PSJ",0))
SET ORDG=$ORDER(^ORD(100.98,"B","UD RX",0))
+5 SET ORI=0
FOR
SET ORI=$ORDER(^TMP("PSJQOS",$JOB,ORI))
if ORI'>0
QUIT
Begin DoDot:1
+6 SET NODE1=$GET(^TMP("PSJQOS",$JOB,ORI,1))
SET NODE2=$GET(^(2))
SET NODE3=$GET(^(3))
+7 SET OI=+$ORDER(^ORD(101.43,"ID",+NODE1_";99PSP",0))
if 'OI
QUIT
SET ORTX=$PIECE($GET(^ORD(101.43,OI,0)),U)
+8 SET DITEM=$$PSJQ(ORTX,ORI)
if 'DITEM
QUIT
+9 SET ORDA=ORDA+1
SET ORDA(ORDA)=DITEM
SET CNT=0
+10 DO SET^ORCONVRT("ORDERABLE ITEM",OI)
+11 if NODE3
DO SET^ORCONVRT("DISPENSE DRUG",+NODE3)
+12 if $LENGTH($PIECE(NODE1,U,4))
DO SET^ORCONVRT("INSTRUCTIONS",$PIECE(NODE1,U,4))
+13 if $PIECE(NODE1,U,2)
DO SET^ORCONVRT("ROUTE",$PIECE(NODE1,U,2))
+14 if $LENGTH($PIECE(NODE1,U,3))
DO SET^ORCONVRT("SCHEDULE",$PIECE(NODE1,U,3))
+15 IF $LENGTH(NODE2)
KILL ORTX
SET ORTX(0)="^^1^"_DT_U
SET ORTX(1,0)=NODE2
DO SET^ORCONVRT("WORD PROCESSING 1","ORTX")
+16 if CNT
SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
End DoDot:1
PS1 ; Single quick order only
if ORDA'>0
QUIT
IF ORDA=1
IF $GET(ORDA(1))
Begin DoDot:1
+1 NEW DIE,DA,DR,ORNM
SET DIE="^ORD(101.41,"
SET ORNM="PSJQOS "_ORSETNM
+2 SET DA=ORDA(1)
SET DR=".01///^S X=ORNM;2///^S X=ORSETNM"
DO ^DIE
End DoDot:1
QUIT
+3 ; Order set
SET DITEM=$$PSJQ(ORSETNM)
IF DITEM
Begin DoDot:1
+4 NEW I,X
FOR I=1:1:ORDA
SET X=ORDA(I)
SET ^ORD(101.41,DITEM,10,I,0)=I_U_X
SET ^ORD(101.41,DITEM,10,"B",I,I)=""
SET ^ORD(101.41,DITEM,10,"D",X,I)=""
SET ^ORD(101.41,"AD",X,DITEM,I)=""
+5 SET ^ORD(101.41,DITEM,10,0)="^101.412AI^"_ORDA_U_ORDA
End DoDot:1
+6 QUIT
+7 ;
PSJQ(NAME,ITM) ; -- Create new PSJQOS dialog
+1 NEW X,Y,DIC,DLAYGO
if '$LENGTH(NAME)
SET NAME=ORSETNM
+2 SET DIC="^ORD(101.41,"
SET DIC(0)="LX"
SET DLAYGO=101.41
+3 SET X="PSJQOS "_ORSETNM_$SELECT($GET(ITM):" "_ITM,1:"")
DO ^DIC
if Y'>0
SET Y=0
+4 IF $PIECE(Y,U,3)
Begin DoDot:1
+5 SET X=$PIECE(Y,U,2)_U_NAME_"^^"_$SELECT($GET(ITM):"Q",1:"O")_U_ORDG_"^2^"_ORPKG
+6 SET ^ORD(101.41,+Y,0)=X
SET ^ORD(101.41,"C",$$UP^XLFSTR(NAME),+Y)=""
+7 if ORPKG
SET ^ORD(101.41,"APKG",+ORPKG,+Y)=""
End DoDot:1
+8 QUIT +Y
+9 ;
COLS ; -- Fix column position
+1 NEW MENU,ITM,ROW,COL,POS,CW,ORCOL
+2 SET MENU=0
FOR
SET MENU=$ORDER(^ORD(101.41,MENU))
if MENU'>0
QUIT
IF $PIECE(^(MENU,0),U,4)="M"
SET CW=+$GET(^(5))
Begin DoDot:1
+3 if 'CW
SET CW=80
KILL ORCOL
DO SETCOL(CW)
SET ITM=0
+4 FOR
SET ITM=$ORDER(^ORD(101.41,MENU,10,ITM))
if ITM'>0
QUIT
SET POS=$PIECE(^(ITM,0),U)
Begin DoDot:2
+5 KILL ^ORD(101.41,MENU,10,"B",POS,ITM)
+6 SET ROW=$PIECE(POS,".")
SET COL=$PIECE(POS,".",2)
if 'COL
SET COL=1
SET COL=ORCOL("B",COL)
+7 SET POS=ROW_"."_COL
SET $PIECE(^ORD(101.41,MENU,10,ITM,0),U)=POS
+8 SET ^ORD(101.41,MENU,10,"B",POS,ITM)=""
WRITE "."
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
SETCOL(WIDTH) ; -- Set ORCOL(#)=ColPos by WIDTH
+1 NEW I,X
if '$GET(WIDTH)
SET WIDTH=80
+2 FOR I=1:1
SET X=(I-1)*WIDTH+1
if X'<240
QUIT
SET ORCOL(I)=X
SET ORCOL=I
SET ORCOL("B",X)=I
+3 QUIT
