- GMRVADM ;HIRMFO/YH-Determine Patient's Admission, Discharge and Absence Status ;10/1/96
- ;;4.0;Vitals/Measurements;;Apr 25, 1997
- EN1 ; THIS PROCEDURE RETURNS GMROK=0 IF PATIENT IS IN HOSPITAL, ELSE
- ; IT RETURNS GMROK=1.
- I $D(GASSES) S GMROK=0 Q
- S GMROK=0,GENTR=1 D NOW^%DTC
- ADM ; SAME AS EN1, BUT USES PATIENT'S LAST ADMISSION.
- S GMROK=0 I '$D(^DGPM("ATID1",DFN)) G Q
- ;OBTAIN THE LAST ADMISSION IFN
- S GMRADM=0,GMRADM=$O(^DGPM("ATID1",DFN,GMRADM)) I 'GMRADM G Q
- I GENTR=2 S VAIP("D")="LAST" D IN5^VADPT S GMRWARD(1)=$P(VAIP(5),"^",2),GMRWARD=$P(VAIP(5),"^")
- ;CHECK FOR ABSENCE & PASS
- S VAIP("D")=GDT D IN5^VADPT,DEM^VADPT K VAIP("D")
- I VADM(6)>0 W !!,$P(VADM(1),"^")_" died on "_$P(VADM(6),"^",2) S GMROK=2 G Q
- I $G(VAIP(10))=0 W !!,VADM(1)_" on "_$P($G(VAIP(4)),"^",2)_" started on "_$P($G(VAIP(3)),"^",2),! S GMROK=1
- Q K D1,GT,GDG1,GDG2,GVERS,GMRDIS,GMRADM,GENTR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVADM 896 printed Feb 18, 2025@23:22:20 Page 2
- GMRVADM ;HIRMFO/YH-Determine Patient's Admission, Discharge and Absence Status ;10/1/96
- +1 ;;4.0;Vitals/Measurements;;Apr 25, 1997
- EN1 ; THIS PROCEDURE RETURNS GMROK=0 IF PATIENT IS IN HOSPITAL, ELSE
- +1 ; IT RETURNS GMROK=1.
- +2 IF $DATA(GASSES)
- SET GMROK=0
- QUIT
- +3 SET GMROK=0
- SET GENTR=1
- DO NOW^%DTC
- ADM ; SAME AS EN1, BUT USES PATIENT'S LAST ADMISSION.
- +1 SET GMROK=0
- IF '$DATA(^DGPM("ATID1",DFN))
- GOTO Q
- +2 ;OBTAIN THE LAST ADMISSION IFN
- +3 SET GMRADM=0
- SET GMRADM=$ORDER(^DGPM("ATID1",DFN,GMRADM))
- IF 'GMRADM
- GOTO Q
- +4 IF GENTR=2
- SET VAIP("D")="LAST"
- DO IN5^VADPT
- SET GMRWARD(1)=$PIECE(VAIP(5),"^",2)
- SET GMRWARD=$PIECE(VAIP(5),"^")
- +5 ;CHECK FOR ABSENCE & PASS
- +6 SET VAIP("D")=GDT
- DO IN5^VADPT
- DO DEM^VADPT
- KILL VAIP("D")
- +7 IF VADM(6)>0
- WRITE !!,$PIECE(VADM(1),"^")_" died on "_$PIECE(VADM(6),"^",2)
- SET GMROK=2
- GOTO Q
- +8 IF $GET(VAIP(10))=0
- WRITE !!,VADM(1)_" on "_$PIECE($GET(VAIP(4)),"^",2)_" started on "_$PIECE($GET(VAIP(3)),"^",2),!
- SET GMROK=1
- Q KILL D1,GT,GDG1,GDG2,GVERS,GMRDIS,GMRADM,GENTR
- +1 QUIT