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
WRITE !,"Due to the errors in conversion please valiate the quick order in the editor."
+39 ;
+40 ;Call the QO editor
+41 WRITE !
+42 DO QCK0^ORCMEDT1(IEN)
EDITX ;
+1 KILL ^TMP($JOB,"OR DESC")
+2 QUIT EXIT
+3 ;
EN ;
+1 KILL ^TMP($JOB,"OR REMMDLG")
+2 NEW DIR,DSGPAR,DSGRP,EXIT,NANSC,ODIEN,PERQOAR,QOIEN,Y
+3 ;
+4 DO HELP(6)
+5 ;Build a list of Display Groups that contains the default dialog of
+6 ;PSJ OR PAT OE
+7 SET ODIEN=$ORDER(^ORD(101.41,"AB","PSJ OR PAT OE",""))
IF ODIEN=""
QUIT
+8 SET DSGRP=0
FOR
SET DSGRP=$ORDER(^ORD(100.98,DSGRP))
IF DSGRP'>0
QUIT
Begin DoDot:1
+9 IF $PIECE(^ORD(100.98,DSGRP,0),U,4)=ODIEN
SET DSGPAR(DSGRP)=""
End DoDot:1
+10 ;
+11 SET 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"
+12 SET DIR("A")="Which QO to convert?"
+13 SET DIR("??")="^D HELP^ORINQIV(5)"
+14 DO ^DIR
+15 IF Y=U!(Y="^^")!(Y="Q")
QUIT
+16 IF Y="S"
DO IND^ORINQIV(.DSGPAR)
QUIT
+17 SET NANSC=Y
+18 IF NANSC="A"
DO FQOIRDLG
+19 ;
+20 SET OIIEN=$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",""))
IF OIIEN'>0
QUIT
+21 SET EXIT=0
+22 SET QOIEN=0
FOR
SET QOIEN=$ORDER(^ORD(101.41,QOIEN))
IF QOIEN'>0!(EXIT=1)
QUIT
Begin DoDot:1
+23 IF $$ISVALID(QOIEN,NANSC,.DSGPAR)=0
QUIT
+24 SET EXIT=$$EDIT(QOIEN,.PERQOAR)
End DoDot:1
UTLEXIT ;
+1 IF $DATA(PERQOAR)
DO BLDMSG(.PERQOAR)
+2 KILL ^TMP($JOB,"OR REMDLG")
+3 QUIT
+4 ;
GETOI(IEN) ;
+1 NEW OIIEN,OROI,POS
+2 NEW OIIEN,OROI,POS
+3 SET OIIEN=$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",""))
IF OIIEN'>0
QUIT ""
+4 SET POS=$ORDER(^ORD(101.41,IEN,6,"D",OIIEN,""))
IF POS'>0
QUIT ""
+5 SET OROI=+$GET(^ORD(101.41,IEN,6,POS,1))
IF OROI'>0
QUIT ""
+6 QUIT OROI
+7 ;
FQOIRDLG ;
+1 NEW AFIND,DIEN,PTEXT,TYPE
+2 FOR TYPE="G","E"
SET DIEN=""
Begin DoDot:1
+3 ;DBIA 5133
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"TYPE",TYPE,DIEN))
IF DIEN'>0
QUIT
Begin DoDot:2
+4 ; PTEXT is 'FINDING ITEM' where 101.41 refers to ^ORD(101.41)
+5 SET PTEXT=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
SET AFIND=""
+6 IF PTEXT[101.41
SET ^TMP($JOB,"OR REMDLG",$PIECE(PTEXT,";"))=DIEN
+7 FOR
SET AFIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",AFIND))
IF AFIND=""
QUIT
Begin DoDot:3
+8 IF AFIND[101.41
SET ^TMP($JOB,"OR REMDLG",$PIECE(AFIND,";"))=DIEN
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
IND(DSGPAR) ;
+1 NEW DIC,DIR,EXIT,PERQOAR
+2 SET DIC="^ORD(101.41,"
SET DIC(0)="AEMQZ"
+3 SET DIC("S")="I $$ISVALID^ORINQIV(Y,""S"",.DSGPAR)=1"
+4 DO ^DIC
+5 IF +$PIECE(Y,U)'>0
QUIT
+6 SET EXIT=$$EDIT($PIECE(Y,U),.PERQOAR)
+7 IF EXIT=1
QUIT
+8 WRITE !
+9 SET DIR(0)="Y"
+10 SET DIR("A")="Convert another Quick Order?"
+11 DO ^DIR
+12 IF Y=1
DO IND(.DSGPAR)
+13 IF $DATA(PERQOAR)
DO BLDMSG(.PERQOAR)
+14 QUIT
+15 ;
ISCONT(IEN) ;
+1 ;This is use to determine if the Entry from file 101.41 is used in an
+2 ;another entry from file 101.41 or in a reminder dialog.
+3 IF $ORDER(^ORD(101.41,"AD",IEN,0))
QUIT 1
+4 IF $DATA(^TMP($JOB,"OR REMDLG",IEN))>0
QUIT 1
+5 QUIT 0
+6 ;
ISIV(IEN) ;
+1 ;This is use to determine if orderable item is marked as a solution or
+2 ;an additive
+3 NEW PSNODE
+4 SET PSNODE=$GET(^ORD(101.43,IEN,"PS"))
+5 IF $PIECE(PSNODE,U,3)=1
QUIT 1
+6 IF $PIECE(PSNODE,U,4)=1
QUIT 1
+7 QUIT 0
+8 ;
ISPERQO(IEN) ;
+1 NEW NUM,RESULT,USER
+2 IF $DATA(^ORD(101.44,"C",IEN))
Begin DoDot:1
+3 SET NUM=$ORDER(^ORD(101.44,"C",IEN,""))
IF NUM'>0
QUIT
+4 SET USER=$PIECE($GET(^ORD(101.44,NUM,0)),U)
+5 SET USER=$PIECE(USER,"USR",2)
+6 SET RESULT=+$PIECE(USER," ")
End DoDot:1
QUIT RESULT
+7 QUIT 0
+8 ;
ISVALID(IEN,NANSC,DSGPAR) ;
+1 NEW CONT,NODE,QODSG,PSNODE,RESULT
+2 SET NODE=$GET(^ORD(101.41,IEN,0))
+3 ;Quit if not a quick order
+4 IF $PIECE(NODE,U,4)'="Q"
QUIT 0
+5 ;Disregard order dialog entry does not contain a valid display group
+6 SET QODSG=$PIECE(NODE,U,5)
IF QODSG=""
QUIT 1
+7 IF '$DATA(DSGPAR(QODSG))
QUIT 0
+8 ;
+9 SET CONT=$SELECT($ORDER(^ORD(101.41,"AD",IEN,0)):1,$DATA(^TMP($JOB,"OR REMDLG",IEN)):1,1:0)
+10 ;
+11 ;S CONT=$$ISCONT(IEN)
+12 IF NANSC="A"
IF CONT=0
QUIT 0
+13 IF NANSC="N"
IF CONT=1
QUIT 0
+14 SET OROI=$$GETOI(IEN)
IF OROI=""
QUIT 0
+15 SET PSNODE=$GET(^ORD(101.43,OROI,"PS"))
+16 IF $PIECE(PSNODE,U,3)=1
QUIT 1
+17 IF $PIECE(PSNODE,U,4)=1
QUIT 1
+18 QUIT 0
+19 ;
HELP(NUM) ;
+1 NEW CNT,TAB,TEXT
+2 SET CNT=0
SET TAB=" "
+3 IF NUM=1
Begin DoDot:1
+4 SET CNT=CNT+1
SET TEXT(CNT)="By selecting YES this quick order will be converted to a Infusion QO."
+5 SET CNT=CNT+1
SET TEXT(CNT)=" "
+6 SET CNT=CNT+1
SET TEXT(CNT)="This quick order will not be able to be converted back to a unit dose quick"
+7 SET CNT=CNT+1
SET TEXT(CNT)="order. However, you can edit the specific fields of the Infusion quick order in the"
+8 SET CNT=CNT+1
SET TEXT(CNT)="quick order editor."
End DoDot:1
+9 IF NUM=2
Begin DoDot:1
+10 SET CNT=CNT+1
SET TEXT(CNT)="This value defines the type of Infusion quick order that is being setup."
+11 SET CNT=CNT+1
SET TEXT(CNT)=" "
+12 SET CNT=CNT+1
SET TEXT(CNT)=TAB_"Select INTERMITTENT to set-up a quick order that should be administered at"
+13 SET CNT=CNT+1
SET TEXT(CNT)=TAB_"scheduled intervals (Q4H, QDay) or One-Time only, ""over a specified time"
+14 SET CNT=CNT+1
SET TEXT(CNT)=TAB_"period"" (e.g. ""Infuse over 30 min."")."
+15 SET CNT=CNT+1
SET TEXT(CNT)=TAB_TAB_"An example is an a IVP/IVPB order."
+16 SET CNT=CNT+1
SET TEXT(CNT)=" "
+17 SET CNT=CNT+1
SET TEXT(CNT)=TAB_"Select CONTINUOUS to set-up a quick order that run at a specified ""Rate"""
+18 SET CNT=CNT+1
SET TEXT(CNT)=TAB_"(_ml/hr, _mcg/kg/min, etc)"
+19 SET CNT=CNT+1
SET TEXT(CNT)=TAB_TAB_"An example is an a Infusion/drip quick order."
End DoDot:1
+20 IF NUM=3
Begin DoDot:1
+21 SET CNT=CNT+1
SET TEXT(CNT)="Select Yes to switch the orderable item from the solution to the additive value in the quick order."
+22 SET CNT=CNT+1
SET TEXT(CNT)=" "
+23 SET CNT=CNT+1
SET TEXT(CNT)="Select No to leave the orderable item as the solution in the quick order."
End DoDot:1
+24 IF NUM=4
Begin DoDot:1
+25 SET CNT=CNT+1
SET TEXT(CNT)="Select Yes to convert the quick order to an infusion quick order with the"
+26 SET CNT=CNT+1
SET TEXT(CNT)="selected change. When the conversion is complete you will be drop into the"
+27 SET CNT=CNT+1
SET TEXT(CNT)="quick order editor to make any changes to the quick order."
+28 SET CNT=CNT+1
SET TEXT(CNT)=" "
+29 SET CNT=CNT+1
SET TEXT(CNT)="Select No to stop the conversion process for this quick order."
End DoDot:1
+30 IF NUM<5
Begin DoDot:1
+31 SET CNT=CNT+1
SET TEXT(CNT)=" "
+32 SET CNT=CNT+1
SET TEXT(CNT)="Select SKIP THIS QUICK ORDER to leave the current quick order as an"
+33 SET CNT=CNT+1
SET TEXT(CNT)="Inpatient quick order and select another quick order to convert."
End DoDot:1
+34 IF NUM=5
Begin DoDot:1
+35 SET CNT=CNT+1
SET TEXT(CNT)="Select QO ASSIGNED TO ORDER MENUS, ORDER SETS, OR REMINDER DIALOGS to convert"
+36 SET CNT=CNT+1
SET TEXT(CNT)="quick orders that are used in one of the following: Order Menus, Order Sets,"
+37 SET CNT=CNT+1
SET TEXT(CNT)="or Reminder Dialogs."
+38 SET CNT=CNT+1
SET TEXT(CNT)=" "
+39 SET CNT=CNT+1
SET TEXT(CNT)="Select QO NOT ASSIGNED TO ANY OF THESE ITEMS to convert quick orders that are"
+40 SET CNT=CNT+1
SET TEXT(CNT)="not use in the following: Order Menus, Order Sets, or Reminder Dialogs."
+41 SET CNT=CNT+1
SET TEXT(CNT)=" "
+42 SET CNT=CNT+1
SET TEXT(CNT)="Select SPECIFIC QUICK ORDER to convert an individual quick order."
End DoDot:1
+43 IF NUM=6
Begin DoDot:1
+44 SET CNT=CNT+1
SET TEXT(CNT)=" "
+45 SET CNT=CNT+1
SET TEXT(CNT)="This conversion utility enables users to convert IV quick orders set-up as"
+46 SET CNT=CNT+1
SET TEXT(CNT)="Inpatient quick orders to Infusion quick orders. For each quick order,"
+47 SET CNT=CNT+1
SET TEXT(CNT)="the conversion utility asks a series of questions to populate the minimum"
+48 SET CNT=CNT+1
SET TEXT(CNT)="prompts needed to convert the quick order. Once the conversion is"
+49 SET CNT=CNT+1
SET TEXT(CNT)="done, the user is placed into the Infusion quick order editor to add any"
+50 SET CNT=CNT+1
SET TEXT(CNT)="values to the additional fields in the Infusion quick order, if needed."
+51 SET CNT=CNT+1
SET TEXT(CNT)="Possible conflicts at the time of conversion will be displayed before entering"
+52 SET CNT=CNT+1
SET TEXT(CNT)="the editor. An example of a conflict may be that the user should review the"
+53 SET CNT=CNT+1
SET TEXT(CNT)="strength associated with the additive in the editor."
End DoDot:1
+54 SET CNT=CNT+1
SET TEXT(CNT)=" "
+55 IF NUM<6
SET CNT=CNT+1
SET TEXT(CNT)="Select QUIT THE CONVERSION UTILITY to exit this utility."
+56 SET CNT=0
FOR
SET CNT=$ORDER(TEXT(CNT))
IF CNT'>0
QUIT
WRITE !,TEXT(CNT)
+57 QUIT
+58 ;
