- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTTS0 907 printed Jan 18, 2025@03:54:24 Page 2
- DGPTTS0 ;ALB/MTC - UPDATE FACILITY TREATING SPECIALTY/501 MOVEMENTS IN PTF ; 1/30/90 @12
- +1 ;;5.3;Registration;;Aug 13, 1993
- +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 ;