ORINQIV.m

ORINQIV ; SLC/AGP - Utility report for Order Dialogs ; 11/18/08

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**301,296**;DEC 17, 1997;Build 19

 ;

 ; DBIA 5133: reading ^PXRMD file #801.41

 ; 

 Q

 ;

ASK(PROMPT,QUEST,HELP) ;

 N DIR,STR,Y

 S STR=QUEST_";S:SKIP THIS QUICK ORDER;Q:QUIT THE CONVERSION UTILITY"

 S DIR("A")=PROMPT

 S DIR(0)="S^"_STR

 S DIR("??")="^D HELP^ORINQIV("_HELP_")"

 D ^DIR

 Q Y

 ;

AWRITE(REF) ;Write all the descendants of the array reference.

 ;REF is the starting array reference, for example A or ^TMP("OR",$J).

 N DONE,IND,LEN,PROOT,ROOT,START,TEMP

 I REF="" Q

 S PROOT=$P(REF,")",1)

 ;Build the root so we can tell when we are done.

 S TEMP=$NA(@REF)

 S ROOT=$P(TEMP,")",1)

 S REF=$Q(@REF)

 I REF'[ROOT Q

 S DONE=0

 F  Q:(REF="")!(DONE)  D

 . S START=$F(REF,ROOT)

 . S LEN=$L(REF)

 . S IND=$E(REF,START,LEN)

 . W !,PROOT_IND,"=",@REF

 . S REF=$Q(@REF)

 . I REF'[ROOT S DONE=1

 Q

 ;

BLDMSG(ARRAY) ;

 N CNT,LC,NAME,PQO,SPACE,SUCCESS,TEMP,TEXT,USER,XMSUB,Y

 W !

 S CNT=1,TEXT(CNT)="Below is a list of personal QO that can be converted to the Infusion format."

 S CNT=CNT+1,TEXT(CNT)="These items should not be converted unless the quick order is remove from"

 S CNT=CNT+1,TEXT(CNT)="the user personal quick order menu."

 S NAME="" F  S NAME=$O(ARRAY(NAME)) Q:NAME=""  D

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)=NAME,CNT=CNT+1,TEXT(CNT)="_"

 .F SPACE=1:1:78 S TEXT(CNT)=TEXT(CNT)_"_"

 .S PQO="" F  S PQO=$O(ARRAY(NAME,PQO)) Q:PQO=""  D

 ..S CNT=CNT+1,TEXT(CNT)=$G(ARRAY(NAME,PQO))

 S CNT=0 F  S CNT=$O(TEXT(CNT)) Q:CNT'>0  W !,TEXT(CNT)

 ;

 S DIR(0)="Y"

 S DIR("A")="Send this information in a mailman message"

 D ^DIR

 I Y'=1 Q

 S XMSUB="List of personal QO that can be converted to Infusion format"

 S TEMP=$$SUBCHK^XMGAPI0(XMSUB,0)

 I $P(TEMP,U)'="" S XMSUB=$E(XMSUB,1,65)

RETRY ;

 D XMZ^XMA2

 I XMZ<1 G RETRY

 S SUCCESS("XMZ")=XMZ

 S SUCCESS("SUB")=XMSUB

 S CNT=0,LC=0 F  S CNT=$O(TEXT(CNT)) Q:CNT'>0  D

 .S LC=LC+1,^XMB(3.9,XMZ,2,LC,0)=TEXT(CNT)

 S ^XMB(3.9,XMZ,2,0)="^3.92^"_LC_"^"_LC_"^"_DT

 S $P(^XMB(3.9,XMZ,0),U,12)="Y"

 D ENT2^XMD

 Q

 ;

