| 1 | DGPMEVT ;ALB/RMO - MAS MOVEMENT EVENT DRIVER; 26 DEC 89 ; 2/2/04 3:18pm
|
|---|
| 2 | ;;5.3;Registration;**61,574**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;Required Variables:
|
|---|
| 5 | ; DFN = Patient's IFN
|
|---|
| 6 | ; DGPMDA = Movement's IFN
|
|---|
| 7 | ; DGPMP = 0 Node of Primary Movement PRIOR to Add/Edit/Delete
|
|---|
| 8 | ; DGPMA = 0 Node of Primary Movement AFTER Add/Edit/Delete
|
|---|
| 9 | ; DGQUIET = If $G(DGQUIET) then the read/writes should not
|
|---|
| 10 | ; occur (optional)
|
|---|
| 11 | ;
|
|---|
| 12 | K DTOUT,DIROUT
|
|---|
| 13 | ; **************************************************************
|
|---|
| 14 | ;-- establish visit & set pt movement ptr
|
|---|
| 15 | I $P($G(^DIC(150.9,1,0)),U,2)["1" D VISIT
|
|---|
| 16 | ; **************************************************************
|
|---|
| 17 | N OROLD D INP^VADPT S X=$O(^ORD(101,"B","DGPM MOVEMENT EVENTS",0))_";ORD(101,"
|
|---|
| 18 | I $P(X,";",1)="" D ERR K VAIN Q
|
|---|
| 19 | D EN1^XQOR K VAIN,X
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ERR ;
|
|---|
| 23 | W !,"Serious error ! DGPM MOVEMENT EVENTS protocol not found"
|
|---|
| 24 | W !,"in Protocol file #101. No events fired !"
|
|---|
| 25 | W !
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | VISIT ;-- create visit file entry for new admissions
|
|---|
| 29 | ;
|
|---|
| 30 | ;-- Loop through ^UTILITY for admissions, if no prior movement
|
|---|
| 31 | ; then new admission. This will capture admissions for ASIH.
|
|---|
| 32 | N DGX,DGY
|
|---|
| 33 | S DGX=""
|
|---|
| 34 | F S DGX=$O(^UTILITY("DGPM",$J,1,DGX)) Q:'DGX D
|
|---|
| 35 | . I $G(^UTILITY("DGPM",$J,1,DGX,"A"))]"",$G(^("P"))="" S DGY=^("A") D
|
|---|
| 36 | .. S DGY=$$NEW(DGX,DGY)
|
|---|
| 37 | .. S ^UTILITY("DGPM",$J,1,DGX,"A")=DGY
|
|---|
| 38 | .. S:DGPMDA=DGX DGPMA=DGY
|
|---|
| 39 | K VSIT
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | NEW(DGPM,DGPMA) ; --- add a new entry, new admit
|
|---|
| 43 | ; INPUT : DGPM - IEN of admission movement
|
|---|
| 44 | ; DGPMA - Oth node of admission movement
|
|---|
| 45 | K VSIT
|
|---|
| 46 | ;
|
|---|
| 47 | ;-- define admission
|
|---|
| 48 | ;
|
|---|
| 49 | ;--location
|
|---|
| 50 | I $D(^DIC(42,+$P(DGPMA,"^",6),44)) S VSIT("LOC")=+^(44)
|
|---|
| 51 | I $D(VSIT("LOC")),'$D(^SC(+VSIT("LOC"),0)) K VSIT("LOC")
|
|---|
| 52 | ;
|
|---|
| 53 | ;--eligibility
|
|---|
| 54 | S VSIT("ELG")=$S(+$P(DGPMA,U,20):+$P(DGPMA,U,20),1:+$G(^DPT($P(DGPMA,U,3),.36)))
|
|---|
| 55 | G:'VSIT("ELG") NEWQ
|
|---|
| 56 | ;
|
|---|
| 57 | ;-- get vt ien
|
|---|
| 58 | S VSIT=+DGPMA,VSIT(0)="F",VSIT("SVC")="H"
|
|---|
| 59 | D ^VSIT
|
|---|
| 60 | ;
|
|---|
| 61 | ;-- add the vt entry to the admission
|
|---|
| 62 | I +$G(VSIT("IEN")) D
|
|---|
| 63 | . S DIE="^DGPM(",DA=+DGPM,DR=".27////"_+VSIT("IEN") D ^DIE
|
|---|
| 64 | . K DIC,DIE,DA,DR
|
|---|
| 65 | . S $P(DGPMA,"^",27)=+VSIT("IEN")
|
|---|
| 66 | ;
|
|---|
| 67 | NEWQ ;
|
|---|
| 68 | K VSIT
|
|---|
| 69 | Q DGPMA
|
|---|
| 70 | ;
|
|---|
