- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWD.m
r613 r623 1 ORWD ; SLC/KCM - Utilities for Windows Dialogs ;7/2/01 13:312 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242 3 4 DT(Y,X) 5 6 7 PROVKEY(VAL,USERID) 8 9 10 11 KEY(VAL,KEYNAME,USERID) 12 13 14 OI(Y,XREF,DIR,FROM) 15 16 17 18 19 20 21 22 23 24 25 26 27 ODEF(Y,DLG) 28 29 30 31 32 33 34 35 36 37 DEF(Y,DLG) 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 FORMID(VAL,ORIFN) 55 56 57 58 59 60 61 62 GET4EDIT(LST,ORIFN) 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 EXTDT(X) 80 81 82 83 WRLST(Y,TYP) 84 85 86 87 88 89 90 91 92 93 SAVE(Y,DFN,ORNP,LOC,DLG,ORWDACT,RSP) 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 SIGN(ERRLST,DFN,ORNP,LOC,ORWSIGN) 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 VALIDACT(VAL,ORIFN,ACTION) 126 127 128 129 130 SAVEACT(LST,ORIFN,ACTION,REASON,DFN,ORNP,LOC) 131 132 133 134 135 136 137 138 139 140 141 . D CANCEL^ORCSAVE2(ORIFN)142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 1 ORWD ; SLC/KCM - Utilities for Windows Dialogs ;7/26/96 17:53 [ 11/19/96 4:27 PM ] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997 3 ; 4 DT(Y,X) ; Returns internal Fileman Date/Time 5 N %DT S %DT="TS" D ^%DT 6 Q 7 PROVKEY(VAL,USERID) ; Returns 1 if user possesses the provider key 8 N NAM S NAM=$P(^VA(200,USERID,0),U,1) 9 S VAL=$D(^VA(200,"AK.PROVIDER",NAM,USERID)) 10 Q 11 KEY(VAL,KEYNAME,USERID) ; Returns 1 if user possesses the key 12 S VAL=0 I $D(^XUSEC(KEYNAME,USERID)) S VAL=1 13 Q 14 OI(Y,XREF,DIR,FROM) ; Return a bolus of orderable items 15 ; .Return Array, Cross Reference (S.xxx), Direction, Starting Text 16 N I,IEN,CNT S CNT=44 17 ; 18 I DIR=0 D ; Forward direction 19 . F I=1:1:CNT S FROM=$O(^ORD(101.43,XREF,FROM)) Q:FROM="" D 20 . . S Y(I)=$O(^ORD(101.43,XREF,FROM,0))_"^"_FROM 21 . I $G(Y(CNT))="" S Y(I)="" 22 ; 23 I DIR=1 D ; Reverse direction 24 . F I=1:1:CNT S FROM=$O(^ORD(101.43,XREF,FROM),-1) Q:FROM="" D 25 . . S Y(I)=$O(^ORD(101.43,XREF,FROM,0))_"^"_FROM 26 Q 27 ODEF(Y,DLG) ; Return the definition for a dialog 28 Q:'$L(DLG) 29 S DLG=+$O(^ORD(101.41,"B",DLG,0)) 30 Q:$D(^ORD(101.41,DLG,50))<10 31 N I,IEN,IDX 32 S I=0,IDX=0 33 S Y(0)=$P($G(^ORD(101.41,DLG,5)),"^",4) 34 F S I=$O(^ORD(101.41,DLG,50,"AC",I)) Q:I="" S IEN=$O(^(I,0)) D 35 . S IDX=IDX+1,Y(IDX)=$G(^ORD(101.41,DLG,50,IEN,0)) 36 Q 37 DEF(Y,DLG) ; Return format mapping for a dialog 38 ; Y(n): CtrlName^DlgPtr^FmtSeq^Fmt^Omit^Lead^Trail^Mult?^chd1~chd2~... 39 I DLG="NOT IMPLEMENTED" S Y(0)="0^0" Q ; for testing 40 S DLG=$O(^ORD(101.41,"B",DLG,0)) 41 N I,J,K,N,X0,X2,XW,DPTR 42 S Y(0)=$P(^ORD(101.41,DLG,0),U,5)_U_DLG 43 S I=0,N=0 44 F S I=$O(^ORD(101.41,DLG,10,I)) Q:I'>0 D 45 . S X0=$G(^ORD(101.41,DLG,10,I,0)),DPTR=$P(X0,U,2) 46 . S X2=$G(^ORD(101.41,DLG,10,I,2)) 47 . S XW=$G(^ORD(101.41,DLG,10,I,"W")) 48 . S N=N+1,Y(N)=$P(XW,U,1)_U_DPTR_U_X2,CHLD="" 49 . S J=0 F S J=$O(^ORD(101.41,DLG,10,"DAD",DPTR,J)) Q:'J D 50 . . S K=0 F S K=$O(^ORD(101.41,DLG,10,"DAD",DPTR,J,K)) Q:'K D 51 . . . S CHLD=CHLD_$P(^ORD(101.41,DLG,10,K,0),U,2)_"~" 52 . S $P(Y(N),U,8)=CHLD 53 Q 54 FORMID(VAL,ORIFN) ; procedure 55 ; Returns the Dialog Form ID 56 N X 57 S VAL=0,X=$P(^OR(100,+ORIFN,0),U,5) 58 Q:$P(X,";",2)'="ORD(101.41," 59 S VAL=+$P($G(^ORD(101.41,+X,5)),U,5) 60 ; I X S VAL=$P($G(^XTV(8989.52,+X,0)),U,2) 61 Q 62 GET4EDIT(LST,ORIFN) ; procedure 63 ; return responses in format that can be used by dialog 64 N ILST,PRMT,INST,DLG,ORDIALOG S ILST=0 65 I '$D(ORIFN) S LST=0 Q 66 S ORIFN=+ORIFN,DLG=+$P(^OR(100,ORIFN,0),U,5) 67 D GETDLG1^ORCD(DLG),GETORDER^ORCD("^OR(100,"_ORIFN_",4.5)") 68 S PRMT=0 F S PRMT=$O(ORDIALOG(PRMT)) Q:'PRMT D 69 . S INST=0 F S INST=$O(ORDIALOG(PRMT,INST)) Q:'INST D 70 . . S ILST=ILST+1,LST(ILST)="~"_PRMT_U_INST_U_$P(ORDIALOG(PRMT),U,3) 71 . . S ILST=ILST+1,LST(ILST)="d"_ORDIALOG(PRMT,INST) 72 . . I $E(ORDIALOG(PRMT,INST))=U D ; load word processing 73 . . . N I,REF S I=0,REF=ORDIALOG(PRMT,INST) 74 . . . F S I=$O(@REF@(I)) Q:'I S ILST=ILST+1,LST(ILST)="t"_^(I,0) 75 . . E S $P(LST(ILST),U,2)=$$EXT^ORCD(PRMT,INST) ; load external value 76 . . I "R"[$E(ORDIALOG(PRMT,0)) D 77 . . . S $P(LST(ILST),U,2)=$$UP^XLFSTR($$FMTE^XLFDT(ORDIALOG(PRMT,INST))) 78 Q 79 EXTDT(X) ; Return an external date time that can be interpreted by %DT 80 I $E(X)="T" Q "TODAY"_$E(X,2,255) 81 I $E(X)="V" Q "NEXT VISIT"_$E(X,2,255) 82 Q "" 83 WRLST(Y,TYP) ; Return list of dialogs for writing orders 84 ; .Y(n): DlgName^ListBox Text 85 ; TYP: 'I' = inpatient, 'O' = outpatient 86 N PAR,ERR,SEQ,IEN,I,X 87 S PAR=$S(TYP="I":"ORW ADDORD INPT",1:"ORW ADDORD OUTPT") 88 D GETLST^XPAR(.X,"ALL",PAR,"Q",.ERR) Q:ERR 89 S I=0 F S I=$O(X(I)) Q:'I D 90 . S SEQ=$P(X(I),U,1),IEN=$P(X(I),U,2) 91 . S Y(SEQ)=$P(^ORD(101.41,IEN,0),U,1)_U_$P($G(^(5)),U,4) 92 Q 93 SAVE(Y,DFN,ORNP,LOC,DLG,ORWDACT,RSP) ; procedure 94 ; Save order 95 N ORDIALOG,ORL,ORVP,ORIFN,ORDUZ,ORSTS,ORDG,OREVENT,ORCAT,ORDA 96 I $P(^ORD(101.41,+DLG,0),U)="PSO OERR" S ORCAT="O" 97 I $P(^ORD(101.41,+DLG,0),U)="PSJ OR PAT OE" S ORCAT="I" 98 S ORVP=DFN_";DPT(",ORL(2)=LOC_";SC(",ORL=ORL(2) 99 D GETDLG^ORCD(DLG) 100 M ORDIALOG=RSP S ORDIALOG=DLG 101 I ORWDACT="N" D 102 . D EN^ORCSAVE 103 . S Y="" I ORIFN D GETBYIFN^ORWORR(.Y,ORIFN) 104 I $P(ORWDACT,U,1)="E" D 105 . S ORIFN=+$P(ORWDACT,U,2) D XX^ORCSAVE 106 . S Y="" S ORIFN=+$P(ORWDACT,U,2)_";"_ORDA D GETBYIFN^ORWORR(.Y,ORIFN) 107 Q 108 SIGN(ERRLST,DFN,ORNP,LOC,ORWSIGN) ; procedure 109 ; Sign orders (ORIFN;ACT^RELSTS^SIGSTS^NATR) 110 N ORVP,ORL,IDX,ANERROR,ERRCNT 111 S ORVP=DFN_";DPT(",ORL(2)=LOC_";SC(",ORL=ORL(2),ERRCNT=0 112 I '$D(^XUSEC("ORES",DUZ)) S ERRLST(1)=0_U_"Must have ORES key." Q 113 S IDX=0 F S IDX=$O(ORWSIGN(IDX)) Q:'IDX S X=ORWSIGN(IDX) D 114 . ; ** change NATR when GUI changed to pass Nature in 4th piece 115 . S ORIFN=$P(X,U),RELSTS=$P(X,U,2),SIGSTS=$P(X,U,3),NATR="E" ;$P(X,U,4) 116 . I SIGSTS=2 D NOTIF^ORCSIGN S ANERROR="" 117 . I SIGSTS'=2 D EN^ORCSEND(ORIFN,"",SIGSTS,RELSTS,NATR,"",.ANERROR) 118 . I $L(ANERROR) D Q ; don't print if an error occurred 119 . . S ERRCNT=ERRCNT+1,ERRLST(ERRCNT)=$P(ORWSIGN(IDX),U)_U_ANERROR 120 . . K ORWSIGN(IDX) 121 . I RELSTS=0 K ORWSIGN(IDX) Q ; don't print if unreleased 122 . S ORWSIGN(IDX)=$P(ORWSIGN(IDX),U) 123 D PRINTS^ORWD1(.ORWSIGN,LOC) 124 Q 125 VALIDACT(VAL,ORIFN,ACTION) ;procedure 126 ; Return 1 if action is valid for this order, otherwise 0^error 127 S VAL=$$VALID^ORCACT0(ORIFN,ACTION,.ERR) 128 I VAL=0 S VAL=VAL_U_ERR 129 Q 130 SAVEACT(LST,ORIFN,ACTION,REASON,DFN,ORNP,LOC) ;procedure 131 ; Save this action for the order (it is still unsigned/unreleased) 132 N ORDIALOG,ORL,ORVP,ORDUZ,ORSTS,ORDG,OREVENT,ACTDA,SIGSTS,RELSTS,ASTS 133 S ORVP=DFN_";DPT(",ORL(2)=LOC_";SC(" 134 S SIGSTS=2,RELSTS=11 135 I '$P(ORIFN,";",2) S $P(ORIFN,";",2)=1 136 I (ACTION="FL")!(ACTION="UF")!(ACTION="WC") S SIGSTS=3,RELSTS="" 137 S ASTS=$P(^OR(100,+ORIFN,8,+$P(ORIFN,";",2),0),U,15) 138 I ACTION="DC",((ASTS=10)!(ASTS=11)) D Q ; exit here if DELETE 139 . D GETBYIFN^ORWORR(.LST,ORIFN) 140 . S $P(LST(1),U,1)="~0",LST(2)="tDELETED - "_$E(LST(2),2,245) 141 . D DELETE^ORCSAVE2(ORIFN) 142 ; 143 ; the only valid action for ActDA>1 is deletion, so only orders 144 ; identified by ORIFN;1 should reach this point 145 ; 146 I $P(ORIFN,";",2)>1 S $ECODE=",Uorder action invalid," Q 147 I ACTION="FL" S $P(^OR(100,+ORIFN,6),U,1)=1 148 I ACTION="UF" S $P(^OR(100,+ORIFN,6),U,1)=0 149 I ACTION'="RN" D 150 . S ACTDA=$$ACTION^ORCSAVE(ACTION,+ORIFN,ORNP,REASON) 151 I ACTION="RN" D 152 . N ORDA,ORDIALOG,PRMT,SAVIFN,X0 153 . S SAVIFN=+ORIFN,X0=^OR(100,+ORIFN,0) 154 . I $P(X0,U,5)["101.41," D ; version 3 155 . . S ORDIALOG=+$P(X0,U,5),ORCAT=$P(^OR(100,+ORIFN,0),U,12) 156 . . D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN) 157 . E D ; version 2.5 generic 158 . . S ORDIALOG=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDE",0)) 159 . . D GETDLG^ORCD(ORDIALOG) 160 . . S PRMT=$O(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0)) 161 . . S ORDIALOG(PRMT,1)=$NA(^TMP("ORWORD",$J,PRMT,1)) 162 . . M ^TMP("ORWORD",$J,PRMT,1)=^OR(100,+ORIFN,1) 163 . . S PRMT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0)) 164 . . I $P(X0,U,9) S ORDIALOG(PRMT,1)=$P(X0,U,9) 165 . D RN^ORCSAVE I 'ORIFN S $ECODE=",UCPRS renew order," 166 . S ACTDA=ORDA,ORIFN=SAVIFN 167 I (ACTION="FL")!(ACTION="UF") S ACTDA=1 168 D GETBYIFN^ORWORR(.LST,+ORIFN_";"_ACTDA) 169 S $P(LST(1),U,12)=ACTDA 170 Q
Note:
See TracChangeset
for help on using the changeset viewer.