EDIT(IEN,PERQOAR) ;

 N ASKADD,CNT,CONF,DA,DIE,DIK,DR,DRPSIVDG,DUR,EXIT,ERR,ERROR,FDA,FDAIEN

 N IVTYPE,LOC,NAME,NODE,OUTPUT,PSIVDG,PSNODE,TERMIN,USER

 S EXIT=0,ERROR=0

 N OI,OINAME,PTR,UPDADD,UPDDSG

 S USER=$$ISPERQO(IEN) I USER>0 D  Q EXIT

 .S NODE=$G(^ORD(101.41,IEN,0))

 .D GETS^DIQ(200,USER_",",".01;9.2","EI","OUTPUT","ERR")

 .I $D(ERR) D AWRITE(ERR) Q

 .S TERMIN=$G(OUTPUT(200,USER_",",9.2,"I"))

 .I TERMIN>0,TERMIN<DT Q

 .S PERQOAR(OUTPUT(200,USER_",",.01,"E"),$P(NODE,U))=$P(NODE,U,2)

 K ^TMP($J,"OR DESC")

 S UPDDSG="N",UPDADD="N"

 S OI=$$GETOI(IEN) I OI="" Q 0

 S OINAME=$P($G(^ORD(101.43,OI,0)),U) I OINAME="" Q 0

 S PSNODE=$G(^ORD(101.43,OI,"PS"))

 S ASKADD=$S($P(PSNODE,U,4)=1:1,1:0)

 S DA=IEN

 D EN^ORORDDSC(IEN,"OR DESC")

 S CNT=0 F  S CNT=$O(^TMP($J,"OR DESC",IEN,CNT)) Q:CNT'>0  D

 .W !,^TMP($J,"OR DESC",IEN,CNT)

 ;

CONVERT ;

 W !!,"Convert the above Quick Order to an Infusion Quick Order?"

 S UPDDSG=$$ASK("Convert?","Y:YES;N:NO",1)

 I UPDDSG="Q"!(UPDDSG=U)!(UPDDSG="^^") S EXIT=1 G EDITX

 I UPDDSG'="Y" G EDITX

IVTYPE ;

 W !!,"Select the IV Type for this Quick Order."

 S IVTYPE=$$ASK("IV TYPE","C:CONTINUOUS;I:INTERMITTENT",2)

 I IVTYPE=U G CONVERT

 I IVTYPE="^^"!(IVTYPE="Q") S EXIT=1 G EDITX

 I IVTYPE="S" G EDITX

 ;

ADDIT ;

 I ASKADD=1 D

 .I $P(PSNODE,U,3)=0 D  Q

 ..S UPDADD="Y"

 ..W !,"Orderable item "_OINAME_"  is not marked as a solution."

 ..W !,"This orderable item will be moved to the additive value."

 .W !!,"Change orderable item "_OINAME_" to an additive?"

 .S UPDADD=$$ASK("Convert to Additive?","Y:YES;N:NO",3)

 .I UPDADD=U G IVTYPE

 .I UPDADD="^^"!(UPDADD="Q") S EXIT=1 G EDITX

 .I UPDADD="S" G EDITX

 ;

CONFIRM ;

 W !!,"Please confirm the selected changes below."

 W !,"If these changes are accepted, the Quick Order will be converted to an"

 W !,"Infusion Quick Order. This Quick Order will not be able to be converted back to"

 W !,"an Inpatient Quick Order."

 W !!,"Convert to Infusion Quick Order: YES"

 W !,"IV TYPE: "_$S(IVTYPE="I":"Intermittent",1:"Continuous")

 I UPDADD="Y" W !,"Change orderable item "_OINAME_" to an additive: YES"

 S CONF=$$ASK("Confirm Changes?","Y:YES;N:NO",4)

 I CONF=U G:ASKADD=1 ADDIT I ASKADD=0 G IVTYPE

 I CONF="^^"!(CONF="Q") S EXIT=1 G EDITX

 I CONF="S"!(CONF="N") G EDITX

 ;

