DGPTTS0.m

DGPTTS0 ;ALB/MTC - UPDATE FACILITY TREATING SPECIALTY/501 MOVEMENTS IN PTF ; 1/30/90 @12

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;

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

 ;

DGPTTS0   ;ALB/MTC - UPDATE FACILITY TREATING SPECIALTY/501 MOVEMENTS IN PTF ; 1/30/90 @12

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2       ;

EV        ;entry point from event driver

 +1        IF '$DATA(^UTILITY("DGPM",$JOB,6))

               IF '$DATA(^(3))

                   QUIT 

 +2        NEW DGPMCA,DGPMAN,PTF,DGADM

           DO CA^DGPTTS

 +3        IF DGMVT=3

               DO LE^DGPTTS

               GOTO Q1

 +4        IF '$DATA(^UTILITY("DGPM",$JOB,6))

               GOTO Q1

 +5        SET DGMV=$ORDER(^UTILITY("DGPM",$JOB,6,0))

           SET DGMVP=^(DGMV,"P")

           SET DGMVA=^("A")

 +6        IF DGMVT=1

               IF DGPMP=""

                   SET DGNEW=""

 +7        IF DGMVT=2

               IF DGPMP=""

                   IF "^13^44^"[("^"_$PIECE(DGPMA,"^",18)_"^")

                       SET DGNEW=""

 +8        IF '$DATA(^DGPT(+PTF,0))

               GOTO Q1

 +9        IF DGMVP=""

               IF (9999999.999999-DGMVA)'=$EXTRACT($ORDER(^DGPM("ATS",DFN,DGPMCA,0)),1,14)

                   DO NTR^DGPTTS

                   DO LE^DGPTTS

                   GOTO Q1

 +10       IF DGMVA=""

               IF DGMVT'=1

                   DO DEL^DGPTTS

                   DO LE^DGPTTS

                   GOTO Q1

 +11       IF ^UTILITY("DGPM",$JOB,6,DGMV,"DXP")'=^("DXA")

               SET DGMVDA=DGPMDA

               SET DGPMDA=DGMV

               IF $DATA(DGNEW)

                   SET DGMSG1="New Admission"

               DO MOV^DGPTMSG1

               SET DGPMDA=DGMVDA

 +12       DO LE^DGPTTS

Q1         KILL DGMVDA,DGMV,DGMVP,DGMVA,DGMVT,X,V,DGNEW,AGE,DGLAST,DGNEXT,DGY,DOB,DQ,DRG,SEX

 +1        QUIT 

 +2       ;