| [613] | 1 | DGPMUTL ;ALB/MJK - SELECT PATIENT MOVEMENT FOR PATIENT ; 3/24/90 1PM ;
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; -- 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 | ;
|
|---|
| 12 | DFN ; -- 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
|
|---|
| 25 | DFNQ K D Q
|
|---|
| 26 | ;
|
|---|
| 27 | DIC ;
|
|---|
| 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 | ;
|
|---|
| 32 | WARD ; -- 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
|
|---|
| 41 | WARDQ Q
|
|---|
| 42 | ;
|
|---|
| 43 | PTF(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
|
|---|