UPDATES ;Do updates

 W !

 S DIE="^ORD(101.41,"

 S PSIVDG=$O(^ORD(100.98,"B","IV MEDICATIONS","")) Q:PSIVDG'>0

 S DR="5///^S X=PSIVDG"

 D ^DIE

 S PTR=$$PTR^ORMBLDPS("IV TYPE") Q:PTR'>0

 S IENS="?+3,"_IEN_","

 S FDA(101.416,IENS,.01)=35

 S FDA(101.416,IENS,.02)=PTR

 S FDA(101.416,IENS,.03)=1

 S FDA(101.416,IENS,1)=IVTYPE

 D UPDATE^DIE("","FDA","FDAIEN","ERR")

 I $D(ERR) D AWRITE("ERR") S ERROR=1

 I UPDADD="Y" D

 .S PTR=$$PTR^ORMBLDPS("ADDITIVE") Q:PTR'>0

 .N FDA,IENS

 .S IENS="?+2,"_IEN_","

 .S FDA(101.416,IENS,.01)=30

 .S FDA(101.416,IENS,.02)=PTR

 .S FDA(101.416,IENS,.03)=1

 .S FDA(101.416,IENS,1)=OI

 .D UPDATE^DIE("","FDA","FDAIEN","ERR")

 .I $D(ERR) D AWRITE("ERR") S ERROR=1

 .I '$D(ERR) W !!,"**CHECK THE STRENGTH ASSOCIATED WITH THE ADDITIVE VALUE IN THE EDITOR." H 1

 .S PTR=$$PTR^ORMBLDPS("ORDERABLE ITEM") Q:PTR'>0

 .S LOC=$O(^ORD(101.41,IEN,6,"D",PTR,"")) Q:LOC'>0

 .S DA(1)=IEN,DA=LOC

 .S DIK="^ORD(101.41,"_DA(1)_",6," D ^DIK

 ;Check for duration

 I IVTYPE="C" D

 .S PTR=$$PTR^ORMBLDPS("SCHEDULE") Q:PTR'>0

 .S LOC=$O(^ORD(101.41,IEN,6,"D",PTR,"")) Q:LOC'>0

 .S DA(1)=IEN,DA=LOC

 .S DIK="^ORD(101.41,"_DA(1)_",6," D ^DIK

 S DUR=$$PTR^ORMBLDPS("DURATION")

 I DUR>0,$D(^ORD(101.41,IEN,6,"D",DUR))>0 D

 .W !!,"**CHECK THE LIMITATION VALUE ASSIGNED TO THE QUICK ORDER IN THE EDITOR." H 1

 I ERROR=1 W !,"Due to the errors in conversion please valiate the quick order in the editor."

 ;

 ;Call the QO editor

 W !

 D QCK0^ORCMEDT1(IEN)

EDITX ;

 K ^TMP($J,"OR DESC")

 Q EXIT

 ;

EN ;

 K ^TMP($J,"OR REMMDLG")

 N DIR,DSGPAR,DSGRP,EXIT,NANSC,ODIEN,PERQOAR,QOIEN,Y

 ;

 D HELP(6)

 ;Build a list of Display Groups that contains the default dialog of

 ;PSJ OR PAT OE

 S ODIEN=$O(^ORD(101.41,"AB","PSJ OR PAT OE","")) Q:ODIEN=""

 S DSGRP=0 F  S DSGRP=$O(^ORD(100.98,DSGRP)) Q:DSGRP'>0  D

 .I $P(^ORD(100.98,DSGRP,0),U,4)=ODIEN S DSGPAR(DSGRP)=""

 ;

 S DIR(0)="S^A:QO ASSIGNED TO ORDER MENUS, ORDER SETS, OR REMINDER DIALOGS;N:QO NOT ASSIGNED TO ANY OF THESE ITEMS;S:SPECIFIC QUICK ORDER;Q:QUIT THE CONVERSION UTILITY"

 S DIR("A")="Which QO to convert?"

 S DIR("??")="^D HELP^ORINQIV(5)"

 D ^DIR

 I Y=U!(Y="^^")!(Y="Q") Q

 I Y="S" D IND^ORINQIV(.DSGPAR) Q

 S NANSC=Y

 I NANSC="A" D FQOIRDLG

 ;

 S OIIEN=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM","")) Q:OIIEN'>0

 S EXIT=0

 S QOIEN=0 F  S QOIEN=$O(^ORD(101.41,QOIEN)) Q:QOIEN'>0!(EXIT=1)  D

 .I $$ISVALID(QOIEN,NANSC,.DSGPAR)=0 Q

 .S EXIT=$$EDIT(QOIEN,.PERQOAR)

UTLEXIT ;

 I $D(PERQOAR) D BLDMSG(.PERQOAR)

 K ^TMP($J,"OR REMDLG")

 Q

 ;

GETOI(IEN) ;

 N OIIEN,OROI,POS

 N OIIEN,OROI,POS

 S OIIEN=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM","")) Q:OIIEN'>0 ""

 S POS=$O(^ORD(101.41,IEN,6,"D",OIIEN,"")) Q:POS'>0 ""

 S OROI=+$G(^ORD(101.41,IEN,6,POS,1)) Q:OROI'>0 ""

 Q OROI

 ;

