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