DGPMEVT ;ALB/RMO - MAS MOVEMENT EVENT DRIVER; 26 DEC 89 ; 2/2/04 3:18pm
;;5.3;Registration;**61,574**;Aug 13, 1993
;
;Required Variables:
; DFN = Patient's IFN
; DGPMDA = Movement's IFN
; DGPMP = 0 Node of Primary Movement PRIOR to Add/Edit/Delete
; DGPMA = 0 Node of Primary Movement AFTER Add/Edit/Delete
; DGQUIET = If $G(DGQUIET) then the read/writes should not
; occur (optional)
;
K DTOUT,DIROUT
; **************************************************************
;-- establish visit & set pt movement ptr
I $P($G(^DIC(150.9,1,0)),U,2)["1" D VISIT
; **************************************************************
N OROLD D INP^VADPT S X=$O(^ORD(101,"B","DGPM MOVEMENT EVENTS",0))_";ORD(101,"
I $P(X,";",1)="" D ERR K VAIN Q
D EN1^XQOR K VAIN,X
Q
;
ERR ;
W !,"Serious error ! DGPM MOVEMENT EVENTS protocol not found"
W !,"in Protocol file #101. No events fired !"
W !
Q
;
VISIT ;-- create visit file entry for new admissions
;
;-- Loop through ^UTILITY for admissions, if no prior movement
; then new admission. This will capture admissions for ASIH.
N DGX,DGY
S DGX=""
F S DGX=$O(^UTILITY("DGPM",$J,1,DGX)) Q:'DGX D
. I $G(^UTILITY("DGPM",$J,1,DGX,"A"))]"",$G(^("P"))="" S DGY=^("A") D
.. S DGY=$$NEW(DGX,DGY)
.. S ^UTILITY("DGPM",$J,1,DGX,"A")=DGY
.. S:DGPMDA=DGX DGPMA=DGY
K VSIT
Q
;
NEW(DGPM,DGPMA) ; --- add a new entry, new admit
; INPUT : DGPM - IEN of admission movement
; DGPMA - Oth node of admission movement
K VSIT
;
;-- define admission
;
;--location
I $D(^DIC(42,+$P(DGPMA,"^",6),44)) S VSIT("LOC")=+^(44)
I $D(VSIT("LOC")),'$D(^SC(+VSIT("LOC"),0)) K VSIT("LOC")
;
;--eligibility
S VSIT("ELG")=$S(+$P(DGPMA,U,20):+$P(DGPMA,U,20),1:+$G(^DPT($P(DGPMA,U,3),.36)))
G:'VSIT("ELG") NEWQ
;
;-- get vt ien
S VSIT=+DGPMA,VSIT(0)="F",VSIT("SVC")="H"
D ^VSIT
;
;-- add the vt entry to the admission
I +$G(VSIT("IEN")) D
. S DIE="^DGPM(",DA=+DGPM,DR=".27////"_+VSIT("IEN") D ^DIE
. K DIC,DIE,DA,DR
. S $P(DGPMA,"^",27)=+VSIT("IEN")
;
NEWQ ;
K VSIT
Q DGPMA
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMEVT 2185 printed Sep 23, 2025@20:25:22 Page 2
DGPMEVT ;ALB/RMO - MAS MOVEMENT EVENT DRIVER; 26 DEC 89 ; 2/2/04 3:18pm
+1 ;;5.3;Registration;**61,574**;Aug 13, 1993
+2 ;
+3 ;Required Variables:
+4 ; DFN = Patient's IFN
+5 ; DGPMDA = Movement's IFN
+6 ; DGPMP = 0 Node of Primary Movement PRIOR to Add/Edit/Delete
+7 ; DGPMA = 0 Node of Primary Movement AFTER Add/Edit/Delete
+8 ; DGQUIET = If $G(DGQUIET) then the read/writes should not
+9 ; occur (optional)
+10 ;
+11 KILL DTOUT,DIROUT
+12 ; **************************************************************
+13 ;-- establish visit & set pt movement ptr
+14 IF $PIECE($GET(^DIC(150.9,1,0)),U,2)["1"
DO VISIT
+15 ; **************************************************************
+16 NEW OROLD
DO INP^VADPT
SET X=$ORDER(^ORD(101,"B","DGPM MOVEMENT EVENTS",0))_";ORD(101,"
+17 IF $PIECE(X,";",1)=""
DO ERR
KILL VAIN
QUIT
+18 DO EN1^XQOR
KILL VAIN,X
+19 QUIT
+20 ;
ERR ;
+1 WRITE !,"Serious error ! DGPM MOVEMENT EVENTS protocol not found"
+2 WRITE !,"in Protocol file #101. No events fired !"
+3 WRITE !
+4 QUIT
+5 ;
VISIT ;-- create visit file entry for new admissions
+1 ;
+2 ;-- Loop through ^UTILITY for admissions, if no prior movement
+3 ; then new admission. This will capture admissions for ASIH.
+4 NEW DGX,DGY
+5 SET DGX=""
+6 FOR
SET DGX=$ORDER(^UTILITY("DGPM",$JOB,1,DGX))
if 'DGX
QUIT
Begin DoDot:1
+7 IF $GET(^UTILITY("DGPM",$JOB,1,DGX,"A"))]""
IF $GET(^("P"))=""
SET DGY=^("A")
Begin DoDot:2
+8 SET DGY=$$NEW(DGX,DGY)
+9 SET ^UTILITY("DGPM",$JOB,1,DGX,"A")=DGY
+10 if DGPMDA=DGX
SET DGPMA=DGY
End DoDot:2
End DoDot:1
+11 KILL VSIT
+12 QUIT
+13 ;
NEW(DGPM,DGPMA) ; --- add a new entry, new admit
+1 ; INPUT : DGPM - IEN of admission movement
+2 ; DGPMA - Oth node of admission movement
+3 KILL VSIT
+4 ;
+5 ;-- define admission
+6 ;
+7 ;--location
+8 IF $DATA(^DIC(42,+$PIECE(DGPMA,"^",6),44))
SET VSIT("LOC")=+^(44)
+9 IF $DATA(VSIT("LOC"))
IF '$DATA(^SC(+VSIT("LOC"),0))
KILL VSIT("LOC")
+10 ;
+11 ;--eligibility
+12 SET VSIT("ELG")=$SELECT(+$PIECE(DGPMA,U,20):+$PIECE(DGPMA,U,20),1:+$GET(^DPT($PIECE(DGPMA,U,3),.36)))
+13 if 'VSIT("ELG")
GOTO NEWQ
+14 ;
+15 ;-- get vt ien
+16 SET VSIT=+DGPMA
SET VSIT(0)="F"
SET VSIT("SVC")="H"
+17 DO ^VSIT
+18 ;
+19 ;-- add the vt entry to the admission
+20 IF +$GET(VSIT("IEN"))
Begin DoDot:1
+21 SET DIE="^DGPM("
SET DA=+DGPM
SET DR=".27////"_+VSIT("IEN")
DO ^DIE
+22 KILL DIC,DIE,DA,DR
+23 SET $PIECE(DGPMA,"^",27)=+VSIT("IEN")
End DoDot:1
+24 ;
NEWQ ;
+1 KILL VSIT
+2 QUIT DGPMA
+3 ;