FQOIRDLG ;

 N AFIND,DIEN,PTEXT,TYPE

 F TYPE="G","E" S DIEN="" D

 . F  S DIEN=$O(^PXRMD(801.41,"TYPE",TYPE,DIEN)) Q:DIEN'>0  D  ;DBIA 5133

 .. ; PTEXT is 'FINDING ITEM' where 101.41 refers to ^ORD(101.41)

 .. S PTEXT=$P($G(^PXRMD(801.41,DIEN,1)),U,5),AFIND=""

 .. I PTEXT[101.41 S ^TMP($J,"OR REMDLG",$P(PTEXT,";"))=DIEN

 .. F  S AFIND=$O(^PXRMD(801.41,DIEN,3,"B",AFIND)) Q:AFIND=""  D

 ... I AFIND[101.41 S ^TMP($J,"OR REMDLG",$P(AFIND,";"))=DIEN

 Q

 ;

IND(DSGPAR) ;

 N DIC,DIR,EXIT,PERQOAR

 S DIC="^ORD(101.41,",DIC(0)="AEMQZ"

 S DIC("S")="I $$ISVALID^ORINQIV(Y,""S"",.DSGPAR)=1"

 D ^DIC

 I +$P(Y,U)'>0 Q

 S EXIT=$$EDIT($P(Y,U),.PERQOAR)

 I EXIT=1 Q

 W !

 S DIR(0)="Y"

 S DIR("A")="Convert another Quick Order?"

 D ^DIR

 I Y=1 D IND(.DSGPAR)

 I $D(PERQOAR) D BLDMSG(.PERQOAR)

 Q

 ;

ISCONT(IEN) ;

 ;This is use to determine if the Entry from file 101.41 is used in an

 ;another entry from file 101.41 or in a reminder dialog.

 I $O(^ORD(101.41,"AD",IEN,0)) Q 1

 I $D(^TMP($J,"OR REMDLG",IEN))>0 Q 1

 Q 0

 ;

ISIV(IEN) ;

 ;This is use to determine if orderable item is marked as a solution or

 ;an additive

 N PSNODE

 S PSNODE=$G(^ORD(101.43,IEN,"PS"))

 I $P(PSNODE,U,3)=1 Q 1

 I $P(PSNODE,U,4)=1 Q 1

 Q 0

 ;

ISPERQO(IEN) ;

 N NUM,RESULT,USER

 I $D(^ORD(101.44,"C",IEN)) D  Q RESULT

 .S NUM=$O(^ORD(101.44,"C",IEN,"")) Q:NUM'>0

 .S USER=$P($G(^ORD(101.44,NUM,0)),U)

 .S USER=$P(USER,"USR",2)

 .S RESULT=+$P(USER," ")

 Q 0

 ;

ISVALID(IEN,NANSC,DSGPAR) ;

 N CONT,NODE,QODSG,PSNODE,RESULT

 S NODE=$G(^ORD(101.41,IEN,0))

 ;Quit if not a quick order

 I $P(NODE,U,4)'="Q" Q 0

 ;Disregard order dialog entry does not contain a valid display group

 S QODSG=$P(NODE,U,5) I QODSG="" Q 1

 I '$D(DSGPAR(QODSG)) Q 0

 ;

 S CONT=$S($O(^ORD(101.41,"AD",IEN,0)):1,$D(^TMP($J,"OR REMDLG",IEN)):1,1:0)

 ;

 ;S CONT=$$ISCONT(IEN)

 I NANSC="A",CONT=0 Q 0

 I NANSC="N",CONT=1 Q 0

 S OROI=$$GETOI(IEN) I OROI="" Q 0

 S PSNODE=$G(^ORD(101.43,OROI,"PS"))

 I $P(PSNODE,U,3)=1 Q 1

 I $P(PSNODE,U,4)=1 Q 1

 Q 0

 ;

HELP(NUM) ;

 N CNT,TAB,TEXT

 S CNT=0,TAB="     "

 I NUM=1 D

 .S CNT=CNT+1,TEXT(CNT)="By selecting YES this quick order will be converted to a Infusion QO."

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)="This quick order will not be able to be converted back to a unit dose quick"

 .S CNT=CNT+1,TEXT(CNT)="order. However, you can edit the specific fields of the Infusion quick order in the"

 .S CNT=CNT+1,TEXT(CNT)="quick order editor."

 I NUM=2 D

 .S CNT=CNT+1,TEXT(CNT)="This value defines the type of Infusion quick order that is being setup."

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)=TAB_"Select INTERMITTENT to set-up a quick order that should be administered at"

 .S CNT=CNT+1,TEXT(CNT)=TAB_"scheduled intervals (Q4H, QDay) or One-Time only, ""over a specified time"

 .S CNT=CNT+1,TEXT(CNT)=TAB_"period"" (e.g. ""Infuse over 30 min."")."

 .S CNT=CNT+1,TEXT(CNT)=TAB_TAB_"An example is an a IVP/IVPB order."

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)=TAB_"Select CONTINUOUS to set-up a quick order that run at a specified ""Rate"""

 .S CNT=CNT+1,TEXT(CNT)=TAB_"(_ml/hr, _mcg/kg/min, etc)"

 .S CNT=CNT+1,TEXT(CNT)=TAB_TAB_"An example is an a Infusion/drip quick order."

 I NUM=3 D

 .S CNT=CNT+1,TEXT(CNT)="Select Yes to switch the orderable item from the solution to the additive value in the quick order."

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)="Select No to leave the orderable item as the solution in the quick order."

 I NUM=4 D

 .S CNT=CNT+1,TEXT(CNT)="Select Yes to convert the quick order to an infusion quick order with the"

 .S CNT=CNT+1,TEXT(CNT)="selected change. When the conversion is complete you will be drop into the"

 .S CNT=CNT+1,TEXT(CNT)="quick order editor to make any changes to the quick order."

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)="Select No to stop the conversion process for this quick order."

 I NUM<5 D

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)="Select SKIP THIS QUICK ORDER to leave the current quick order as an"

 .S CNT=CNT+1,TEXT(CNT)="Inpatient quick order and select another quick order to convert."

 I NUM=5 D

 .S CNT=CNT+1,TEXT(CNT)="Select QO ASSIGNED TO ORDER MENUS, ORDER SETS, OR REMINDER DIALOGS to convert"

 .S CNT=CNT+1,TEXT(CNT)="quick orders that are used in one of the following: Order Menus, Order Sets,"

 .S CNT=CNT+1,TEXT(CNT)="or Reminder Dialogs."

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)="Select QO NOT ASSIGNED TO ANY OF THESE ITEMS to convert quick orders that are"

 .S CNT=CNT+1,TEXT(CNT)="not use in the following: Order Menus, Order Sets, or Reminder Dialogs."

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)="Select SPECIFIC QUICK ORDER to convert an individual quick order."

 I NUM=6 D

 .S CNT=CNT+1,TEXT(CNT)=" "

 .S CNT=CNT+1,TEXT(CNT)="This conversion utility enables users to convert IV quick orders set-up as"

 .S CNT=CNT+1,TEXT(CNT)="Inpatient quick orders to Infusion quick orders. For each quick order,"

 .S CNT=CNT+1,TEXT(CNT)="the conversion utility asks a series of questions to populate the minimum"

 .S CNT=CNT+1,TEXT(CNT)="prompts needed to convert the quick order. Once the conversion is"

 .S CNT=CNT+1,TEXT(CNT)="done, the user is placed into the Infusion quick order editor to add any"

 .S CNT=CNT+1,TEXT(CNT)="values to the additional fields in the Infusion quick order, if needed."

 .S CNT=CNT+1,TEXT(CNT)="Possible conflicts at the time of conversion will be displayed before entering"

 .S CNT=CNT+1,TEXT(CNT)="the editor. An example of a conflict may be that the user should review the"

 .S CNT=CNT+1,TEXT(CNT)="strength associated with the additive in the editor."

 S CNT=CNT+1,TEXT(CNT)=" "

 I NUM<6 S CNT=CNT+1,TEXT(CNT)="Select QUIT THE CONVERSION UTILITY to exit this utility."

 S CNT=0 F  S CNT=$O(TEXT(CNT)) Q:CNT'>0  W !,TEXT(CNT)

 Q

 ;

