ORCONV1 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97 10:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
EN ; -- process pkg quick order PITEM from $$ITEM
I '$L(NMSP) G UNKPKG^ORCONVRT
G:$L($T(@NMSP)) @NMSP
S NMSP=$E(NMSP,1,4) G:$L($T(@NMSP)) @NMSP
S NMSP=$E(NMSP,1,2) G:$L($T(@NMSP)) @NMSP
G UNKPKG^ORCONVRT
Q
;
OR ; -- Generic text orders
I TYPE'="A" G OR^ORCONV0
Q
;
SR ; -- Surgery
GMRA ; -- Allergies
Q
;
FH ; -- Dietetics
I TYPE'="A" G FH^ORCONV2
Q
;
GMRC ; -- Consults
Q:TYPE="A" N DEFAULT,FLINK,ORDG,OI,X,CNT,CODE,Z,ZZ,PKG
I NAME?1"GMRCT".E D G GMRC1
. S DEFAULT="CONSULT",ORDG=$O(^ORD(100.98,"B","CSLT",0))
. S FLINK=+$P($G(^ORD(101,PITEM,5)),U)_";99CON"
I NAME?1"GMRCR".E D G GMRC1
. S DEFAULT="REQUEST",ORDG=$O(^ORD(100.98,"B","PROC",0))
. S FLINK=PITEM_";99PRO"
G NONSTD^ORCONVRT
GMRC1 S DEFAULT=$O(^ORD(101.41,"AB","GMRCOR "_DEFAULT,0)) G:'DEFAULT NONSTD^ORCONVRT
S OI=$O(^ORD(101.43,"ID",FLINK,0)) G:'OI OI^ORCONVRT
S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
S PKG=$O(^DIC(9.4,"C","GMRC",0))
S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_ORDG_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
K ^ORD(101.41,DITEM,6) S CODE=$G(^ORD(101,PITEM,20))
D SET^ORCONVRT("ORDERABLE ITEM",OI)
S Z=$F(CODE,"GMRCFIO=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D SET^ORCONVRT("CATEGORY",ZZ)
S Z=$F(CODE,"GMRCURGX=") I Z S Z=+$E(CODE,Z,999),ZZ=$P($P($G(^ORD(101,Z,0)),U)," - ",2),ZZ=+$O(^ORD(101.42,"B",ZZ,0)) D:ZZ SET^ORCONVRT("URGENCY",ZZ)
S Z=$F(CODE,"GMRCPLZ=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z),ZZ=$S(ZZ="Bedside":"B",ZZ="Consultant's Choice":"C",ZZ="Emergency Room":"E",1:"") D:$L(ZZ) SET^ORCONVRT("PLACE OF CONSULTATION",ZZ)
S ZZ="" I $O(^ORD(101,PITEM,101.0431,0)) S Z="^ORD(101,"_PITEM_",101.0431)" D SET^ORCONVRT("WORD PROCESSING 1",Z) S:$F(CODE,"GMRCREAF=") ZZ="S GMRCREAF=1"
S:$F(CODE,"GMRCNOPD=") ZZ=ZZ_$S($L(ZZ):",",1:"S ")_"GMRCNOPD=1"
S:$F(CODE,"GMRCNOAT=") ZZ=ZZ_$S($L(ZZ):",",1:"S ")_"GMRCNOAT=1"
S:$L(ZZ) ^ORD(101.41,DITEM,3)=ZZ ; entry action
S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
Q
;
GMRV ; -- Vitals
; default Vitals dialog = GMRVOR
Q:TYPE="A" N DEFAULT,VALUE,OI,TEXT,Z,CODE,START,STOP,SCH,X,CNT,PKG
S TEXT=$P(^ORD(101,PITEM,0),U,2),CODE=$G(^(20)),VALUE="NOW^^"
I NAME?1"GMRVORQ"1.N D Q:'Z ;quick order
. S:$E(TEXT,1,6)="QUICK " TEXT=$E(TEXT,7,999)
. S Z=$F(CODE,"GMRVANSR=") I 'Z D NONSTD^ORCONVRT Q
. S VALUE=$P($E(CODE,Z,999),"""",2)
S Z=$O(^ORD(100.98,"B","V/M",0))_"^V/M",OI=$$ORDITM^ORCONV0(TEXT,Z)
G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
S DEFAULT=+$O(^ORD(101.41,"AB","GMRVOR",0))
S PKG=+$O(^DIC(9.4,"C","GMRV",0))
S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_$P(^ORD(101.41,DEFAULT,0),U,5)_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
S START=$P(VALUE,U),STOP=$P(VALUE,U,2),SCH=$P(VALUE,U,3)
F Z="START","STOP","SCH" I $E(@Z)="~" S @Z=$E(@Z,2,99) ; strip leading ~
K ^ORD(101.41,DITEM,6) D SET^ORCONVRT("ORDERABLE ITEM",OI)
D:$L(START) SET^ORCONVRT("START DATE/TIME",START)
D:$L(STOP) SET^ORCONVRT("STOP DATE/TIME",STOP)
D:$L(SCH) SET^ORCONVRT("SCHEDULE",SCH)
S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
Q
;
LR ; -- Lab
I TYPE'="A" G LR^ORCONV2
Q
;
PS ; -- Pharmacy
Q:TYPE="A" G:NAME'?1"PSJQ".E NONSTD^ORCONVRT K ^TMP("PSJQO",$J)
D EN^PSSQOC(PITEM) G:'$D(^TMP("PSJQO",$J)) UNABLE^ORCONVRT
S TYPE=$P($G(^TMP("PSJQO",$J,1)),U,2)
G IV^ORCONV2:TYPE=1,UD^ORCONV2:TYPE=2
G UNABLE^ORCONVRT ; unable to map OI/Drug/IV rate or volume
Q
;
RA ; -- Radiology
; default Radiology Order dialog = RA OERR EXAM
N DEFAULT,FLINK,CODE,OI,X,Y,Z,ZZ,MODS,DFLT,IMTYPE,INST,ORDG,CNT,PKG
Q:TYPE="A" ; G:NAME'?1"RA"1.N.E NONSTD^ORCONVRT ; not a quick order
S FLINK=+$P($G(^ORD(101,PITEM,5)),U)_";99RAP",CODE=$G(^(20))
S OI=$O(^ORD(101.43,"ID",FLINK,0))
G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
S IMTYPE=$P($G(^ORD(101.43,OI,"RA")),U,3)
S ORDG=$O(^ORD(100.98,"B",IMTYPE,0)) S:'ORDG ORDG=$O(^ORD(100.98,"B","XRAY",0))
S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
S DEFAULT=$O(^ORD(101.41,"AB","RA OERR EXAM",0)),PKG=$O(^DIC(9.4,"C","RA",0))
S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_ORDG_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
K ^ORD(101.41,DITEM,6)
RA1 ; Stuff values for quick order into appropriate prompts
D SET^ORCONVRT("ORDERABLE ITEM",OI)
S Z=$F(CODE,"RAILOC=") I Z S ZZ=+$E(CODE,Z,999) D:ZZ&$D(^RA(79.1,ZZ,0)) SET^ORCONVRT("IMAGING LOCATION",ZZ)
S Z=$F(CODE,"RARU=") I Z S ZZ=+$E(CODE,Z,999) D:ZZ&$D(^ORD(101.42,ZZ,0)) SET^ORCONVRT("URGENCY",ZZ)
S Z=$F(CODE,"RACAT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D:$L(ZZ) SET^ORCONVRT("CATEGORY",ZZ)
S Z=$F(CODE,"RAREQDT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D:$L(ZZ) SET^ORCONVRT("START DATE/TIME",ZZ)
S Z=$F(CODE,"RAMT=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z),ZZ=$$UP^XLFSTR(ZZ) D:$L(ZZ) SET^ORCONVRT("MODE OF TRANSPORT",ZZ)
RA2 ; Skip RAIP - look for generic order instead
G RAQ:CODE'["RAMOD" ; no modifiers
S MODS=CODE,INST=0 F S Z=$F(MODS,"RAMOD(") Q:'Z D
. S MODS=$E(MODS,Z,999),X=+$P(MODS,"=",2)
. I X,$D(^RAMIS(71.2,X,0)) S INST=INST+1 D SET^ORCONVRT("MODIFIERS",X,INST)
RAQ S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
Q
;
DG ; -- Registration
SD ; -- Scheduling
I TYPE'="A",TYPE'="O" Q ; actions or protocols only
N X,PKG S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
S PKG=$P(^ORD(101,PITEM,0),U,12)
S X=^ORD(101.41,DITEM,0),X=X_"^^A^"_$O(^ORD(100.98,"B","M.A.S.",0))_U_U_PKG,^ORD(101.41,DITEM,0)=X
S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
S ^ORD(101.41,DITEM,3)="D SAVE^ORXD"_$S($L($G(^ORD(101,PITEM,20))):" "_^(20),1:"")
S ^ORD(101.41,DITEM,4)=$S($L($G(^ORD(101,PITEM,15))):^(15)_" ",1:"")_"D RSTR^ORXD"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCONV1 6071 printed Oct 16, 2024@18:29:26 Page 2
ORCONV1 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97 10:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
EN ; -- process pkg quick order PITEM from $$ITEM
+1 IF '$LENGTH(NMSP)
GOTO UNKPKG^ORCONVRT
+2 if $LENGTH($TEXT(@NMSP))
GOTO @NMSP
+3 SET NMSP=$EXTRACT(NMSP,1,4)
if $LENGTH($TEXT(@NMSP))
GOTO @NMSP
+4 SET NMSP=$EXTRACT(NMSP,1,2)
if $LENGTH($TEXT(@NMSP))
GOTO @NMSP
+5 GOTO UNKPKG^ORCONVRT
+6 QUIT
+7 ;
OR ; -- Generic text orders
+1 IF TYPE'="A"
GOTO OR^ORCONV0
+2 QUIT
+3 ;
SR ; -- Surgery
GMRA ; -- Allergies
+1 QUIT
+2 ;
FH ; -- Dietetics
+1 IF TYPE'="A"
GOTO FH^ORCONV2
+2 QUIT
+3 ;
GMRC ; -- Consults
+1 if TYPE="A"
QUIT
NEW DEFAULT,FLINK,ORDG,OI,X,CNT,CODE,Z,ZZ,PKG
+2 IF NAME?1"GMRCT".E
Begin DoDot:1
+3 SET DEFAULT="CONSULT"
SET ORDG=$ORDER(^ORD(100.98,"B","CSLT",0))
+4 SET FLINK=+$PIECE($GET(^ORD(101,PITEM,5)),U)_";99CON"
End DoDot:1
GOTO GMRC1
+5 IF NAME?1"GMRCR".E
Begin DoDot:1
+6 SET DEFAULT="REQUEST"
SET ORDG=$ORDER(^ORD(100.98,"B","PROC",0))
+7 SET FLINK=PITEM_";99PRO"
End DoDot:1
GOTO GMRC1
+8 GOTO NONSTD^ORCONVRT
GMRC1 SET DEFAULT=$ORDER(^ORD(101.41,"AB","GMRCOR "_DEFAULT,0))
if 'DEFAULT
GOTO NONSTD^ORCONVRT
+1 SET OI=$ORDER(^ORD(101.43,"ID",FLINK,0))
if 'OI
GOTO OI^ORCONVRT
+2 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
if 'DITEM
GOTO DLG^ORCONVRT
+3 SET PKG=$ORDER(^DIC(9.4,"C","GMRC",0))
+4 SET X=^ORD(101.41,DITEM,0)
SET X=X_"^^Q^"_ORDG_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
SET ^ORD(101.41,DITEM,0)=X
+5 if PKG
SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
+6 KILL ^ORD(101.41,DITEM,6)
SET CODE=$GET(^ORD(101,PITEM,20))
+7 DO SET^ORCONVRT("ORDERABLE ITEM",OI)
+8 SET Z=$FIND(CODE,"GMRCFIO=")
IF Z
SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
DO SET^ORCONVRT("CATEGORY",ZZ)
+9 SET Z=$FIND(CODE,"GMRCURGX=")
IF Z
SET Z=+$EXTRACT(CODE,Z,999)
SET ZZ=$PIECE($PIECE($GET(^ORD(101,Z,0)),U)," - ",2)
SET ZZ=+$ORDER(^ORD(101.42,"B",ZZ,0))
if ZZ
DO SET^ORCONVRT("URGENCY",ZZ)
+10 SET Z=$FIND(CODE,"GMRCPLZ=")
IF Z
SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
SET ZZ=$SELECT(ZZ="Bedside":"B",ZZ="Consultant's Choice":"C",ZZ="Emergency Room":"E",1:"")
if $LENGTH(ZZ)
DO SET^ORCONVRT("PLACE OF CONSULTATION",ZZ)
+11 SET ZZ=""
IF $ORDER(^ORD(101,PITEM,101.0431,0))
SET Z="^ORD(101,"_PITEM_",101.0431)"
DO SET^ORCONVRT("WORD PROCESSING 1",Z)
if $FIND(CODE,"GMRCREAF=")
SET ZZ="S GMRCREAF=1"
+12 if $FIND(CODE,"GMRCNOPD=")
SET ZZ=ZZ_$SELECT($LENGTH(ZZ):",",1:"S ")_"GMRCNOPD=1"
+13 if $FIND(CODE,"GMRCNOAT=")
SET ZZ=ZZ_$SELECT($LENGTH(ZZ):",",1:"S ")_"GMRCNOAT=1"
+14 ; entry action
if $LENGTH(ZZ)
SET ^ORD(101.41,DITEM,3)=ZZ
+15 if $GET(CNT)
SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
+16 QUIT
+17 ;
GMRV ; -- Vitals
+1 ; default Vitals dialog = GMRVOR
+2 if TYPE="A"
QUIT
NEW DEFAULT,VALUE,OI,TEXT,Z,CODE,START,STOP,SCH,X,CNT,PKG
+3 SET TEXT=$PIECE(^ORD(101,PITEM,0),U,2)
SET CODE=$GET(^(20))
SET VALUE="NOW^^"
+4 ;quick order
IF NAME?1"GMRVORQ"1.N
Begin DoDot:1
+5 if $EXTRACT(TEXT,1,6)="QUICK "
SET TEXT=$EXTRACT(TEXT,7,999)
+6 SET Z=$FIND(CODE,"GMRVANSR=")
IF 'Z
DO NONSTD^ORCONVRT
QUIT
+7 SET VALUE=$PIECE($EXTRACT(CODE,Z,999),"""",2)
End DoDot:1
if 'Z
QUIT
+8 SET Z=$ORDER(^ORD(100.98,"B","V/M",0))_"^V/M"
SET OI=$$ORDITM^ORCONV0(TEXT,Z)
+9 if 'OI
GOTO OI^ORCONVRT
if $$INACTIVE^ORCONVRT(OI)
GOTO OI^ORCONVRT
+10 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
if 'DITEM
GOTO DLG^ORCONVRT
+11 SET DEFAULT=+$ORDER(^ORD(101.41,"AB","GMRVOR",0))
+12 SET PKG=+$ORDER(^DIC(9.4,"C","GMRV",0))
+13 SET X=^ORD(101.41,DITEM,0)
SET X=X_"^^Q^"_$PIECE(^ORD(101.41,DEFAULT,0),U,5)_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
SET ^ORD(101.41,DITEM,0)=X
+14 if PKG
SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
+15 SET START=$PIECE(VALUE,U)
SET STOP=$PIECE(VALUE,U,2)
SET SCH=$PIECE(VALUE,U,3)
+16 ; strip leading ~
FOR Z="START","STOP","SCH"
IF $EXTRACT(@Z)="~"
SET @Z=$EXTRACT(@Z,2,99)
+17 KILL ^ORD(101.41,DITEM,6)
DO SET^ORCONVRT("ORDERABLE ITEM",OI)
+18 if $LENGTH(START)
DO SET^ORCONVRT("START DATE/TIME",START)
+19 if $LENGTH(STOP)
DO SET^ORCONVRT("STOP DATE/TIME",STOP)
+20 if $LENGTH(SCH)
DO SET^ORCONVRT("SCHEDULE",SCH)
+21 if $GET(CNT)
SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
+22 QUIT
+23 ;
LR ; -- Lab
+1 IF TYPE'="A"
GOTO LR^ORCONV2
+2 QUIT
+3 ;
PS ; -- Pharmacy
+1 if TYPE="A"
QUIT
if NAME'?1"PSJQ".E
GOTO NONSTD^ORCONVRT
KILL ^TMP("PSJQO",$JOB)
+2 DO EN^PSSQOC(PITEM)
if '$DATA(^TMP("PSJQO",$JOB))
GOTO UNABLE^ORCONVRT
+3 SET TYPE=$PIECE($GET(^TMP("PSJQO",$JOB,1)),U,2)
+4 if TYPE=1
GOTO IV^ORCONV2
if TYPE=2
GOTO UD^ORCONV2
+5 ; unable to map OI/Drug/IV rate or volume
GOTO UNABLE^ORCONVRT
+6 QUIT
+7 ;
RA ; -- Radiology
+1 ; default Radiology Order dialog = RA OERR EXAM
+2 NEW DEFAULT,FLINK,CODE,OI,X,Y,Z,ZZ,MODS,DFLT,IMTYPE,INST,ORDG,CNT,PKG
+3 ; G:NAME'?1"RA"1.N.E NONSTD^ORCONVRT ; not a quick order
if TYPE="A"
QUIT
+4 SET FLINK=+$PIECE($GET(^ORD(101,PITEM,5)),U)_";99RAP"
SET CODE=$GET(^(20))
+5 SET OI=$ORDER(^ORD(101.43,"ID",FLINK,0))
+6 if 'OI
GOTO OI^ORCONVRT
if $$INACTIVE^ORCONVRT(OI)
GOTO OI^ORCONVRT
+7 SET IMTYPE=$PIECE($GET(^ORD(101.43,OI,"RA")),U,3)
+8 SET ORDG=$ORDER(^ORD(100.98,"B",IMTYPE,0))
if 'ORDG
SET ORDG=$ORDER(^ORD(100.98,"B","XRAY",0))
+9 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
if 'DITEM
GOTO DLG^ORCONVRT
+10 SET DEFAULT=$ORDER(^ORD(101.41,"AB","RA OERR EXAM",0))
SET PKG=$ORDER(^DIC(9.4,"C","RA",0))
+11 SET X=^ORD(101.41,DITEM,0)
SET X=X_"^^Q^"_ORDG_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
SET ^ORD(101.41,DITEM,0)=X
+12 if PKG
SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
+13 KILL ^ORD(101.41,DITEM,6)
RA1 ; Stuff values for quick order into appropriate prompts
+1 DO SET^ORCONVRT("ORDERABLE ITEM",OI)
+2 SET Z=$FIND(CODE,"RAILOC=")
IF Z
SET ZZ=+$EXTRACT(CODE,Z,999)
if ZZ&$DATA(^RA(79.1,ZZ,0))
DO SET^ORCONVRT("IMAGING LOCATION",ZZ)
+3 SET Z=$FIND(CODE,"RARU=")
IF Z
SET ZZ=+$EXTRACT(CODE,Z,999)
if ZZ&$DATA(^ORD(101.42,ZZ,0))
DO SET^ORCONVRT("URGENCY",ZZ)
+4 SET Z=$FIND(CODE,"RACAT=")
IF Z
SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
if $LENGTH(ZZ)
DO SET^ORCONVRT("CATEGORY",ZZ)
+5 SET Z=$FIND(CODE,"RAREQDT=")
IF Z
SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
if $LENGTH(ZZ)
DO SET^ORCONVRT("START DATE/TIME",ZZ)
+6 SET Z=$FIND(CODE,"RAMT=")
IF Z
SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
SET ZZ=$$UP^XLFSTR(ZZ)
if $LENGTH(ZZ)
DO SET^ORCONVRT("MODE OF TRANSPORT",ZZ)
RA2 ; Skip RAIP - look for generic order instead
+1 ; no modifiers
if CODE'["RAMOD"
GOTO RAQ
+2 SET MODS=CODE
SET INST=0
FOR
SET Z=$FIND(MODS,"RAMOD(")
if 'Z
QUIT
Begin DoDot:1
+3 SET MODS=$EXTRACT(MODS,Z,999)
SET X=+$PIECE(MODS,"=",2)
+4 IF X
IF $DATA(^RAMIS(71.2,X,0))
SET INST=INST+1
DO SET^ORCONVRT("MODIFIERS",X,INST)
End DoDot:1
RAQ if $GET(CNT)
SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
+1 QUIT
+2 ;
DG ; -- Registration
SD ; -- Scheduling
+1 ; actions or protocols only
IF TYPE'="A"
IF TYPE'="O"
QUIT
+2 NEW X,PKG
SET DITEM=$$DIALOG^ORCONVRT(PITEM)
if 'DITEM
GOTO DLG^ORCONVRT
+3 SET PKG=$PIECE(^ORD(101,PITEM,0),U,12)
+4 SET X=^ORD(101.41,DITEM,0)
SET X=X_"^^A^"_$ORDER(^ORD(100.98,"B","M.A.S.",0))_U_U_PKG
SET ^ORD(101.41,DITEM,0)=X
+5 if PKG
SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
+6 SET ^ORD(101.41,DITEM,3)="D SAVE^ORXD"_$SELECT($LENGTH($GET(^ORD(101,PITEM,20))):" "_^(20),1:"")
+7 SET ^ORD(101.41,DITEM,4)=$SELECT($LENGTH($GET(^ORD(101,PITEM,15))):^(15)_" ",1:"")_"D RSTR^ORXD"
+8 QUIT
