source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMUTL.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1DGPMUTL ;ALB/MJK - SELECT PATIENT MOVEMENT FOR PATIENT ; 3/24/90 1PM ;
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4EN ; -- sets DIC and DIC(0) before calling DFN (*** FOR MAS USE ONLY ***)
5 ; input: DFN
6 ; All desired DIC variables except DIC and DIC(0)
7 ; output: Y, X, DTOUT, DUOUT as defined by FM documentation for ^DIC
8 ;
9 S DIC="^DGPM(",DIC(0)="QES" D DFN
10 Q
11 ;
12DFN ; -- select mvt for DFN patient (*** FOR MAS USE ONLY ***)
13 ; input: DFN
14 ; All desired DIC variables
15 ; output: Y, X, DTOUT, DUOUT as defined by FM documentation for ^DIC
16 ;
17 S Y=-1,X="" G DFNQ:'$D(^DPT(DFN,0)) S X=^(0)
18 W !,$S($D(DIC("A")):DIC("A"),1:"Select Movement for "_$P(X,"^")_": ") I $D(DIC("B")) W DIC("B")_"// "
19 R X:DTIME I '$T S DTOUT="",Y=-1,X="" G DFNQ
20 I X="",$D(DIC("B")) S X=DIC("B")
21 I "^"[X S Y=-1 S:X="^" DUOUT="" G DFNQ
22 I $E(X)["?" D DIC G DFN
23 I X'=" ",$E(X)'="`" S %DT="ETP" D ^%DT K %DT G DFNQ:$D(DTOUT),DFN:+Y<0 S X=Y
24 D DIC G DFNQ:$D(DTOUT),DFN:+Y<0
25DFNQ K D Q
26 ;
27DIC ;
28 F %="A","M","N" S:DIC(0)[% DIC(0)=$P(DIC(0),%)_$P(DIC(0),%,2)
29 S D="ADFN"_DFN D IX^DIC
30 Q
31 ;
32WARD ; -- determine ward at discharge
33 ; o called by WARD AT DISCHARGE(c) field in pt mvt file
34 ; input: D0 := d/c ifn of pat. mvt. file
35 ;output: X := ward name
36 ;
37 S X="" N IDT,MVT,CA,DFN,M
38 G WARDQ:'$D(^DGPM(D0,0)) S M=^(0) G WARDQ:$P(M,U,2)'=3
39 S CA=+$P(M,U,14),DFN=+$P(M,U,3)
40 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
41WARDQ Q
42 ;
43PTF(DGPTF) ; -- determine ward at discharge
44 ; o called by WARD AT DISCHARGE(c) field in PTF file
45 ; input: DGPTF := ifn of ptf file
46 ;output: X := ward name
47 ;
48 N D0
49 S D0=+$P($G(^DGPM(+$O(^DGPM("APTF",DGPTF,0)),0)),U,17)
50 D WARD
51 Q
Note: See TracBrowser for help on using the repository browser.