ORINQIV   ; SLC/AGP - Utility report for Order Dialogs ; 11/18/08

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**301,296**;DEC 17, 1997;Build 19

 +2       ;

 +3       ; DBIA 5133: reading ^PXRMD file #801.41

 +4       ; 

 +5        QUIT 

 +6       ;

ASK(PROMPT,QUEST,HELP) ;

 +1        NEW DIR,STR,Y

 +2        SET STR=QUEST_";S:SKIP THIS QUICK ORDER;Q:QUIT THE CONVERSION UTILITY"

 +3        SET DIR("A")=PROMPT

 +4        SET DIR(0)="S^"_STR

 +5        SET DIR("??")="^D HELP^ORINQIV("_HELP_")"

 +6        DO ^DIR

 +7        QUIT Y

 +8       ;

AWRITE(REF) ;Write all the descendants of the array reference.

 +1       ;REF is the starting array reference, for example A or ^TMP("OR",$J).

 +2        NEW DONE,IND,LEN,PROOT,ROOT,START,TEMP

 +3        IF REF=""

               QUIT 

 +4        SET PROOT=$PIECE(REF,")",1)

 +5       ;Build the root so we can tell when we are done.

 +6        SET TEMP=$NAME(@REF)

 +7        SET ROOT=$PIECE(TEMP,")",1)

 +8        SET REF=$QUERY(@REF)

 +9        IF REF'[ROOT

               QUIT 

 +10       SET DONE=0

 +11       FOR 

               IF (REF="")!(DONE)

                   QUIT 

               Begin DoDot:1

 +12               SET START=$FIND(REF,ROOT)

 +13               SET LEN=$LENGTH(REF)

 +14               SET IND=$EXTRACT(REF,START,LEN)

 +15               WRITE !,PROOT_IND,"=",@REF

 +16               SET REF=$QUERY(@REF)

 +17               IF REF'[ROOT

                       SET DONE=1

               End DoDot:1

 +18       QUIT 

 +19      ;

