DVBAADM1.m

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 ---DVBAADM1   349     printed  Apr 09, 2024@20:51:16                                                                                                                                                                                                     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