ORADDFQT ; SLC/AGP - Utility report for Order Dialogs ; 10/15/10
;;3.0;ORDER ENTRY/RESULTS REPORTING;**337**;DEC 17, 1997;Build 84
;
; DBIA 5133: reading ^PXRMD file #801.41
;
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
N ADD,ADDIEN,ADDF,ADDFIEN,ADDNAME,ADDV,ORDIALOG,STR
S EXIT=0,ERROR=0
N OI,OINAME,PTR,UPDADD,UPDDSG
S USER=$$ISPERQO^ORINQIV(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^ORINQIV(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 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 !!,"Add additive frequency to the above Quick Order?"
S UPDDSG=$$ASK^ORINQIV("Add additive fequency?","Y:YES;N:NO",1,"")
I UPDDSG="Q"!(UPDDSG=U)!(UPDDSG="^^") S EXIT=1 G EDITX
I UPDDSG'="Y" G EDITX
;buidl ORDIALOG array
D GETQDLG^ORCD(IEN)
;find additive
S ADDIEN=+$P($G(ORDIALOG("B","ADDITIVE")),U,2)
S CNT=0
F S CNT=$O(ORDIALOG(ADDIEN,CNT)) Q:CNT="" D
.I +CNT=0 Q
.S ADD(CNT)=ORDIALOG(ADDIEN,CNT)
;
FREQ ;
N ANS,DEFAULT,EXIT,ORIVTYPE
S ORIVTYPE="C"
S CNT=0,EXIT=0 F S CNT=$O(ADD(CNT)) Q:CNT'>0!(EXIT=1) D
.S ADDV=ADD(CNT) Q:ADDV'>0
.S ADDNAME=$P($G(^ORD(101.43,ADDV,0)),U)
.W !,"Additive: "_ADDNAME
.S DEFAULT=$$ADDFRD^ORCDPSIV(.ORDIALOG,CNT,"ADDFREQ")
.S STR="A:ALL Bags;1:1 Bag/Day;S:See Comments"
.W !,"Default value: "_DEFAULT
.S ANS=$$ASK^ORINQIV("Select Additive Frequency",STR,9,DEFAULT)
.I ANS=U S EXIT=1 Q
.I ANS="^^"!(ANS="Q") S EXIT=1 Q
.I ANS="K"!(ANS="N") S EXIT=1 Q
.S ADDF(CNT)=$S(ANS="A":"ALL Bags",ANS=1:"1 Bag/Day",ANS="S":"See Comments")
I ANS=U G FREQ
I ANS="^^"!(ANS="Q") G EDITX
I ANS="K"!(ANS="N") G EDITX
;
CONFIRM ;
W !!,"Please confirm the selected changes below."
W !,"If these changes are accepted, the Quick Order will be updated"
S CNT=0 F S CNT=$O(ADD(CNT)) Q:CNT="" D
.S ADDV=ADD(CNT) Q:ADDV'>0
.S ADDNAME=$P($G(^ORD(101.43,ADDV,0)),U)
.W !,"Additive: "_ADDNAME
.W !,"Additive Frequency: "_$G(ADDF(CNT))
.W !
S CONF=$$ASK^ORINQIV("Confirm Changes?","Y:YES;N:NO",4,"")
I CONF=U G FREQ
I CONF="^^"!(CONF="Q") S EXIT=1 G EDITX
I CONF="S"!(CONF="N") G EDITX
;
UPDATES ;Do updates
W !
N FDA,IENS
N UPD,INT,VALUE
S UPD=3,INT=0
S PTR=$$PTR^ORMBLDPS("ADDITIVE FREQUENCY") Q:PTR'>0
S CNT=0 F S CNT=$O(ADDF(CNT)) Q:CNT="" D
.S UPD=UPD+1,INT=INT+1
.S VALUE=ADDF(CNT) Q:VALUE=""
.S IENS="?+"_UPD_","_IEN_","
.S FDA(101.416,IENS,.01)=40
.S FDA(101.416,IENS,.02)=PTR
.S FDA(101.416,IENS,.03)=INT
.S FDA(101.416,IENS,1)=VALUE
.D UPDATE^DIE("","FDA","FDAIEN","ERR")
.I $D(ERR) D AWRITE^ORINQIV("ERR") S ERROR=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^ORINQIV(7)
;Build a list of Display Groups that contains the default dialog of
;PSJI OR PAT FLUID OE
S ODIEN=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID 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 UPDATE 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(.DSGPAR) Q
S NANSC=Y
D FQOIRDLG^ORINQIV
;
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^ORINQIV(.PERQOAR)
K ^TMP($J,"OR REMDLG")
Q
;
IND(DSGPAR) ;
N DIC,DIR,EXIT,PERQOAR
S DIC="^ORD(101.41,",DIC(0)="AEMQZ"
S DIC("S")="I $$ISVALID^ORADDFQT(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^ORINQIV(.PERQOAR)
Q
;
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 0
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^ORINQIV(IEN)
I NANSC="A",CONT=0 Q 0
I NANSC="N",CONT=1 Q 0
N TYPE,ORDIALOG
S ORTYPE="Z"
D GETQDLG^ORCD(IEN)
; determine if a continuous IV Order
S TYPE=+$P($G(ORDIALOG("B","TYPE")),U,2) I TYPE'>0 Q 0
I $G(ORDIALOG(TYPE,1))'="C" Q 0
I $$IVADFCHK^ORWDXM3(.ORDIALOG)=0 Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORADDFQT 5312 printed Dec 13, 2024@02:26:52 Page 2
ORADDFQT ; SLC/AGP - Utility report for Order Dialogs ; 10/15/10
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**337**;DEC 17, 1997;Build 84
+2 ;
+3 ; DBIA 5133: reading ^PXRMD file #801.41
+4 ;
+5 QUIT
+6 ;
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 NEW ADD,ADDIEN,ADDF,ADDFIEN,ADDNAME,ADDV,ORDIALOG,STR
+4 SET EXIT=0
SET ERROR=0
+5 NEW OI,OINAME,PTR,UPDADD,UPDDSG
+6 SET USER=$$ISPERQO^ORINQIV(IEN)
IF USER>0
Begin DoDot:1
+7 SET NODE=$GET(^ORD(101.41,IEN,0))
+8 DO GETS^DIQ(200,USER_",",".01;9.2","EI","OUTPUT","ERR")
+9 IF $DATA(ERR)
DO AWRITE^ORINQIV(ERR)
QUIT
+10 SET TERMIN=$GET(OUTPUT(200,USER_",",9.2,"I"))
+11 IF TERMIN>0
IF TERMIN<DT
QUIT
+12 SET PERQOAR(OUTPUT(200,USER_",",.01,"E"),$PIECE(NODE,U))=$PIECE(NODE,U,2)
End DoDot:1
QUIT EXIT
+13 KILL ^TMP($JOB,"OR DESC")
+14 SET UPDDSG="N"
SET UPDADD="N"
+15 SET DA=IEN
+16 DO EN^ORORDDSC(IEN,"OR DESC")
+17 SET CNT=0
FOR
SET CNT=$ORDER(^TMP($JOB,"OR DESC",IEN,CNT))
if CNT'>0
QUIT
Begin DoDot:1
+18 WRITE !,^TMP($JOB,"OR DESC",IEN,CNT)
End DoDot:1
+19 ;
CONVERT ;
+1 WRITE !!,"Add additive frequency to the above Quick Order?"
+2 SET UPDDSG=$$ASK^ORINQIV("Add additive fequency?","Y:YES;N:NO",1,"")
+3 IF UPDDSG="Q"!(UPDDSG=U)!(UPDDSG="^^")
SET EXIT=1
GOTO EDITX
+4 IF UPDDSG'="Y"
GOTO EDITX
+5 ;buidl ORDIALOG array
+6 DO GETQDLG^ORCD(IEN)
+7 ;find additive
+8 SET ADDIEN=+$PIECE($GET(ORDIALOG("B","ADDITIVE")),U,2)
+9 SET CNT=0
+10 FOR
SET CNT=$ORDER(ORDIALOG(ADDIEN,CNT))
if CNT=""
QUIT
Begin DoDot:1
+11 IF +CNT=0
QUIT
+12 SET ADD(CNT)=ORDIALOG(ADDIEN,CNT)
End DoDot:1
+13 ;
FREQ ;
+1 NEW ANS,DEFAULT,EXIT,ORIVTYPE
+2 SET ORIVTYPE="C"
+3 SET CNT=0
SET EXIT=0
FOR
SET CNT=$ORDER(ADD(CNT))
if CNT'>0!(EXIT=1)
QUIT
Begin DoDot:1
+4 SET ADDV=ADD(CNT)
if ADDV'>0
QUIT
+5 SET ADDNAME=$PIECE($GET(^ORD(101.43,ADDV,0)),U)
+6 WRITE !,"Additive: "_ADDNAME
+7 SET DEFAULT=$$ADDFRD^ORCDPSIV(.ORDIALOG,CNT,"ADDFREQ")
+8 SET STR="A:ALL Bags;1:1 Bag/Day;S:See Comments"
+9 WRITE !,"Default value: "_DEFAULT
+10 SET ANS=$$ASK^ORINQIV("Select Additive Frequency",STR,9,DEFAULT)
+11 IF ANS=U
SET EXIT=1
QUIT
+12 IF ANS="^^"!(ANS="Q")
SET EXIT=1
QUIT
+13 IF ANS="K"!(ANS="N")
SET EXIT=1
QUIT
+14 SET ADDF(CNT)=$SELECT(ANS="A":"ALL Bags",ANS=1:"1 Bag/Day",ANS="S":"See Comments")
End DoDot:1
+15 IF ANS=U
GOTO FREQ
+16 IF ANS="^^"!(ANS="Q")
GOTO EDITX
+17 IF ANS="K"!(ANS="N")
GOTO EDITX
+18 ;
CONFIRM ;
+1 WRITE !!,"Please confirm the selected changes below."
+2 WRITE !,"If these changes are accepted, the Quick Order will be updated"
+3 SET CNT=0
FOR
SET CNT=$ORDER(ADD(CNT))
if CNT=""
QUIT
Begin DoDot:1
+4 SET ADDV=ADD(CNT)
if ADDV'>0
QUIT
+5 SET ADDNAME=$PIECE($GET(^ORD(101.43,ADDV,0)),U)
+6 WRITE !,"Additive: "_ADDNAME
+7 WRITE !,"Additive Frequency: "_$GET(ADDF(CNT))
+8 WRITE !
End DoDot:1
+9 SET CONF=$$ASK^ORINQIV("Confirm Changes?","Y:YES;N:NO",4,"")
+10 IF CONF=U
GOTO FREQ
+11 IF CONF="^^"!(CONF="Q")
SET EXIT=1
GOTO EDITX
+12 IF CONF="S"!(CONF="N")
GOTO EDITX
+13 ;
UPDATES ;Do updates
+1 WRITE !
+2 NEW FDA,IENS
+3 NEW UPD,INT,VALUE
+4 SET UPD=3
SET INT=0
+5 SET PTR=$$PTR^ORMBLDPS("ADDITIVE FREQUENCY")
if PTR'>0
QUIT
+6 SET CNT=0
FOR
SET CNT=$ORDER(ADDF(CNT))
if CNT=""
QUIT
Begin DoDot:1
+7 SET UPD=UPD+1
SET INT=INT+1
+8 SET VALUE=ADDF(CNT)
if VALUE=""
QUIT
+9 SET IENS="?+"_UPD_","_IEN_","
+10 SET FDA(101.416,IENS,.01)=40
+11 SET FDA(101.416,IENS,.02)=PTR
+12 SET FDA(101.416,IENS,.03)=INT
+13 SET FDA(101.416,IENS,1)=VALUE
+14 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
+15 IF $DATA(ERR)
DO AWRITE^ORINQIV("ERR")
SET ERROR=1
End DoDot:1
+16 IF ERROR=1
WRITE !,"Due to the errors in conversion please valiate the quick order in the editor."
+17 ;
+18 ;Call the QO editor
+19 WRITE !
+20 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^ORINQIV(7)
+5 ;Build a list of Display Groups that contains the default dialog of
+6 ;PSJI OR PAT FLUID OE
+7 SET ODIEN=$ORDER(^ORD(101.41,"AB","PSJI OR PAT FLUID 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 UPDATE 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(.DSGPAR)
QUIT
+17 SET NANSC=Y
+18 DO FQOIRDLG^ORINQIV
+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^ORINQIV(.PERQOAR)
+2 KILL ^TMP($JOB,"OR REMDLG")
+3 QUIT
+4 ;
IND(DSGPAR) ;
+1 NEW DIC,DIR,EXIT,PERQOAR
+2 SET DIC="^ORD(101.41,"
SET DIC(0)="AEMQZ"
+3 SET DIC("S")="I $$ISVALID^ORADDFQT(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^ORINQIV(.PERQOAR)
+14 QUIT
+15 ;
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 0
+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^ORINQIV(IEN)
+12 IF NANSC="A"
IF CONT=0
QUIT 0
+13 IF NANSC="N"
IF CONT=1
QUIT 0
+14 NEW TYPE,ORDIALOG
+15 SET ORTYPE="Z"
+16 DO GETQDLG^ORCD(IEN)
+17 ; determine if a continuous IV Order
+18 SET TYPE=+$PIECE($GET(ORDIALOG("B","TYPE")),U,2)
IF TYPE'>0
QUIT 0
+19 IF $GET(ORDIALOG(TYPE,1))'="C"
QUIT 0
+20 IF $$IVADFCHK^ORWDXM3(.ORDIALOG)=0
QUIT 1
+21 QUIT 0
+22 ;