BLDMSG(ARRAY) ;

 +1        NEW CNT,LC,NAME,PQO,SPACE,SUCCESS,TEMP,TEXT,USER,XMSUB,Y

 +2        WRITE !

 +3        SET CNT=1

           SET TEXT(CNT)="Below is a list of personal QO that can be converted to the Infusion format."

 +4        SET CNT=CNT+1

           SET TEXT(CNT)="These items should not be converted unless the quick order is remove from"

 +5        SET CNT=CNT+1

           SET TEXT(CNT)="the user personal quick order menu."

 +6        SET NAME=""

           FOR 

               SET NAME=$ORDER(ARRAY(NAME))

               IF NAME=""

                   QUIT 

               Begin DoDot:1

 +7                SET CNT=CNT+1

                   SET TEXT(CNT)=" "

 +8                SET CNT=CNT+1

                   SET TEXT(CNT)=NAME

                   SET CNT=CNT+1

                   SET TEXT(CNT)="_"

 +9                FOR SPACE=1:1:78

                       SET TEXT(CNT)=TEXT(CNT)_"_"

 +10               SET PQO=""

                   FOR 

                       SET PQO=$ORDER(ARRAY(NAME,PQO))

                       IF PQO=""

                           QUIT 

                       Begin DoDot:2

 +11                       SET CNT=CNT+1

                           SET TEXT(CNT)=$GET(ARRAY(NAME,PQO))

                       End DoDot:2

               End DoDot:1

 +12       SET CNT=0

           FOR 

               SET CNT=$ORDER(TEXT(CNT))

               IF CNT'>0

                   QUIT 

               WRITE !,TEXT(CNT)

 +13      ;

 +14       SET DIR(0)="Y"

 +15       SET DIR("A")="Send this information in a mailman message"

 +16       DO ^DIR

 +17       IF Y'=1

               QUIT 

 +18       SET XMSUB="List of personal QO that can be converted to Infusion format"

 +19       SET TEMP=$$SUBCHK^XMGAPI0(XMSUB,0)

 +20       IF $PIECE(TEMP,U)'=""

               SET XMSUB=$EXTRACT(XMSUB,1,65)

RETRY     ;

 +1        DO XMZ^XMA2

 +2        IF XMZ<1

               GOTO RETRY

 +3        SET SUCCESS("XMZ")=XMZ

 +4        SET SUCCESS("SUB")=XMSUB

 +5        SET CNT=0

           SET LC=0

           FOR 

               SET CNT=$ORDER(TEXT(CNT))

               IF CNT'>0

                   QUIT 

               Begin DoDot:1

 +6                SET LC=LC+1

                   SET ^XMB(3.9,XMZ,2,LC,0)=TEXT(CNT)

               End DoDot:1

 +7        SET ^XMB(3.9,XMZ,2,0)="^3.92^"_LC_"^"_LC_"^"_DT

 +8        SET $PIECE(^XMB(3.9,XMZ,0),U,12)="Y"

 +9        DO ENT2^XMD

 +10       QUIT 

 +11      ;

