Routine: DGPMEVT

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

ERR ;

 W !,"Serious error ! DGPM MOVEMENT EVENTS protocol not found"

 W !,"in Protocol file #101.  No events fired !"

W !

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

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  Feb 19, 2025@00:15:32                                                                                                                                                                                                     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       ;

DGPMEVT.m