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