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

ORWD.m

Go to the documentation of this file. 
  1. ORWD ; SLC/KCM - Utilities for Windows Dialogs ;7/2/01  13:31
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
  1.  ;
  1. DT(Y,X) ; Returns internal Fileman Date/Time
  1.  N %DT S %DT="TS" D ^%DT
  1.  Q
  1. PROVKEY(VAL,USERID) ; Returns 1 if user possesses the provider key
  1.  N NAM S NAM=$P(^VA(200,USERID,0),U,1)
  1.  S VAL=$D(^VA(200,"AK.PROVIDER",NAM,USERID))
  1.  Q
  1. KEY(VAL,KEYNAME,USERID) ; Returns 1 if user possesses the key
  1.  S VAL=0 I $D(^XUSEC(KEYNAME,USERID)) S VAL=1
  1.  Q
  1. OI(Y,XREF,DIR,FROM) ; Return a bolus of orderable items
  1.  ; .Return Array, Cross Reference (S.xxx), Direction, Starting Text
  1.  N I,IEN,CNT S CNT=44
  1.  ;
  1.  I DIR=0 D  ; Forward direction
  1.  . F I=1:1:CNT S FROM=$O(^ORD(101.43,XREF,FROM)) Q:FROM=""  D
  1.  . . S Y(I)=$O(^ORD(101.43,XREF,FROM,0))_"^"_FROM
  1.  . I $G(Y(CNT))="" S Y(I)=""
  1.  ;
  1.  I DIR=1 D  ; Reverse direction
  1.  . F I=1:1:CNT S FROM=$O(^ORD(101.43,XREF,FROM),-1) Q:FROM=""  D
  1.  . . S Y(I)=$O(^ORD(101.43,XREF,FROM,0))_"^"_FROM
  1.  Q
  1. ODEF(Y,DLG) ; Return the definition for a dialog
  1.  Q:'$L(DLG)
  1.  S DLG=+$O(^ORD(101.41,"B",DLG,0))
  1.  Q:$D(^ORD(101.41,DLG,50))<10
  1.  N I,IEN,IDX
  1.  S I=0,IDX=0
  1.  S Y(0)=$P($G(^ORD(101.41,DLG,5)),"^",4)
  1.  F  S I=$O(^ORD(101.41,DLG,50,"AC",I)) Q:I=""  S IEN=$O(^(I,0)) D
  1.  . S IDX=IDX+1,Y(IDX)=$G(^ORD(101.41,DLG,50,IEN,0))
  1.  Q
  1. DEF(Y,DLG) ; Return format mapping for a dialog
  1.  ; Y(n): CtrlName^DlgPtr^FmtSeq^Fmt^Omit^Lead^Trail^Mult?^chd1~chd2~...
  1.  I DLG="NOT IMPLEMENTED" S Y(0)="0^0" Q                 ; for testing
  1.  S DLG=$O(^ORD(101.41,"B",DLG,0))
  1.  N I,J,K,N,X0,X2,XW,DPTR
  1.  S Y(0)=$P(^ORD(101.41,DLG,0),U,5)_U_DLG
  1.  S I=0,N=0
  1.  F  S I=$O(^ORD(101.41,DLG,10,I)) Q:I'>0  D
  1.  . S X0=$G(^ORD(101.41,DLG,10,I,0)),DPTR=$P(X0,U,2)
  1.  . S X2=$G(^ORD(101.41,DLG,10,I,2))
  1.  . S XW=$G(^ORD(101.41,DLG,10,I,"W"))
  1.  . S N=N+1,Y(N)=$P(XW,U,1)_U_DPTR_U_X2,CHLD=""
  1.  . S J=0 F  S J=$O(^ORD(101.41,DLG,10,"DAD",DPTR,J)) Q:'J  D
  1.  . . S K=0 F  S K=$O(^ORD(101.41,DLG,10,"DAD",DPTR,J,K)) Q:'K  D
  1.  . . . S CHLD=CHLD_$P(^ORD(101.41,DLG,10,K,0),U,2)_"~"
  1.  . S $P(Y(N),U,8)=CHLD
  1.  Q
  1. FORMID(VAL,ORIFN) ; procedure
  1.  ; Returns the Dialog Form ID
  1.  N X
  1.  S VAL=0,X=$P(^OR(100,+ORIFN,0),U,5)
  1.  Q:$P(X,";",2)'="ORD(101.41,"
  1.  S VAL=+$P($G(^ORD(101.41,+X,5)),U,5)
  1.  ; I X S VAL=$P($G(^XTV(8989.52,+X,0)),U,2)
  1.  Q
  1. GET4EDIT(LST,ORIFN) ; procedure
  1.  ; return responses in format that can be used by dialog
  1.  N ILST,PRMT,INST,DLG,ORDIALOG S ILST=0
  1.  I '$D(ORIFN) S LST=0 Q
  1.  S ORIFN=+ORIFN,DLG=+$P(^OR(100,ORIFN,0),U,5)
  1.  D GETDLG1^ORCD(DLG),GETORDER^ORCD("^OR(100,"_ORIFN_",4.5)")
  1.  S PRMT=0 F  S PRMT=$O(ORDIALOG(PRMT)) Q:'PRMT  D
  1.  . S INST=0 F  S INST=$O(ORDIALOG(PRMT,INST)) Q:'INST  D
  1.  . . S ILST=ILST+1,LST(ILST)="~"_PRMT_U_INST_U_$P(ORDIALOG(PRMT),U,3)
  1.  . . S ILST=ILST+1,LST(ILST)="d"_ORDIALOG(PRMT,INST)
  1.  . . I $E(ORDIALOG(PRMT,INST))=U D                 ; load word processing
  1.  . . . N I,REF S I=0,REF=ORDIALOG(PRMT,INST)
  1.  . . . F  S I=$O(@REF@(I)) Q:'I  S ILST=ILST+1,LST(ILST)="t"_^(I,0)
  1.  . . E  S $P(LST(ILST),U,2)=$$EXT^ORCD(PRMT,INST)  ; load external value
  1.  . . I "R"[$E(ORDIALOG(PRMT,0)) D
  1.  . . . S $P(LST(ILST),U,2)=$$UP^XLFSTR($$FMTE^XLFDT(ORDIALOG(PRMT,INST)))
  1.  Q
  1. EXTDT(X) ; Return an external date time that can be interpreted by %DT
  1.  I $E(X)="T" Q "TODAY"_$E(X,2,255)
  1.  I $E(X)="V" Q "NEXT VISIT"_$E(X,2,255)
  1.  Q ""
  1. WRLST(Y,TYP) ; Return list of dialogs for writing orders
  1.  ; .Y(n): DlgName^ListBox Text
  1.  ;   TYP: 'I' = inpatient, 'O' = outpatient
  1.  N PAR,ERR,SEQ,IEN,I,X
  1.  S PAR=$S(TYP="I":"ORW ADDORD INPT",1:"ORW ADDORD OUTPT")
  1.  D GETLST^XPAR(.X,"ALL",PAR,"Q",.ERR) Q:ERR
  1.  S I=0 F  S I=$O(X(I)) Q:'I  D
  1.  . S SEQ=$P(X(I),U,1),IEN=$P(X(I),U,2)
  1.  . S Y(SEQ)=$P(^ORD(101.41,IEN,0),U,1)_U_$P($G(^(5)),U,4)
  1.  Q
  1. SAVE(Y,DFN,ORNP,LOC,DLG,ORWDACT,RSP) ; procedure
  1.  ; Save order
  1.  N ORDIALOG,ORL,ORVP,ORIFN,ORDUZ,ORSTS,ORDG,OREVENT,ORCAT,ORDA
  1.  I $P(^ORD(101.41,+DLG,0),U)="PSO OERR" S ORCAT="O"
  1.  I $P(^ORD(101.41,+DLG,0),U)="PSJ OR PAT OE" S ORCAT="I"
  1.  S ORVP=DFN_";DPT(",ORL(2)=LOC_";SC(",ORL=ORL(2)
  1.  D GETDLG^ORCD(DLG)
  1.  M ORDIALOG=RSP S ORDIALOG=DLG
  1.  I ORWDACT="N" D
  1.  . D EN^ORCSAVE
  1.  . S Y="" I ORIFN D GETBYIFN^ORWORR(.Y,ORIFN)
  1.  I $P(ORWDACT,U,1)="E" D
  1.  . S ORIFN=+$P(ORWDACT,U,2) D XX^ORCSAVE
  1.  . S Y="" S ORIFN=+$P(ORWDACT,U,2)_";"_ORDA D GETBYIFN^ORWORR(.Y,ORIFN)
  1.  Q
  1. SIGN(ERRLST,DFN,ORNP,LOC,ORWSIGN) ; procedure
  1.  ; Sign orders (ORIFN;ACT^RELSTS^SIGSTS^NATR)
  1.  N ORVP,ORL,IDX,ANERROR,ERRCNT
  1.  S ORVP=DFN_";DPT(",ORL(2)=LOC_";SC(",ORL=ORL(2),ERRCNT=0
  1.  I '$D(^XUSEC("ORES",DUZ)) S ERRLST(1)=0_U_"Must have ORES key." Q
  1.  S IDX=0 F  S IDX=$O(ORWSIGN(IDX)) Q:'IDX  S X=ORWSIGN(IDX) D
  1.  . ; ** change NATR when GUI changed to pass Nature in 4th piece
  1.  . S ORIFN=$P(X,U),RELSTS=$P(X,U,2),SIGSTS=$P(X,U,3),NATR="E" ;$P(X,U,4)
  1.  . I SIGSTS=2 D NOTIF^ORCSIGN S ANERROR=""
  1.  . I SIGSTS'=2 D EN^ORCSEND(ORIFN,"",SIGSTS,RELSTS,NATR,"",.ANERROR)
  1.  . I $L(ANERROR) D  Q           ; don't print if an error occurred
  1.  . . S ERRCNT=ERRCNT+1,ERRLST(ERRCNT)=$P(ORWSIGN(IDX),U)_U_ANERROR
  1.  . . K ORWSIGN(IDX)
  1.  . I RELSTS=0 K ORWSIGN(IDX) Q  ; don't print if unreleased
  1.  . S ORWSIGN(IDX)=$P(ORWSIGN(IDX),U)
  1.  D PRINTS^ORWD1(.ORWSIGN,LOC)
  1.  Q
  1. VALIDACT(VAL,ORIFN,ACTION) ;procedure
  1.  ; Return 1 if action is valid for this order, otherwise 0^error
  1.  S VAL=$$VALID^ORCACT0(ORIFN,ACTION,.ERR)
  1.  I VAL=0 S VAL=VAL_U_ERR
  1.  Q
  1. SAVEACT(LST,ORIFN,ACTION,REASON,DFN,ORNP,LOC) ;procedure
  1.  ; Save this action for the order (it is still unsigned/unreleased)
  1.  N ORDIALOG,ORL,ORVP,ORDUZ,ORSTS,ORDG,OREVENT,ACTDA,SIGSTS,RELSTS,ASTS
  1.  S ORVP=DFN_";DPT(",ORL(2)=LOC_";SC("
  1.  S SIGSTS=2,RELSTS=11
  1.  I '$P(ORIFN,";",2) S $P(ORIFN,";",2)=1
  1.  I (ACTION="FL")!(ACTION="UF")!(ACTION="WC") S SIGSTS=3,RELSTS=""
  1.  S ASTS=$P(^OR(100,+ORIFN,8,+$P(ORIFN,";",2),0),U,15)
  1.  I ACTION="DC",((ASTS=10)!(ASTS=11)) D  Q       ; exit here if DELETE
  1.  . D GETBYIFN^ORWORR(.LST,ORIFN)
  1.  . S $P(LST(1),U,1)="~0",LST(2)="tDELETED - "_$E(LST(2),2,245)
  1.  . D CANCEL^ORCSAVE2(ORIFN)
  1.  ;
  1.  ; the only valid action for ActDA>1 is deletion, so only orders 
  1.  ; identified by ORIFN;1 should reach this point
  1.  ;
  1.  I $P(ORIFN,";",2)>1 S $ECODE=",Uorder action invalid," Q
  1.  I ACTION="FL" S $P(^OR(100,+ORIFN,6),U,1)=1
  1.  I ACTION="UF" S $P(^OR(100,+ORIFN,6),U,1)=0
  1.  I ACTION'="RN" D
  1.  . S ACTDA=$$ACTION^ORCSAVE(ACTION,+ORIFN,ORNP,REASON)
  1.  I ACTION="RN" D
  1.  . N ORDA,ORDIALOG,PRMT,SAVIFN,X0
  1.  . S SAVIFN=+ORIFN,X0=^OR(100,+ORIFN,0)
  1.  . I $P(X0,U,5)["101.41," D                        ; version 3
  1.  . . S ORDIALOG=+$P(X0,U,5),ORCAT=$P(^OR(100,+ORIFN,0),U,12)
  1.  . . D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN)
  1.  . E  D                                            ; version 2.5 generic
  1.  . . S ORDIALOG=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDE",0))
  1.  . . D GETDLG^ORCD(ORDIALOG)
  1.  . . S PRMT=$O(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0))
  1.  . . S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1))
  1.  . . M ^TMP("ORWORD",$J,PRMT,1)=^OR(100,+ORIFN,1)
  1.  . . S PRMT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
  1.  . . I $P(X0,U,9) S ORDIALOG(PRMT,1)=$P(X0,U,9)
  1.  . D RN^ORCSAVE I 'ORIFN S $ECODE=",UCPRS renew order,"
  1.  . S ACTDA=ORDA,ORIFN=SAVIFN
  1.  I (ACTION="FL")!(ACTION="UF") S ACTDA=1
  1.  D GETBYIFN^ORWORR(.LST,+ORIFN_";"_ACTDA)
  1.  S $P(LST(1),U,12)=ACTDA
  1.  Q