source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTTS0.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 888 bytes
Line 
1DGPTTS0 ;ALB/MTC - UPDATE FACILITY TREATING SPECIALTY/501 MOVEMENTS IN PTF ; 1/30/90 @12
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4EV ;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
17Q1 K DGMVDA,DGMV,DGMVP,DGMVA,DGMVT,X,V,DGNEW,AGE,DGLAST,DGNEXT,DGY,DOB,DQ,DRG,SEX
18 Q
19 ;
Note: See TracBrowser for help on using the repository browser.