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

DGPMUTL.m

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