source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMEVT.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1DGPMEVT ;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 ;
22ERR ;
23 W !,"Serious error ! DGPM MOVEMENT EVENTS protocol not found"
24 W !,"in Protocol file #101. No events fired !"
25 W !
26 Q
27 ;
28VISIT ;-- 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 ;
42NEW(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 ;
67NEWQ ;
68 K VSIT
69 Q DGPMA
70 ;
Note: See TracBrowser for help on using the repository browser.