Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORADDFQT

ORADDFQT.m

Go to the documentation of this file. 
  1. ORADDFQT ; SLC/AGP - Utility report for Order Dialogs ; 10/15/10
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**337**;DEC 17, 1997;Build 84
  1.  ;
  1.  ; DBIA 5133: reading ^PXRMD file #801.41
  1.  ; 
  1.  Q
  1.  ;
  1. EDIT(IEN,PERQOAR) ;
  1.  N ASKADD,CNT,CONF,DA,DIE,DIK,DR,DRPSIVDG,DUR,EXIT,ERR,ERROR,FDA,FDAIEN
  1.  N IVTYPE,LOC,NAME,NODE,OUTPUT,PSIVDG,PSNODE,TERMIN,USER
  1.  N ADD,ADDIEN,ADDF,ADDFIEN,ADDNAME,ADDV,ORDIALOG,STR
  1.  S EXIT=0,ERROR=0
  1.  N OI,OINAME,PTR,UPDADD,UPDDSG
  1.  S USER=$$ISPERQO^ORINQIV(IEN) I USER>0 D  Q EXIT
  1.  .S NODE=$G(^ORD(101.41,IEN,0))
  1.  .D GETS^DIQ(200,USER_",",".01;9.2","EI","OUTPUT","ERR")
  1.  .I $D(ERR) D AWRITE^ORINQIV(ERR) Q
  1.  .S TERMIN=$G(OUTPUT(200,USER_",",9.2,"I"))
  1.  .I TERMIN>0,TERMIN<DT Q
  1.  .S PERQOAR(OUTPUT(200,USER_",",.01,"E"),$P(NODE,U))=$P(NODE,U,2)
  1.  K ^TMP($J,"OR DESC")
  1.  S UPDDSG="N",UPDADD="N"
  1.  S DA=IEN
  1.  D EN^ORORDDSC(IEN,"OR DESC")
  1.  S CNT=0 F  S CNT=$O(^TMP($J,"OR DESC",IEN,CNT)) Q:CNT'>0  D
  1.  .W !,^TMP($J,"OR DESC",IEN,CNT)
  1.  ;
  1. CONVERT ;
  1.  W !!,"Add additive frequency to the above Quick Order?"
  1.  S UPDDSG=$$ASK^ORINQIV("Add additive fequency?","Y:YES;N:NO",1,"")
  1.  I UPDDSG="Q"!(UPDDSG=U)!(UPDDSG="^^") S EXIT=1 G EDITX
  1.  I UPDDSG'="Y" G EDITX
  1.  ;buidl ORDIALOG array
  1.  D GETQDLG^ORCD(IEN)
  1.  ;find additive
  1.  S ADDIEN=+$P($G(ORDIALOG("B","ADDITIVE")),U,2)
  1.  S CNT=0
  1.  F  S CNT=$O(ORDIALOG(ADDIEN,CNT)) Q:CNT=""  D
  1.  .I +CNT=0 Q
  1.  .S ADD(CNT)=ORDIALOG(ADDIEN,CNT)
  1.  ;
  1. FREQ ;
  1.  N ANS,DEFAULT,EXIT,ORIVTYPE
  1.  S ORIVTYPE="C"
  1.  S CNT=0,EXIT=0 F  S CNT=$O(ADD(CNT)) Q:CNT'>0!(EXIT=1)  D
  1.  .S ADDV=ADD(CNT) Q:ADDV'>0
  1.  .S ADDNAME=$P($G(^ORD(101.43,ADDV,0)),U)
  1.  .W !,"Additive: "_ADDNAME
  1.  .S DEFAULT=$$ADDFRD^ORCDPSIV(.ORDIALOG,CNT,"ADDFREQ")
  1.  .S STR="A:ALL Bags;1:1 Bag/Day;S:See Comments"
  1.  .W !,"Default value: "_DEFAULT
  1.  .S ANS=$$ASK^ORINQIV("Select Additive Frequency",STR,9,DEFAULT)
  1.  .I ANS=U S EXIT=1 Q
  1.  .I ANS="^^"!(ANS="Q") S EXIT=1 Q
  1.  .I ANS="K"!(ANS="N") S EXIT=1 Q
  1.  .S ADDF(CNT)=$S(ANS="A":"ALL Bags",ANS=1:"1 Bag/Day",ANS="S":"See Comments")
  1.  I ANS=U G FREQ
  1.  I ANS="^^"!(ANS="Q") G EDITX
  1.  I ANS="K"!(ANS="N") G EDITX
  1.  ;
  1. CONFIRM ;
  1.  W !!,"Please confirm the selected changes below."
  1.  W !,"If these changes are accepted, the Quick Order will be updated"
  1.  S CNT=0 F  S CNT=$O(ADD(CNT)) Q:CNT=""  D
  1.  .S ADDV=ADD(CNT) Q:ADDV'>0
  1.  .S ADDNAME=$P($G(^ORD(101.43,ADDV,0)),U)
  1.  .W !,"Additive: "_ADDNAME
  1.  .W !,"Additive Frequency: "_$G(ADDF(CNT))
  1.  .W !
  1.  S CONF=$$ASK^ORINQIV("Confirm Changes?","Y:YES;N:NO",4,"")
  1.  I CONF=U G FREQ
  1.  I CONF="^^"!(CONF="Q") S EXIT=1 G EDITX
  1.  I CONF="S"!(CONF="N") G EDITX
  1.  ;
  1. UPDATES ;Do updates
  1.  W !
  1.  N FDA,IENS
  1.  N UPD,INT,VALUE
  1.  S UPD=3,INT=0
  1.  S PTR=$$PTR^ORMBLDPS("ADDITIVE FREQUENCY") Q:PTR'>0
  1.  S CNT=0 F  S CNT=$O(ADDF(CNT)) Q:CNT=""  D
  1.  .S UPD=UPD+1,INT=INT+1
  1.  .S VALUE=ADDF(CNT) Q:VALUE=""
  1.  .S IENS="?+"_UPD_","_IEN_","
  1.  .S FDA(101.416,IENS,.01)=40
  1.  .S FDA(101.416,IENS,.02)=PTR
  1.  .S FDA(101.416,IENS,.03)=INT
  1.  .S FDA(101.416,IENS,1)=VALUE
  1.  .D UPDATE^DIE("","FDA","FDAIEN","ERR")
  1.  .I $D(ERR) D AWRITE^ORINQIV("ERR") S ERROR=1
  1.  I ERROR=1 W !,"Due to the errors in conversion please valiate the quick order in the editor."
  1.  ;
  1.  ;Call the QO editor
  1.  W !
  1.  D QCK0^ORCMEDT1(IEN)
  1. EDITX ;
  1.  K ^TMP($J,"OR DESC")
  1.  Q EXIT
  1.  ;
  1. EN ;
  1.  K ^TMP($J,"OR REMMDLG")
  1.  N DIR,DSGPAR,DSGRP,EXIT,NANSC,ODIEN,PERQOAR,QOIEN,Y
  1.  ;
  1.  D HELP^ORINQIV(7)
  1.  ;Build a list of Display Groups that contains the default dialog of
  1.  ;PSJI OR PAT FLUID OE
  1.  S ODIEN=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE","")) Q:ODIEN=""
  1.  S DSGRP=0 F  S DSGRP=$O(^ORD(100.98,DSGRP)) Q:DSGRP'>0  D
  1.  .I $P(^ORD(100.98,DSGRP,0),U,4)=ODIEN S DSGPAR(DSGRP)=""
  1.  ;
  1.  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"
  1.  S DIR("A")="Which QO to convert?"
  1.  S DIR("??")="^D HELP^ORINQIV(5)"
  1.  D ^DIR
  1.  I Y=U!(Y="^^")!(Y="Q") Q
  1.  I Y="S" D IND(.DSGPAR) Q
  1.  S NANSC=Y
  1.  D FQOIRDLG^ORINQIV
  1.  ;
  1.  S OIIEN=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM","")) Q:OIIEN'>0
  1.  S EXIT=0
  1.  S QOIEN=0 F  S QOIEN=$O(^ORD(101.41,QOIEN)) Q:QOIEN'>0!(EXIT=1)  D
  1.  .I $$ISVALID(QOIEN,NANSC,.DSGPAR)=0 Q
  1.  .S EXIT=$$EDIT(QOIEN,.PERQOAR)
  1. UTLEXIT ;
  1.  I $D(PERQOAR) D BLDMSG^ORINQIV(.PERQOAR)
  1.  K ^TMP($J,"OR REMDLG")
  1.  Q
  1.  ;
  1. IND(DSGPAR) ;
  1.  N DIC,DIR,EXIT,PERQOAR
  1.  S DIC="^ORD(101.41,",DIC(0)="AEMQZ"
  1.  S DIC("S")="I $$ISVALID^ORADDFQT(Y,""S"",.DSGPAR)=1"
  1.  D ^DIC
  1.  I +$P(Y,U)'>0 Q
  1.  S EXIT=$$EDIT($P(Y,U),.PERQOAR)
  1.  I EXIT=1 Q
  1.  W !
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Convert another Quick Order?"
  1.  D ^DIR
  1.  I Y=1 D IND(.DSGPAR)
  1.  I $D(PERQOAR) D BLDMSG^ORINQIV(.PERQOAR)
  1.  Q
  1.  ;
  1. ISVALID(IEN,NANSC,DSGPAR) ;
  1.  N CONT,NODE,QODSG,PSNODE,RESULT
  1.  S NODE=$G(^ORD(101.41,IEN,0))
  1.  ;Quit if not a quick order
  1.  I $P(NODE,U,4)'="Q" Q 0
  1.  ;Disregard order dialog entry does not contain a valid display group
  1.  S QODSG=$P(NODE,U,5) I QODSG="" Q 0
  1.  I '$D(DSGPAR(QODSG)) Q 0
  1.  ;
  1.  S CONT=$S($O(^ORD(101.41,"AD",IEN,0)):1,$D(^TMP($J,"OR REMDLG",IEN)):1,1:0)
  1.  ;
  1.  ;S CONT=$$ISCONT^ORINQIV(IEN)
  1.  I NANSC="A",CONT=0 Q 0
  1.  I NANSC="N",CONT=1 Q 0
  1.  N TYPE,ORDIALOG
  1.  S ORTYPE="Z"
  1.  D GETQDLG^ORCD(IEN)
  1.  ; determine if a continuous IV Order
  1.  S TYPE=+$P($G(ORDIALOG("B","TYPE")),U,2) I TYPE'>0 Q 0
  1.  I $G(ORDIALOG(TYPE,1))'="C" Q 0
  1.  I $$IVADFCHK^ORWDXM3(.ORDIALOG)=0 Q 1
  1.  Q 0
  1.  ;