EDIT(IEN,PERQOAR) ;

 +1        NEW ASKADD,CNT,CONF,DA,DIE,DIK,DR,DRPSIVDG,DUR,EXIT,ERR,ERROR,FDA,FDAIEN

 +2        NEW IVTYPE,LOC,NAME,NODE,OUTPUT,PSIVDG,PSNODE,TERMIN,USER

 +3        SET EXIT=0

           SET ERROR=0

 +4        NEW OI,OINAME,PTR,UPDADD,UPDDSG

 +5        SET USER=$$ISPERQO(IEN)

           IF USER>0

               Begin DoDot:1

 +6                SET NODE=$GET(^ORD(101.41,IEN,0))

 +7                DO GETS^DIQ(200,USER_",",".01;9.2","EI","OUTPUT","ERR")

 +8                IF $DATA(ERR)

                       DO AWRITE(ERR)

                       QUIT 

 +9                SET TERMIN=$GET(OUTPUT(200,USER_",",9.2,"I"))

 +10               IF TERMIN>0

                       IF TERMIN<DT

                           QUIT 

 +11               SET PERQOAR(OUTPUT(200,USER_",",.01,"E"),$PIECE(NODE,U))=$PIECE(NODE,U,2)

               End DoDot:1

               QUIT EXIT

 +12       KILL ^TMP($JOB,"OR DESC")

 +13       SET UPDDSG="N"

           SET UPDADD="N"

 +14       SET OI=$$GETOI(IEN)

           IF OI=""

               QUIT 0

 +15       SET OINAME=$PIECE($GET(^ORD(101.43,OI,0)),U)

           IF OINAME=""

               QUIT 0

 +16       SET PSNODE=$GET(^ORD(101.43,OI,"PS"))

 +17       SET ASKADD=$SELECT($PIECE(PSNODE,U,4)=1:1,1:0)

 +18       SET DA=IEN

 +19       DO EN^ORORDDSC(IEN,"OR DESC")

 +20       SET CNT=0

           FOR 

               SET CNT=$ORDER(^TMP($JOB,"OR DESC",IEN,CNT))

               IF CNT'>0

                   QUIT 

               Begin DoDot:1

 +21               WRITE !,^TMP($JOB,"OR DESC",IEN,CNT)

               End DoDot:1

 +22      ;

CONVERT   ;

 +1        WRITE !!,"Convert the above Quick Order to an Infusion Quick Order?"

 +2        SET UPDDSG=$$ASK("Convert?","Y:YES;N:NO",1)

 +3        IF UPDDSG="Q"!(UPDDSG=U)!(UPDDSG="^^")

               SET EXIT=1

               GOTO EDITX

 +4        IF UPDDSG'="Y"

               GOTO EDITX

IVTYPE    ;

 +1        WRITE !!,"Select the IV Type for this Quick Order."

 +2        SET IVTYPE=$$ASK("IV TYPE","C:CONTINUOUS;I:INTERMITTENT",2)

 +3        IF IVTYPE=U

               GOTO CONVERT

 +4        IF IVTYPE="^^"!(IVTYPE="Q")

               SET EXIT=1

               GOTO EDITX

 +5        IF IVTYPE="S"

               GOTO EDITX

 +6       ;

ADDIT     ;

 +1        IF ASKADD=1

               Begin DoDot:1

 +2                IF $PIECE(PSNODE,U,3)=0

                       Begin DoDot:2

 +3                        SET UPDADD="Y"

 +4                        WRITE !,"Orderable item "_OINAME_"  is not marked as a solution."

 +5                        WRITE !,"This orderable item will be moved to the additive value."

                       End DoDot:2

                       QUIT 

 +6                WRITE !!,"Change orderable item "_OINAME_" to an additive?"

 +7                SET UPDADD=$$ASK("Convert to Additive?","Y:YES;N:NO",3)

 +8                IF UPDADD=U

                       GOTO IVTYPE

 +9                IF UPDADD="^^"!(UPDADD="Q")

                       SET EXIT=1

                       GOTO EDITX

 +10               IF UPDADD="S"

                       GOTO EDITX

               End DoDot:1

 +11      ;

