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

BEHOQOW.m

Go to the documentation of this file. 
  1. BEHOQOW ;MSC/IND/PLS - Quick Order Wizard Support ;17-Oct-2013 11:56;PLS
  1.  ;;1.1;BEH COMPONENTS;**039001,039002**;Mar 20, 2007
  1.  ;=================================================================
  1.  ; Return List of Display Groups
  1.  ; Input: GRPTYP - 0 = common, 1=user
  1.  ;        GRPUSR - if GRPTYP=1, use this user to retrieve groups
  1. DISGRP(DATA,GRPTYP,GRPUSR) ;EP
  1.  N IEN,NODE,CNT,NAME
  1.  S GRPTYP=$G(GRPTYP,0)  ; default to all users
  1.  S DATA=$$TMPGBL^CIAVMRPC()
  1.  Q:GRPTYP&'$G(GRPUSR)   ; if type is of user, must have a user
  1.  S CNT=0
  1.  S IEN=0 F  S IEN=$O(^ORD(100.98,IEN)) Q:'IEN  D
  1.  .S NODE=^ORD(100.98,IEN,0)
  1.  .;Q:'$P(^ORD(100.98,IEN,0),U,4)  ; Must have a default dialog
  1.  .Q:'$$VALIDGP(IEN)
  1.  .S CNT=CNT+1,@DATA@(CNT)=IEN_U_$P(NODE,U)_U_$P(NODE,U,2)_U_$S(GRPTYP=1:+$$CNTFUSR(IEN,GRPUSR),1:+$$CNTGRP(IEN))
  1.  Q
  1.  ; Return true if group should be included in the list of groups
  1. VALIDGP(IEN) ;
  1.  N FLG
  1.  S FLG=''$P(^ORD(100.98,IEN,0),U,4)
  1.  I 'FLG D
  1.  .S FLG=$$CHKGPH(IEN)
  1.  Q FLG
  1.  ; Return true if group has a hierarchical link to a default dialog
  1. CHKGPH(IEN) ;
  1.  N FLG,LP
  1.  S LP=0,FLG=0
  1.  F  S LP=$O(^ORD(100.98,"AD",IEN,LP)) Q:'LP!FLG  D
  1.  .S FLG=$$VALIDGP(LP)
  1.  Q FLG
  1.  ; Return Main Display Group
  1. DEFDISGP(DATA,GRP) ;EP
  1.  S DATA=+$P($G(^ORD(100.98,GRP,0)),U,4)
  1.  S DATA=$S('DATA:+$O(^ORD(100.98,"AD",GRP,0)),1:GRP)
  1.  Q:$Q DATA
  1.  ;I 'DATA S DATA=+$O(^ORD(100.98,"AD",GRP,0))
  1.  ;E  S DATA=GRP
  1.  Q
  1.  ; Return list of Quick Orders from Order Dialog File
  1.  ; Input:  GRP - Display Group IEN (default=all groups)
  1.  ;         USR - IEN of User (default=all users)
  1. QOITEMS(DATA,GRP,USR) ;EP
  1.  N IEN,NODE,CNT,NAM,QOV,LP
  1.  S GRP=$G(GRP,0)
  1.  S USR=$G(USR,0)
  1.  S DATA=$$TMPGBL^CIAVMRPC()
  1.  S CNT=0
  1.  I 'USR D
  1.  .S NAM="" F  S NAM=$O(^ORD(101.41,"C",NAM)) Q:NAM=""  D
  1.  ..S IEN=0 F  S IEN=$O(^ORD(101.41,"C",NAM,IEN)) Q:'IEN  D
  1.  ...S NODE=^ORD(101.41,IEN,0)
  1.  ...Q:$P(NODE,U,4)'="Q"
  1.  ...I GRP,$P(NODE,U,5)'=GRP Q
  1.  ...;S CNT=CNT+1,@DATA@(CNT)=IEN_U_NAM_U_$P(NODE,U,5)_U_$P(NODE,U,1)
  1.  ...S CNT=CNT+1,@DATA@(CNT)=IEN_U_$P(NODE,U,1)_U_$P(NODE,U,5)_U_NAM
  1.  E  D
  1.  .S QOV=+$P($$GETQOV(GRP,USR),U,2)
  1.  .I QOV D
  1.  ..S LP=0 F  S LP=$O(^ORD(101.44,+QOV,10,LP)) Q:'LP  S IEN=+^(LP,0) D
  1.  ...S NODE=$G(^ORD(101.41,IEN,0))
  1.  ...Q:$P(NODE,U,4)'="Q"
  1.  ...S CNT=CNT+1,@DATA@(CNT)=IEN_U_$P(NODE,U)_U_$P(NODE,U,5)_U_$P(^ORD(101.44,+QOV,10,LP,0),U,2)  ;$P(NODE,U,2)
  1.  Q
  1.  ; Return value of field for given quick order
  1.  ; Input: IEN - IEN to File 101.41
  1.  ;        FLD - Field Number (defaults to .01)
  1.  ;        FLG - 0=actual (default), 1=Uppercase
  1. QOFVAL(DATA,IEN,FLD,FLG) ;EP
  1.  S FLD=$G(FLD,.01)
  1.  S FLG=$G(FLG,0)
  1.  S DATA=$$GET1^DIQ(101.41,IEN,FLD)
  1.  S:FLG DATA=$$UP^XLFSTR(DATA)
  1.  Q
  1.  ; Count quick orders for a given display group
  1.  ; Input: GRP - Display Group IEN
  1. CNTGRP(GRP) ;
  1.  N CNT,IEN
  1.  S CNT=0
  1.  S IEN=0 F  S IEN=$O(^ORD(101.41,IEN)) Q:'IEN  D
  1.  .Q:$P($G(^ORD(101.41,IEN,0)),U,4)'="Q"
  1.  .Q:$P($G(^ORD(101.41,IEN,0)),U,5)'=GRP
  1.  .S CNT=CNT+1
  1.  Q CNT
  1.  ; Returns Quick Order View information for given Display Group and User.
  1.  ; Input:  DGIEN - Display Group IEN
  1.  ;        GRPUSR - User IEN
  1.  ; Output: Count of Order Dialogs^IEN to Quick Order View for user
  1. CNTFUSR(DGIEN,GRPUSR) ;
  1.  N QOV,VAL
  1.  S VAL="0^0"
  1.  S QOV=$$GETQOV(DGIEN,GRPUSR)
  1.  Q +$$QVCNT(+$P(QOV,U,2))_U_+$P(QOV,U,2)
  1.  ; Returns Item Count for given Quick Order View
  1. QVCNT(QOV) ;
  1.  N LP,CNT
  1.  S:'QOV QOV=$O(^ORD(101.44,"B",QOV,0))
  1.  Q:'QOV 0
  1.  S (CNT,LP)=0 F  S LP=$O(^ORD(101.44,QOV,10,LP)) Q:'LP  D
  1.  .S:$D(^ORD(101.41,+^ORD(101.44,QOV,10,LP,0),0)) CNT=CNT+1
  1.  Q CNT
  1.  ; Return Quick Order View entry for given user
  1.  ; Input: DGIEN - IEN to Display Group (File 100.98)
  1.  ;        USR - IEN to File 200
  1.  ; Output: QOV Name^QOV IEN
  1. GETQOV(DGIEN,USR) ;
  1.  N QOV
  1.  S QOV=$$GET^XPAR("USR.`"_USR,"ORWDQ QUICK VIEW",DGIEN,"I")
  1.  S:$L(QOV) QOV=QOV_U_+$O(^ORD(101.44,"B",QOV,0))
  1.  Q QOV
  1.  ; Return Disabled Status of Order Dialog
  1.  ; Input: BEHOQO - IEN to Order Dialog File (101.41)
  1. GETDISAB(DATA,BEHOQO) ;EP
  1.  S DATA=$L($$GET1^DIQ(101.41,BEHOQO,3))>0
  1.  Q
  1.  ; Set Disabled Message for given Order Dialog
  1.  ; Input: BEHOQO - IEN to Order Dialog File (101.41)
  1.  ;           MSG - Message set (Text will disable; '@' will clear);
  1. SETDISAB(DATA,BEHOQO,MSG) ;EP
  1.  N FDA,F,IENS,ERR
  1.  S F=101.41
  1.  S FDA(F,BEHOQO_",",3)=MSG
  1.  D UPDATE^DIE("","FDA","IENS","ERR")
  1.  S DATA(1)=$S($G(ERR):"Unable to perform action.",1:"")
  1.  Q
  1.  ; Return Delete Status of Order Dialog
  1.  ; Input: BEHOQO - IEN to Order Dialog File (101.41)
  1.  ;           USR - IEN to File 200 - If >0, always return ability to delete.
  1. CANDEL(DATA,BEHOQO,USR) ;EP
  1.  S DATA=0
  1.  S:USR DATA=1
  1.  ;IHS/MSC/PLS - 10/17/2013 - Non-personal quick orders can't be deleted
  1.  ;S:'DATA DATA='($D(^ORD(101.41,"AD",BEHOQO))!($$INUSE^ORCMEDT5(BEHOQO))!($E($$GET1^DIQ(101.41,BEHOQO,.01),1,6)="ORWDQ "))
  1.  Q:$Q DATA
  1.  Q
  1.  ; Delete given Order Dialog
  1.  ; Input: BEHOQO - IEN to Order Dialog File (101.41)
  1.  ;           USR - File 200 IEN. If >0 indicates operation is to be done on
  1.  ;                 user quick view list vs Order Dialog File.
  1.  ;                 (Default = 0)
  1.  ;          DGRP - Display Group
  1.  ;           DNM - Display Name
  1. DELETEQO(DATA,BEHOQO,USR,DGRP,DNM) ;EP
  1.  N DA,DIK
  1.  S USR=$G(USR,0)
  1.  I USR D
  1.  .S DATA=$$DUSRQVI(BEHOQO,USR,DGRP,DNM)
  1.  E  D
  1.  .S DA=BEHOQO,DIK="^ORD(101.41," D ^DIK
  1.  .S DATA='$D(^ORD(101.41,DA,0))
  1.  Q
  1.  ; Delete Order Quick View entry for given user, order dialog and display group.
  1.  ; Input: QOIEN - IEN to File 101.41
  1.  ;          USR - IEN to File 200
  1.  ;         DGRP - IEN to File 100.98
  1. DUSRQVI(QOIEN,USR,DGRP,DNM) ;
  1.  N DFLG,SNM,QVNM,QVIEN,DA,DIK,ROOT
  1.  S DFLG=0
  1.  Q:'QOIEN!'USR!'DGRP!'$L(DNM) DFLG
  1.  S SNM=$$GET1^DIQ(100.98,DGRP,3)
  1.  S QVIEN=$$FIND1^DIC(101.44,"","X","ORWDQ USR"_USR_" "_SNM)
  1.  Q:'QVIEN DFLG
  1.  S DA(1)=QVIEN
  1.  S ROOT="^ORD(101.44,"_DA(1)_",10)"
  1.  S DIK=$P(ROOT,")")_",",DA=0
  1.  F  S DA=$O(@ROOT@(DA)) Q:'DA!DFLG  D
  1.  .I $P(@ROOT@(DA,0),U,1,2)=(QOIEN_U_DNM) D
  1.  ..D ^DIK
  1.  ..S DFLG=1
  1.  ;CPRS 27 removes the view dialogs and then the actual QO
  1.  S DA=QOIEN,DIK="^ORD(101.41," D ^DIK
  1.  Q DFLG
  1.  ; Return Window Form ID for given Display Group default dialog
  1. GRPDEFWD(DATA,GRP) ;EP
  1.  S DATA=+$$GET1^DIQ(101.41,$$DEFDLG^ORWDXQ(GRP),55,"I")
  1.  Q:$Q DATA
  1.  Q
  1.  ; Return properties of given quick order
  1.  ; Input: CIAQO - IEN to Order Dialog File (101.41)
  1. PROPERTY(DATA,CIAQO) ;EP
  1.  N ORDIALOG,F
  1.  S DATA=$$TMPGBL^CIAVMRPC()
  1.  I '$G(CIAQO,0) D  Q
  1.  .S @DATA@(1)="Quick Order entry not available."
  1.  D GETQDLG^ORCD(CIAQO)
  1.  D CAPTURE^CIAUHFS("D DISPLAY^ORCDLG",DATA,50)
  1.  S F=101.41
  1.  S @DATA@(1.01)="Number: "_CIAQO
  1.  S @DATA@(1.1)="Name: "_$$GET1^DIQ(F,CIAQO,.01)
  1.  S @DATA@(1.11)="Display Text: "_$$GET1^DIQ(F,CIAQO,2)
  1.  S @DATA@(1.12)="Disable: "_$$GET1^DIQ(F,CIAQO,3)
  1.  S @DATA@(1.13)="Type: "_$$UP^XLFSTR($$GET1^DIQ(F,CIAQO,4))
  1.  S @DATA@(1.14)="Display Group: "_$$GET1^DIQ(F,CIAQO,5)
  1.  S @DATA@(1.15)="Signature Required: "_$$GET1^DIQ(F,CIAQO,6)
  1.  S @DATA@(1.16)="Package: "_$$GET1^DIQ(F,CIAQO,7)
  1.  S @DATA@(1.17)="Verify Order: "_$$GET1^DIQ(F,CIAQO,8)
  1.  S @DATA@(1.18)="Ask For Another Order: "_$$GET1^DIQ(F,CIAQO,9)
  1.  S @DATA@(1.19)="Auto-Accept Quick Order: "_$$GET1^DIQ(F,CIAQO,58)
  1.  S @DATA@(1.2)=""
  1.  S @DATA@(1.3)="Order Dialog Responses:"
  1.  S @DATA@(1.4)=""
  1.  Q
  1.  ; Save Order Dialog
  1.  ; Input:
  1.  ;       IEN - IEN to 101.41 or 0 for new dialog
  1.  ;       TYP - Common QO (0) or User QO (1) (Default: 0)
  1.  ;        NM - Order Dialog Name
  1.  ;       DNM - Display Text
  1.  ;      DGRP - Display Group
  1.  ;      EACT - Entry Action
  1.  ;       VER - Verify Order
  1.  ;       RSP - Dialog Responses
  1. SAVEDLG(DATA,IEN,TYP,NM,DNM,DGRP,EACT,VER,RSP) ;EP
  1.  S DATA=0,RSP=$$DEFDLG^ORWDXQ(DGRP) Q:'RSP
  1.  S TYP=$G(TYP,0)
  1.  D GETDLG1^ORCD(RSP)
  1.  N FDA,FDAIEN,DIERR,ORDG,ORQDLG,NODE
  1.  S:IEN FDAIEN(1)=IEN
  1.  S NODE=$S(IEN:IEN,1:"+1")_","
  1.  S FDA(101.41,NODE,.01)=NM
  1.  S FDA(101.41,NODE,2)=DNM
  1.  S FDA(101.41,NODE,4)="Q"
  1.  S FDA(101.41,NODE,5)=DGRP
  1.  S FDA(101.41,NODE,8)=VER
  1.  S FDA(101.41,NODE,30)=EACT
  1.  I IEN D
  1.  .D FILE^DIE("","FDA","DIERR")
  1.  E  D
  1.  .D UPDATE^DIE("","FDA","FDAIEN","DIERR")
  1.  S DATA=+$G(FDAIEN(1))
  1.  I '$D(DIERR) D
  1.  .S ORQDLG=FDAIEN(1)
  1.  .D SAVE^ORCMEDT1
  1.  Q
  1.  ; Update Quick Order Responses
  1.  ; Always returns 0
  1. UPDRSP(DATA,IEN,DGRP,ORDIALOG) ;EP
  1.  N ORQDLG
  1.  S DATA=0,ORDIALOG=$$DEFDLG^ORWDXQ(DGRP) Q:'ORDIALOG
  1.  D GETDLG1^ORCD(ORDIALOG)
  1.  S ORQDLG=IEN
  1.  D SAVE^ORCMEDT1
  1.  Q
  1.  ;
  1.  ;Return Package IEN for given Display Group
  1. GETPKG(DATA,DISGRP) ;EP
  1.  N DEFGRP,DLG,PKG
  1.  S DLG=$$DEFDLG^ORWDXQ(DISGRP)
  1.  S DATA=$$GET1^DIQ(101.41,DLG,7,"I")
  1.  ;S DEFGRP=$$DEFDISGP(DISGRP)
  1.  ;S DLG=
  1.  ;S DATA=PKG
  1.  Q:$Q DATA
  1.  Q
  1.  ; Move Reponses to Cloned Entry
  1.  ; Input: FIEN - IEN in 101.41 of entry to clone
  1.  ;        TIEN - IEN in 101.41 of new entry
  1. CLONE(DATA,FIEN,TIEN) ;EP
  1.  S DATA=0
  1.  Q:'FIEN!('TIEN)
  1.  Q:'$D(^ORD(101.41,FIEN))!('$D(^ORD(101.41,TIEN)))
  1.  M ^ORD(101.41,TIEN,6)=^ORD(101.41,FIEN,6)
  1.  S DATA=1
  1.  Q
  1.  ;Returns quick order dialog info
  1. ITMINFO(DATA,IEN) ;EP-
  1.  N NODE
  1.  S NODE=$G(^ORD(101.41,IEN,0))
  1.  S DATA=IEN_U_$P(NODE,U)_U_$P(NODE,U,5)_U_$$UP^XLFSTR($P(NODE,U,2))
  1.  Q