EDP15P ;PHI/WAR - Close ambulance patients with LOC 0 ; 1/27/21 10:23am
;;2.0;EMERGENCY DEPARTMENT;**15**;JAN 13, 2021;Build 4
;
Q
;
INIT ; Remove ambulance patients with LOC=0 then regular patients.
N BED,LOG,EDPSITE,AREA
S EDPSITE="" F S EDPSITE=$O(^EDP(230,"AL",EDPSITE)) Q:'EDPSITE D
.S AREA="" F S AREA=$O(^EDP(230,"AL",EDPSITE,AREA)) Q:'AREA D
..S BED="" F S BED=$O(^EDP(230,"AL",EDPSITE,AREA,BED)) Q:BED>0 D
...S LOG=0 F S LOG=$O(^EDP(230,"AL",EDPSITE,AREA,BED,LOG)) Q:'LOG D
....I $P($G(^EDP(230,LOG,0)),U,4)'="(ambulance en route)" Q
....D CLREC
....D COMMENT
D RMVPAT
Q
RMVPAT ; Remove LOC=0 patients older than 5 days.
N BED,LOG,EDPSITE,AREA
S EDPSITE="" F S EDPSITE=$O(^EDP(230,"AL",EDPSITE)) Q:'EDPSITE D
.S AREA="" F S AREA=$O(^EDP(230,"AL",EDPSITE,AREA)) Q:'AREA D
..S BED="" F S BED=$O(^EDP(230,"AL",EDPSITE,AREA,BED)) Q:BED>0 D
...S LOG=0 F S LOG=$O(^EDP(230,"AL",EDPSITE,AREA,BED,LOG)) Q:'LOG D
....I $$FMDIFF^XLFDT($$NOW^XLFDT(),$P($G(^EDP(230,LOG,0)),U,1),1)<5 Q
....D CLREC
....D COMMENT
Q
CLREC ; Set CLOSED field to "Yes".
N DIE,DA,DR
S DIE="^EDP(230,",DA=LOG,DR=".07///1"
D ^DIE
Q
N DIE,DA,DR
S DIE="^EDP(230,",DA=LOG,DR="3.8///Entered in error. EDP*2*15"
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDP15P 1329 printed Dec 13, 2024@01:51:22 Page 2
EDP15P ;PHI/WAR - Close ambulance patients with LOC 0 ; 1/27/21 10:23am
+1 ;;2.0;EMERGENCY DEPARTMENT;**15**;JAN 13, 2021;Build 4
+2 ;
+3 QUIT
+4 ;
INIT ; Remove ambulance patients with LOC=0 then regular patients.
+1 NEW BED,LOG,EDPSITE,AREA
+2 SET EDPSITE=""
FOR
SET EDPSITE=$ORDER(^EDP(230,"AL",EDPSITE))
if 'EDPSITE
QUIT
Begin DoDot:1
+3 SET AREA=""
FOR
SET AREA=$ORDER(^EDP(230,"AL",EDPSITE,AREA))
if 'AREA
QUIT
Begin DoDot:2
+4 SET BED=""
FOR
SET BED=$ORDER(^EDP(230,"AL",EDPSITE,AREA,BED))
if BED>0
QUIT
Begin DoDot:3
+5 SET LOG=0
FOR
SET LOG=$ORDER(^EDP(230,"AL",EDPSITE,AREA,BED,LOG))
if 'LOG
QUIT
Begin DoDot:4
+6 IF $PIECE($GET(^EDP(230,LOG,0)),U,4)'="(ambulance en route)"
QUIT
+7 DO CLREC
+8 DO COMMENT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+9 DO RMVPAT
+10 QUIT
RMVPAT ; Remove LOC=0 patients older than 5 days.
+1 NEW BED,LOG,EDPSITE,AREA
+2 SET EDPSITE=""
FOR
SET EDPSITE=$ORDER(^EDP(230,"AL",EDPSITE))
if 'EDPSITE
QUIT
Begin DoDot:1
+3 SET AREA=""
FOR
SET AREA=$ORDER(^EDP(230,"AL",EDPSITE,AREA))
if 'AREA
QUIT
Begin DoDot:2
+4 SET BED=""
FOR
SET BED=$ORDER(^EDP(230,"AL",EDPSITE,AREA,BED))
if BED>0
QUIT
Begin DoDot:3
+5 SET LOG=0
FOR
SET LOG=$ORDER(^EDP(230,"AL",EDPSITE,AREA,BED,LOG))
if 'LOG
QUIT
Begin DoDot:4
+6 IF $$FMDIFF^XLFDT($$NOW^XLFDT(),$PIECE($GET(^EDP(230,LOG,0)),U,1),1)<5
QUIT
+7 DO CLREC
+8 DO COMMENT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
CLREC ; Set CLOSED field to "Yes".
+1 NEW DIE,DA,DR
+2 SET DIE="^EDP(230,"
SET DA=LOG
SET DR=".07///1"
+3 DO ^DIE
+4 QUIT
+1 NEW DIE,DA,DR
+2 SET DIE="^EDP(230,"
SET DA=LOG
SET DR="3.8///Entered in error. EDP*2*15"
+3 DO ^DIE
+4 QUIT
