52 lines
1.8 KiB
Mathematica
52 lines
1.8 KiB
Mathematica
DGPMUTL ;ALB/MJK - SELECT PATIENT MOVEMENT FOR PATIENT ; 3/24/90 1PM ;
|
|
;;5.3;Registration;;Aug 13, 1993
|
|
;
|
|
EN ; -- sets DIC and DIC(0) before calling DFN (*** FOR MAS USE ONLY ***)
|
|
; input: DFN
|
|
; All desired DIC variables except DIC and DIC(0)
|
|
; output: Y, X, DTOUT, DUOUT as defined by FM documentation for ^DIC
|
|
;
|
|
S DIC="^DGPM(",DIC(0)="QES" D DFN
|
|
Q
|
|
;
|
|
DFN ; -- select mvt for DFN patient (*** FOR MAS USE ONLY ***)
|
|
; input: DFN
|
|
; All desired DIC variables
|
|
; output: Y, X, DTOUT, DUOUT as defined by FM documentation for ^DIC
|
|
;
|
|
S Y=-1,X="" G DFNQ:'$D(^DPT(DFN,0)) S X=^(0)
|
|
W !,$S($D(DIC("A")):DIC("A"),1:"Select Movement for "_$P(X,"^")_": ") I $D(DIC("B")) W DIC("B")_"// "
|
|
R X:DTIME I '$T S DTOUT="",Y=-1,X="" G DFNQ
|
|
I X="",$D(DIC("B")) S X=DIC("B")
|
|
I "^"[X S Y=-1 S:X="^" DUOUT="" G DFNQ
|
|
I $E(X)["?" D DIC G DFN
|
|
I X'=" ",$E(X)'="`" S %DT="ETP" D ^%DT K %DT G DFNQ:$D(DTOUT),DFN:+Y<0 S X=Y
|
|
D DIC G DFNQ:$D(DTOUT),DFN:+Y<0
|
|
DFNQ K D Q
|
|
;
|
|
DIC ;
|
|
F %="A","M","N" S:DIC(0)[% DIC(0)=$P(DIC(0),%)_$P(DIC(0),%,2)
|
|
S D="ADFN"_DFN D IX^DIC
|
|
Q
|
|
;
|
|
WARD ; -- determine ward at discharge
|
|
; o called by WARD AT DISCHARGE(c) field in pt mvt file
|
|
; input: D0 := d/c ifn of pat. mvt. file
|
|
;output: X := ward name
|
|
;
|
|
S X="" N IDT,MVT,CA,DFN,M
|
|
G WARDQ:'$D(^DGPM(D0,0)) S M=^(0) G WARDQ:$P(M,U,2)'=3
|
|
S CA=+$P(M,U,14),DFN=+$P(M,U,3)
|
|
F IDT=0:0 S IDT=$O(^DGPM("APMV",DFN,CA,IDT)) Q:'IDT F MVT=0:0 S MVT=$O(^DGPM("APMV",DFN,CA,IDT,MVT)) Q:'MVT I $D(^DGPM(MVT,0)) S M=^(0) I "^13^43^44^45^"'[(U_$P(M,U,18)_U),$D(^DIC(42,+$P(M,U,6),0)) S X=$P(^(0),U) G WARDQ
|
|
WARDQ Q
|
|
;
|
|
PTF(DGPTF) ; -- determine ward at discharge
|
|
; o called by WARD AT DISCHARGE(c) field in PTF file
|
|
; input: DGPTF := ifn of ptf file
|
|
;output: X := ward name
|
|
;
|
|
N D0
|
|
S D0=+$P($G(^DGPM(+$O(^DGPM("APTF",DGPTF,0)),0)),U,17)
|
|
D WARD
|
|
Q
|