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

DGPTTS0.m

Go to the documentation of this file.
  1. DGPTTS0 ;ALB/MTC - UPDATE FACILITY TREATING SPECIALTY/501 MOVEMENTS IN PTF ; 1/30/90 @12
  1. ;;5.3;Registration;;Aug 13, 1993
  1. ;
  1. EV ;entry point from event driver
  1. I '$D(^UTILITY("DGPM",$J,6)),'$D(^(3)) Q
  1. N DGPMCA,DGPMAN,PTF,DGADM D CA^DGPTTS
  1. I DGMVT=3 D LE^DGPTTS G Q1
  1. I '$D(^UTILITY("DGPM",$J,6)) G Q1
  1. S DGMV=$O(^UTILITY("DGPM",$J,6,0)),DGMVP=^(DGMV,"P"),DGMVA=^("A")
  1. I DGMVT=1,DGPMP="" S DGNEW=""
  1. I DGMVT=2,DGPMP="","^13^44^"[("^"_$P(DGPMA,"^",18)_"^") S DGNEW=""
  1. G Q1:'$D(^DGPT(+PTF,0))
  1. I DGMVP="",(9999999.999999-DGMVA)'=$E($O(^DGPM("ATS",DFN,DGPMCA,0)),1,14) D NTR^DGPTTS,LE^DGPTTS G Q1
  1. I DGMVA="",DGMVT'=1 D DEL^DGPTTS,LE^DGPTTS G Q1
  1. I ^UTILITY("DGPM",$J,6,DGMV,"DXP")'=^("DXA") S DGMVDA=DGPMDA,DGPMDA=DGMV S:$D(DGNEW) DGMSG1="New Admission" D MOV^DGPTMSG1 S DGPMDA=DGMVDA
  1. D LE^DGPTTS
  1. Q1 K DGMVDA,DGMV,DGMVP,DGMVA,DGMVT,X,V,DGNEW,AGE,DGLAST,DGNEXT,DGY,DOB,DQ,DRG,SEX
  1. Q
  1. ;