Routine: ORCONVRT

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

LAST(USER) ; -- Save last user preference converted

 S ^ORD(100.99,1,200)=USER_U_$S(USER<0:1,1:"")

MENU(PMENU) ; -- Returns dialog ifn for PMENU protocol

 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

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCONVRT   7262     printed  Feb 18, 2025@23:55:27                                                                                                                                                                                                    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       ;

MENU(PMENU) ; -- Returns dialog ifn for PMENU protocol

 +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

ORCONVRT.m