CONFIRM   ;

 +1        WRITE !!,"Please confirm the selected changes below."

 +2        WRITE !,"If these changes are accepted, the Quick Order will be converted to an"

 +3        WRITE !,"Infusion Quick Order. This Quick Order will not be able to be converted back to"

 +4        WRITE !,"an Inpatient Quick Order."

 +5        WRITE !!,"Convert to Infusion Quick Order: YES"

 +6        WRITE !,"IV TYPE: "_$SELECT(IVTYPE="I":"Intermittent",1:"Continuous")

 +7        IF UPDADD="Y"

               WRITE !,"Change orderable item "_OINAME_" to an additive: YES"

 +8        SET CONF=$$ASK("Confirm Changes?","Y:YES;N:NO",4)

 +9        IF CONF=U

               IF ASKADD=1

                   GOTO ADDIT

               IF ASKADD=0

                   GOTO IVTYPE

 +10       IF CONF="^^"!(CONF="Q")

               SET EXIT=1

               GOTO EDITX

 +11       IF CONF="S"!(CONF="N")

               GOTO EDITX

 +12      ;

UPDATES   ;Do updates

 +1        WRITE !

 +2        SET DIE="^ORD(101.41,"

 +3        SET PSIVDG=$ORDER(^ORD(100.98,"B","IV MEDICATIONS",""))

           IF PSIVDG'>0

               QUIT 

 +4        SET DR="5///^S X=PSIVDG"

 +5        DO ^DIE

 +6        SET PTR=$$PTR^ORMBLDPS("IV TYPE")

           IF PTR'>0

               QUIT 

 +7        SET IENS="?+3,"_IEN_","

 +8        SET FDA(101.416,IENS,.01)=35

 +9        SET FDA(101.416,IENS,.02)=PTR

 +10       SET FDA(101.416,IENS,.03)=1

 +11       SET FDA(101.416,IENS,1)=IVTYPE

 +12       DO UPDATE^DIE("","FDA","FDAIEN","ERR")

 +13       IF $DATA(ERR)

               DO AWRITE("ERR")

               SET ERROR=1

 +14       IF UPDADD="Y"

               Begin DoDot:1

 +15               SET PTR=$$PTR^ORMBLDPS("ADDITIVE")

                   IF PTR'>0

                       QUIT 

 +16               NEW FDA,IENS

 +17               SET IENS="?+2,"_IEN_","

 +18               SET FDA(101.416,IENS,.01)=30

 +19               SET FDA(101.416,IENS,.02)=PTR

 +20               SET FDA(101.416,IENS,.03)=1

 +21               SET FDA(101.416,IENS,1)=OI

 +22               DO UPDATE^DIE("","FDA","FDAIEN","ERR")

 +23               IF $DATA(ERR)

                       DO AWRITE("ERR")

                       SET ERROR=1

 +24               IF '$DATA(ERR)

                       WRITE !!,"**CHECK THE STRENGTH ASSOCIATED WITH THE ADDITIVE VALUE IN THE EDITOR."

                       HANG 1

 +25               SET PTR=$$PTR^ORMBLDPS("ORDERABLE ITEM")

                   IF PTR'>0

                       QUIT 

 +26               SET LOC=$ORDER(^ORD(101.41,IEN,6,"D",PTR,""))

                   IF LOC'>0

                       QUIT 

 +27               SET DA(1)=IEN

                   SET DA=LOC

 +28               SET DIK="^ORD(101.41,"_DA(1)_",6,"

                   DO ^DIK

               End DoDot:1

 +29      ;Check for duration

 +30       IF IVTYPE="C"

               Begin DoDot:1

 +31               SET PTR=$$PTR^ORMBLDPS("SCHEDULE")

                   IF PTR'>0

                       QUIT 

 +32               SET LOC=$ORDER(^ORD(101.41,IEN,6,"D",PTR,""))

                   IF LOC'>0

                       QUIT 

 +33               SET DA(1)=IEN

                   SET DA=LOC

 +34               SET DIK="^ORD(101.41,"_DA(1)_",6,"

                   DO ^DIK

               End DoDot:1

 +35       SET DUR=$$PTR^ORMBLDPS("DURATION")

 +36       IF DUR>0

               IF $DATA(^ORD(101.41,IEN,6,"D",DUR))>0

                   Begin DoDot:1

 +37                   WRITE !!,"**CHECK THE LIMITATION VALUE ASSIGNED TO THE QUICK ORDER IN THE EDITOR."

                       HANG 1

                   End DoDot:1

 +38       IF ERROR=1