DVBAADM1 ;ALB ISC/THM-CHECK FOR ADMISSION TO HOSPITAL ;21 JUL 89
;;2.7;AMIE;;Apr 10, 1995
S DVBAX=0,DVBAX=$O(^DGPM("APTT1",DFN,DVBAX)) G INP:DVBAX'>0 S ADM=1 Q
;
INP K DVBAX D STATUS I '$D(ADM) Q
Q
STATUS ;PATIENT STATUS
S:'$D(DOCTYPE) DOCTYPE="A" I DOCTYPE="A",'$D(ADM) W *7,!!,"This patient has never been admitted.",!! K Z H 3 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAADM1 349 printed Sep 23, 2025@19:16:12 Page 2
DVBAADM1 ;ALB ISC/THM-CHECK FOR ADMISSION TO HOSPITAL ;21 JUL 89
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 SET DVBAX=0
SET DVBAX=$ORDER(^DGPM("APTT1",DFN,DVBAX))
if DVBAX'>0
GOTO INP
SET ADM=1
QUIT
+3 ;
INP KILL DVBAX
DO STATUS
IF '$DATA(ADM)
QUIT
+1 QUIT
STATUS ;PATIENT STATUS
+1 if '$DATA(DOCTYPE)
SET DOCTYPE="A"
IF DOCTYPE="A"
IF '$DATA(ADM)
WRITE *7,!!,"This patient has never been admitted.",!!
KILL Z
HANG 3
QUIT
+2 QUIT
