ORCONVRT ; SLC/MKB - Convert protocols/menus to Dialogs ;9/15/97 15:38
;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
EN ; -- Loop thru protocol menus currently in use
Q:$P($G(^ORD(100.99,1,200)),U,2) ; completed
N ORDUZ,ORPMENU,ORDMENU,ORNDNG,ORMNAM
S ORPMENU=$P($G(^ORD(100.99,1,0)),U,9) ; site default menu
I ORPMENU["ORD(101," S ORDMENU=$$MENU(+ORPMENU) D:ORDMENU EN^XPAR("SYS","OR ADD ORDERS MENU",1,"`"_ORDMENU)
S ORDUZ=+$G(^ORD(100.99,1,200)) Q:ORDUZ<0 ; done
F S ORDUZ=$O(^VA(200,ORDUZ)) Q:ORDUZ'>0 D D LAST(ORDUZ)
. S ORPMENU=$P($G(^VA(200,ORDUZ,100.1)),U,2) Q:'ORPMENU ; no menu
. S ORDMENU=$$MENU(ORPMENU) W:IOST?1"C-".E "."
. D:ORDMENU EN^XPAR(ORDUZ_";VA(200,","OR ADD ORDERS MENU",1,"`"_ORDMENU)
D LAST(-1)
; convert defaults if needed
F ORNDNG="CLINICIAN","NURSE","WARD CLERK" D
. S ORMNAM="ORZ ADD MENU "_ORNDNG
. Q:'$O(^ORD(101,"B",ORMNAM,0))!$O(^ORD(101.41,"AB",ORMNAM,0))
. S ORPMENU=$O(^ORD(101,"B",ORMNAM,0)),ORDMENU=$$MENU(+ORPMENU)
D END
Q
;
LAST(USER) ; -- Save last user preference converted
S ^ORD(100.99,1,200)=USER_U_$S(USER<0:1,1:"")
Q
;
N DMENU,XQORM,ORPOS,XUTL,PITEM,DITEM,ROW,COL,POS,NODE0,NODE4,TYPE,FRMT,PITM0,I
S NODE0=$G(^ORD(101,PMENU,0)),NODE4=$G(^(4)),TYPE=$P(NODE0,U,4),DMENU=""
G:'$L(NODE0) MNQ G:'$L($P(NODE0,U)) MNQ ; protocol deleted
S DMENU=$O(^ORD(101.41,"AB",$E($P(NODE0,U),1,63),0))
I DMENU,$P($G(^ORD(100.99,1,101,PMENU,0)),U,2)<0 G MNQ ; done
S DMENU=$$DIALOG(PMENU) I 'DMENU S PITEM=PMENU D DLG G MNQ
S ^ORD(101.41,DMENU,0)=$P(NODE0,U,1,3)_"^M",^(5)=$P(NODE4,U,1,3)
S XQORM=PMENU_";ORD(101," D XREF^XQORM ;force ^XUTL to rebuild
S ORPOS=+$P($G(^ORD(100.99,1,101,PMENU,0)),U,2)
MN1 F S ORPOS=$O(^XUTL("XQORM",XQORM,ORPOS)) Q:ORPOS'>0 D S ^ORD(100.99,1,101,PMENU,0)=PMENU_U_ORPOS
. S XUTL=$G(^XUTL("XQORM",XQORM,ORPOS,0)),PITEM=+$P(XUTL,U,2)
. Q:'PITEM S PITM0=$G(^ORD(101,PITEM,0))
. S ROW=$P(ORPOS,"."),COL=$P(ORPOS,".",2),POS=ROW_"."_COL
. S FRMT=$S($P(XUTL,U,5)="O":1,$P(XUTL,U,5)="H":2,$P(PITM0,U)?1"ORB BLANK LINE".E:1,$P(PITM0,U,4)="T":1,1:""),DITEM="" Q:FRMT&($P(XUTL,U,3)?1." ")
. I FRMT Q:$D(^ORD(101.41,DMENU,10,"B",POS)) ;already added
. I 'FRMT S DITEM=$$ITEM(PITEM) Q:'DITEM Q:$D(^ORD(101.41,"AD",DITEM,DMENU))
. S DA=$$NEXT(DMENU),^ORD(101.41,DMENU,10,DA,0)=POS_U_DITEM_U_$P(XUTL,U,4)_U_$P(XUTL,U,3)_U_FRMT,^ORD(101.41,DMENU,10,"B",POS,DA)=""
. S:DITEM ^ORD(101.41,"AD",DITEM,DMENU,DA)="",^ORD(101.41,DMENU,10,"D",DITEM,DA)=""
S ^ORD(100.99,1,101,PMENU,0)=PMENU_"^-1" ; done
I $L($G(^ORD(101,PMENU,15)))!$L($G(^(20))) D
. Q:$G(^ORD(101,PMENU,15))="K ORSPU"&($G(^(20))="S XQORFLG(""SH"")=1 D EN^OR3")
. D MCODE
MNQ Q DMENU
;
NEXT(MENU,DINUM) ; -- Returns next available item DA
N I,HDR,LAST,TOTAL,DA
S HDR=$G(^ORD(101.41,MENU,10,0)) S:HDR="" HDR="^101.412IA^^"
S LAST=+$P(HDR,U,3),TOTAL=+$P(HDR,U,4)
I $G(DINUM),'$D(^ORD(101.41,MENU,10,DINUM,0)) S I=DINUM
E F I=(LAST+1):1 Q:'$D(^ORD(101.41,MENU,10,I,0))
S DA=I,$P(HDR,U,3,4)=DA_U_(TOTAL+1),^ORD(101.41,MENU,10,0)=HDR
Q DA
;
ITEM(PITEM) ; -- Returns ifn of dialog for PITEM protocol
N DITEM,NAME,NMSP,TYPE
S DITEM=$G(^ORD(101,PITEM,0)),TYPE=$P(DITEM,U,4),NAME=$P(DITEM,U)
I '$L(NAME) S DITEM="" G ITQ ; protocol deleted
I TYPE'?1U D PROTCL S DITEM="" G ITQ ; missing type
S NMSP=$$GET1^DIQ(9.4,+$P(DITEM,U,12)_",",1),DITEM=""
I (TYPE="Q")!(TYPE="M") S DITEM=$$MENU(PITEM) G ITQ ; sub-menu
S DITEM=$O(^ORD(101.41,"AB",$E(NAME,1,63),0)) G:DITEM ITQ ; done
I TYPE="D" D DLG^ORCONV0 G ITQ ; dialog
I TYPE="X" D SET^ORCONV0 G ITQ ; extended action -> order set
I TYPE'="O",TYPE'="L",TYPE'="A" S DITEM="" G ITQ ; not orderable
D EN^ORCONV1 ; pkg quick orders
ITQ Q DITEM
;
INACTIVE(Y) ; -- Returns 1 or 0, if OrdItem is inactive
N IDT S IDT=$G(^ORD(101.43,+Y,.1))
I 'IDT Q 0
I IDT>$$NOW^XLFDT Q 0
Q 1
;
DIALOG(IFN) ; -- Returns ifn of dialog entry for protocol IFN
N X,Y,DIC,DLAYGO,DD,DO,Z,NODE,TEXT
S NODE=$G(^ORD(101,IFN,0)),X=$E($P(NODE,U),1,63) I X="" Q X
S TEXT=$P(NODE,U,2) S:'$L(TEXT) TEXT=X
I TEXT?1"Default Protocol for Rad".E,X?1"RA"1.N.E S TEXT=$$LOWER^VALM1($P(X," ",2,99))
I $P(NODE,U,4)="T" S Z=$P($G(^ORD(101,IFN,101.04)),U,2) S:$L(Z) TEXT=Z_": " ;default prompt
S DIC="^ORD(101.41,",DIC(0)="LX",DLAYGO=101.41 D ^DIC
S Z=$S(Y>0:+Y,1:"")
I Z S ^ORD(101.41,Z,0)=X_U_TEXT,^ORD(101.41,"C",$$UP^XLFSTR(TEXT),Z)="" M ^ORD(101.41,Z,2)=^ORD(101,IFN,1)
Q Z
;
SET(PROMPT,VALUE,INST) ; -- Sets VALUE of PROMPT,INST in DEFAULT dlg into DITEM responses
N P,D,TYPE
S P=$O(^ORD(101.41,"AB",$E("OR GTX "_PROMPT,1,63),0)) Q:'P
S D=$O(^ORD(101.41,DEFAULT,10,"D",+P,0)) Q:'D
S CNT=$G(CNT)+1,^ORD(101.41,DITEM,6,CNT,0)=D_U_P_U_$S($G(INST):INST,1:1)
S:$L(P) ^ORD(101.41,DITEM,6,"D",P,CNT)=""
S TYPE=$P(^ORD(101.41,+P,1),U)
I TYPE'="W" S ^ORD(101.41,DITEM,6,CNT,1)=VALUE
I TYPE="W" M ^ORD(101.41,DITEM,6,CNT,2)=@VALUE
Q
;
VALUE(STR,BEG) ; -- Return value of "var="
N X,Y,I S X=$E(STR,BEG,999),Y=""
S:$E(X)="""" X=$E(X,2,999) ; strip leading "
F I=1:1:$L(X) S Z=$E(X,I) Q:(Z=",")!(Z=" ")!(Z="""") S Y=Y_Z
Q Y
;
ERRORS ; -- Error messages:
UNKPKG S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unknown application protocol." Q
NONSTD S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Non-standard application protocol format." Q
PROTCL S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Missing required data in protocol." Q
UNABLE S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unable to convert quick order." Q
DLG S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unable to create a new entry in Order Dialog file." Q
OI S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_U_$S($G(DITEM):"Incomplete dialog entry - ",1:"")_"Missing or invalid orderable item(s)." Q
PROMPT S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - unable to create or match term to dialog prompt." Q
DUPL S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - duplicate prompt in Items." Q
STRTDT S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - unable to determine 'start date'." Q
MCODE S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - Entry or Exit Action present in menu." Q
;
END ; -- Send bulletin listing conversion problems
N ORTEXT,CNT,IFN,ORERR K ^TMP("ORTEXT",$J)
S (IFN,CNT)=0 F S IFN=$O(^ORD(100.99,1,101,IFN)) Q:IFN'>0 S CNT=CNT+1
S:CNT ^ORD(100.99,1,101,0)="^100.99101P^"_CNT_U_CNT S CNT=0
S IFN=0 F S IFN=$O(^ORD(100.99,1,101.41,IFN)) Q:IFN'>0 S CNT=CNT+1
S:CNT ^ORD(100.99,1,101.41,0)="^100.99141P^"_CNT_U_CNT Q:CNT'>0
S ORTEXT(1)=CNT_" protocols could not be converted."
S ORTEXT(2)="These will be sent to "_$P(^VA(200,DUZ,0),U)_" in a bulletin."
S ORTEXT(3)="Sending bulletin ..." D MES^XPDUTL(.ORTEXT)
S XMB="OR CONVERSION ERRORS",XMDUZ="ORDER ENTRY/RESULTS REPORTING"
S XMY(DUZ)="",XMB(1)=CNT,XMTEXT="^TMP(""ORTEXT"",$J,",(CNT,IFN)=0
F S IFN=$O(^ORD(100.99,1,101.41,IFN)) Q:IFN'>0 S ORERR=$G(^(IFN,0)) D
. S CNT=CNT+1,^TMP("ORTEXT",$J,CNT)=$$LJ^XLFSTR(IFN,15)_$P(^ORD(101,IFN,0),U)
. S CNT=CNT+1,^TMP("ORTEXT",$J,CNT)=$P(ORERR,U,2) ; error msg
. S CNT=CNT+1,^TMP("ORTEXT",$J,CNT)=" " ; blank
D EN^XMB,KILL^XM K ^TMP("ORTEXT",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCONVRT 7262 printed Dec 13, 2024@02:28:53 Page 2
ORCONVRT ; SLC/MKB - Convert protocols/menus to Dialogs ;9/15/97 15:38
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
EN ; -- Loop thru protocol menus currently in use
+1 ; completed
if $PIECE($GET(^ORD(100.99,1,200)),U,2)
QUIT
+2 NEW ORDUZ,ORPMENU,ORDMENU,ORNDNG,ORMNAM
+3 ; site default menu
SET ORPMENU=$PIECE($GET(^ORD(100.99,1,0)),U,9)
+4 IF ORPMENU["ORD(101,"
SET ORDMENU=$$MENU(+ORPMENU)
if ORDMENU
DO EN^XPAR("SYS","OR ADD ORDERS MENU",1,"`"_ORDMENU)
+5 ; done
SET ORDUZ=+$GET(^ORD(100.99,1,200))
if ORDUZ<0
QUIT
+6 FOR
SET ORDUZ=$ORDER(^VA(200,ORDUZ))
if ORDUZ'>0
QUIT
Begin DoDot:1
+7 ; no menu
SET ORPMENU=$PIECE($GET(^VA(200,ORDUZ,100.1)),U,2)
if 'ORPMENU
QUIT
+8 SET ORDMENU=$$MENU(ORPMENU)
if IOST?1"C-".E
WRITE "."
+9 if ORDMENU
DO EN^XPAR(ORDUZ_";VA(200,","OR ADD ORDERS MENU",1,"`"_ORDMENU)
End DoDot:1
DO LAST(ORDUZ)
+10 DO LAST(-1)
+11 ; convert defaults if needed
+12 FOR ORNDNG="CLINICIAN","NURSE","WARD CLERK"
Begin DoDot:1
+13 SET ORMNAM="ORZ ADD MENU "_ORNDNG
+14 if '$ORDER(^ORD(101,"B",ORMNAM,0))!$ORDER(^ORD(101.41,"AB",ORMNAM,0))
QUIT
+15 SET ORPMENU=$ORDER(^ORD(101,"B",ORMNAM,0))
SET ORDMENU=$$MENU(+ORPMENU)
End DoDot:1
+16 DO END
+17 QUIT
+18 ;
LAST(USER) ; -- Save last user preference converted
+1 SET ^ORD(100.99,1,200)=USER_U_$SELECT(USER<0:1,1:"")
+2 QUIT
+3 ;
+1 NEW DMENU,XQORM,ORPOS,XUTL,PITEM,DITEM,ROW,COL,POS,NODE0,NODE4,TYPE,FRMT,PITM0,I
+2 SET NODE0=$GET(^ORD(101,PMENU,0))
SET NODE4=$GET(^(4))
SET TYPE=$PIECE(NODE0,U,4)
SET DMENU=""
+3 ; protocol deleted
if '$LENGTH(NODE0)
GOTO MNQ
if '$LENGTH($PIECE(NODE0,U))
GOTO MNQ
+4 SET DMENU=$ORDER(^ORD(101.41,"AB",$EXTRACT($PIECE(NODE0,U),1,63),0))
+5 ; done
IF DMENU
IF $PIECE($GET(^ORD(100.99,1,101,PMENU,0)),U,2)<0
GOTO MNQ
+6 SET DMENU=$$DIALOG(PMENU)
IF 'DMENU
SET PITEM=PMENU
DO DLG
GOTO MNQ
+7 SET ^ORD(101.41,DMENU,0)=$PIECE(NODE0,U,1,3)_"^M"
SET ^(5)=$PIECE(NODE4,U,1,3)
+8 ;force ^XUTL to rebuild
SET XQORM=PMENU_";ORD(101,"
DO XREF^XQORM
+9 SET ORPOS=+$PIECE($GET(^ORD(100.99,1,101,PMENU,0)),U,2)
MN1 FOR
SET ORPOS=$ORDER(^XUTL("XQORM",XQORM,ORPOS))
if ORPOS'>0
QUIT
Begin DoDot:1
+1 SET XUTL=$GET(^XUTL("XQORM",XQORM,ORPOS,0))
SET PITEM=+$PIECE(XUTL,U,2)
+2 if 'PITEM
QUIT
SET PITM0=$GET(^ORD(101,PITEM,0))
+3 SET ROW=$PIECE(ORPOS,".")
SET COL=$PIECE(ORPOS,".",2)
SET POS=ROW_"."_COL
+4 SET FRMT=$SELECT($PIECE(XUTL,U,5)="O":1,$PIECE(XUTL,U,5)="H":2,$PIECE(PITM0,U)?1"ORB BLANK LINE".E:1,$PIECE(PITM0,U,4)="T":1,1:"")
SET DITEM=""
if FRMT&($PIECE(XUTL,U,3)?1." ")
QUIT
+5 ;already added
IF FRMT
if $DATA(^ORD(101.41,DMENU,10,"B",POS))
QUIT
+6 IF 'FRMT
SET DITEM=$$ITEM(PITEM)
if 'DITEM
QUIT
if $DATA(^ORD(101.41,"AD",DITEM,DMENU))
QUIT
+7 SET DA=$$NEXT(DMENU)
SET ^ORD(101.41,DMENU,10,DA,0)=POS_U_DITEM_U_$PIECE(XUTL,U,4)_U_$PIECE(XUTL,U,3)_U_FRMT
SET ^ORD(101.41,DMENU,10,"B",POS,DA)=""
+8 if DITEM
SET ^ORD(101.41,"AD",DITEM,DMENU,DA)=""
SET ^ORD(101.41,DMENU,10,"D",DITEM,DA)=""
End DoDot:1
SET ^ORD(100.99,1,101,PMENU,0)=PMENU_U_ORPOS
+9 ; done
SET ^ORD(100.99,1,101,PMENU,0)=PMENU_"^-1"
+10 IF $LENGTH($GET(^ORD(101,PMENU,15)))!$LENGTH($GET(^(20)))
Begin DoDot:1
+11 if $GET(^ORD(101,PMENU,15))="K ORSPU"&($GET(^(20))="S XQORFLG(""SH"")=1 D EN^OR3")
QUIT
+12 DO MCODE
End DoDot:1
MNQ QUIT DMENU
+1 ;
NEXT(MENU,DINUM) ; -- Returns next available item DA
+1 NEW I,HDR,LAST,TOTAL,DA
+2 SET HDR=$GET(^ORD(101.41,MENU,10,0))
if HDR=""
SET HDR="^101.412IA^^"
+3 SET LAST=+$PIECE(HDR,U,3)
SET TOTAL=+$PIECE(HDR,U,4)
+4 IF $GET(DINUM)
IF '$DATA(^ORD(101.41,MENU,10,DINUM,0))
SET I=DINUM
+5 IF '$TEST
FOR I=(LAST+1):1
if '$DATA(^ORD(101.41,MENU,10,I,0))
QUIT
+6 SET DA=I
SET $PIECE(HDR,U,3,4)=DA_U_(TOTAL+1)
SET ^ORD(101.41,MENU,10,0)=HDR
+7 QUIT DA
+8 ;
ITEM(PITEM) ; -- Returns ifn of dialog for PITEM protocol
+1 NEW DITEM,NAME,NMSP,TYPE
+2 SET DITEM=$GET(^ORD(101,PITEM,0))
SET TYPE=$PIECE(DITEM,U,4)
SET NAME=$PIECE(DITEM,U)
+3 ; protocol deleted
IF '$LENGTH(NAME)
SET DITEM=""
GOTO ITQ
+4 ; missing type
IF TYPE'?1U
DO PROTCL
SET DITEM=""
GOTO ITQ
+5 SET NMSP=$$GET1^DIQ(9.4,+$PIECE(DITEM,U,12)_",",1)
SET DITEM=""
+6 ; sub-menu
IF (TYPE="Q")!(TYPE="M")
SET DITEM=$$MENU(PITEM)
GOTO ITQ
+7 ; done
SET DITEM=$ORDER(^ORD(101.41,"AB",$EXTRACT(NAME,1,63),0))
if DITEM
GOTO ITQ
+8 ; dialog
IF TYPE="D"
DO DLG^ORCONV0
GOTO ITQ
+9 ; extended action -> order set
IF TYPE="X"
DO SET^ORCONV0
GOTO ITQ
+10 ; not orderable
IF TYPE'="O"
IF TYPE'="L"
IF TYPE'="A"
SET DITEM=""
GOTO ITQ
+11 ; pkg quick orders
DO EN^ORCONV1
ITQ QUIT DITEM
+1 ;
INACTIVE(Y) ; -- Returns 1 or 0, if OrdItem is inactive
+1 NEW IDT
SET IDT=$GET(^ORD(101.43,+Y,.1))
+2 IF 'IDT
QUIT 0
+3 IF IDT>$$NOW^XLFDT
QUIT 0
+4 QUIT 1
+5 ;
DIALOG(IFN) ; -- Returns ifn of dialog entry for protocol IFN
+1 NEW X,Y,DIC,DLAYGO,DD,DO,Z,NODE,TEXT
+2 SET NODE=$GET(^ORD(101,IFN,0))
SET X=$EXTRACT($PIECE(NODE,U),1,63)
IF X=""
QUIT X
+3 SET TEXT=$PIECE(NODE,U,2)
if '$LENGTH(TEXT)
SET TEXT=X
+4 IF TEXT?1"Default Protocol for Rad".E
IF X?1"RA"1.N.E
SET TEXT=$$LOWER^VALM1($PIECE(X," ",2,99))
+5 ;default prompt
IF $PIECE(NODE,U,4)="T"
SET Z=$PIECE($GET(^ORD(101,IFN,101.04)),U,2)
if $LENGTH(Z)
SET TEXT=Z_": "
+6 SET DIC="^ORD(101.41,"
SET DIC(0)="LX"
SET DLAYGO=101.41
DO ^DIC
+7 SET Z=$SELECT(Y>0:+Y,1:"")
+8 IF Z
SET ^ORD(101.41,Z,0)=X_U_TEXT
SET ^ORD(101.41,"C",$$UP^XLFSTR(TEXT),Z)=""
MERGE ^ORD(101.41,Z,2)=^ORD(101,IFN,1)
+9 QUIT Z
+10 ;
SET(PROMPT,VALUE,INST) ; -- Sets VALUE of PROMPT,INST in DEFAULT dlg into DITEM responses
+1 NEW P,D,TYPE
+2 SET P=$ORDER(^ORD(101.41,"AB",$EXTRACT("OR GTX "_PROMPT,1,63),0))
if 'P
QUIT
+3 SET D=$ORDER(^ORD(101.41,DEFAULT,10,"D",+P,0))
if 'D
QUIT
+4 SET CNT=$GET(CNT)+1
SET ^ORD(101.41,DITEM,6,CNT,0)=D_U_P_U_$SELECT($GET(INST):INST,1:1)
+5 if $LENGTH(P)
SET ^ORD(101.41,DITEM,6,"D",P,CNT)=""
+6 SET TYPE=$PIECE(^ORD(101.41,+P,1),U)
+7 IF TYPE'="W"
SET ^ORD(101.41,DITEM,6,CNT,1)=VALUE
+8 IF TYPE="W"
MERGE ^ORD(101.41,DITEM,6,CNT,2)=@VALUE
+9 QUIT
+10 ;
VALUE(STR,BEG) ; -- Return value of "var="
+1 NEW X,Y,I
SET X=$EXTRACT(STR,BEG,999)
SET Y=""
+2 ; strip leading "
if $EXTRACT(X)=""""
SET X=$EXTRACT(X,2,999)
+3 FOR I=1:1:$LENGTH(X)
SET Z=$EXTRACT(X,I)
if (Z=",")!(Z=" ")!(Z="""")
QUIT
SET Y=Y_Z
+4 QUIT Y
+5 ;
ERRORS ; -- Error messages:
UNKPKG SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unknown application protocol."
QUIT
NONSTD SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Non-standard application protocol format."
QUIT
PROTCL SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Missing required data in protocol."
QUIT
UNABLE SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unable to convert quick order."
QUIT
DLG SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unable to create a new entry in Order Dialog file."
QUIT
OI SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_U_$SELECT($GET(DITEM):"Incomplete dialog entry - ",1:"")_"Missing or invalid orderable item(s)."
QUIT
PROMPT SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - unable to create or match term to dialog prompt."
QUIT
DUPL SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - duplicate prompt in Items."
QUIT
STRTDT SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - unable to determine 'start date'."
QUIT
MCODE SET ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - Entry or Exit Action present in menu."
QUIT
+1 ;
END ; -- Send bulletin listing conversion problems
+1 NEW ORTEXT,CNT,IFN,ORERR
KILL ^TMP("ORTEXT",$JOB)
+2 SET (IFN,CNT)=0
FOR
SET IFN=$ORDER(^ORD(100.99,1,101,IFN))
if IFN'>0
QUIT
SET CNT=CNT+1
+3 if CNT
SET ^ORD(100.99,1,101,0)="^100.99101P^"_CNT_U_CNT
SET CNT=0
+4 SET IFN=0
FOR
SET IFN=$ORDER(^ORD(100.99,1,101.41,IFN))
if IFN'>0
QUIT
SET CNT=CNT+1
+5 if CNT
SET ^ORD(100.99,1,101.41,0)="^100.99141P^"_CNT_U_CNT
if CNT'>0
QUIT
+6 SET ORTEXT(1)=CNT_" protocols could not be converted."
+7 SET ORTEXT(2)="These will be sent to "_$PIECE(^VA(200,DUZ,0),U)_" in a bulletin."
+8 SET ORTEXT(3)="Sending bulletin ..."
DO MES^XPDUTL(.ORTEXT)
+9 SET XMB="OR CONVERSION ERRORS"
SET XMDUZ="ORDER ENTRY/RESULTS REPORTING"
+10 SET XMY(DUZ)=""
SET XMB(1)=CNT
SET XMTEXT="^TMP(""ORTEXT"",$J,"
SET (CNT,IFN)=0
+11 FOR
SET IFN=$ORDER(^ORD(100.99,1,101.41,IFN))
if IFN'>0
QUIT
SET ORERR=$GET(^(IFN,0))
Begin DoDot:1
+12 SET CNT=CNT+1
SET ^TMP("ORTEXT",$JOB,CNT)=$$LJ^XLFSTR(IFN,15)_$PIECE(^ORD(101,IFN,0),U)
+13 ; error msg
SET CNT=CNT+1
SET ^TMP("ORTEXT",$JOB,CNT)=$PIECE(ORERR,U,2)
+14 ; blank
SET CNT=CNT+1
SET ^TMP("ORTEXT",$JOB,CNT)=" "
End DoDot:1
+15 DO EN^XMB
DO KILL^XM
KILL ^TMP("ORTEXT",$JOB)
+16 QUIT
