source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCUP000.m@ 1638

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

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1YSCUP000 ;DALISC/LJA - Pt Move Utils: Master Logic ;8/23/94 18:04
2 ;;5.01;MENTAL HEALTH;**2,11,20,29**;Dec 30, 1994
3 ;;
4 ;
5CTRL ; Process movements starting here... YSCUP is just the "caller".
6 ;
7 ; Required Variable: DFN
8 ;
9 ; OK to set DFN and call here multiple times. No harm done.
10 ; This can be done to correct any "errant" patient records.
11 ;
12CHKPMOV ; Check type of PIM's movement. If the movement is made from Bed Switch
13 ; [DG SWITCH BED], Provider Change [DGPM PROVIDER CHANGE],
14 ; Check-in Lodger [DGPM CHECK-IN] OR Lodger Check-out [DGPM CHECK-OUT],
15 ; then no MH data is updated.
16 ;
17 S YSMOVOK=1
18 S:$D(ZTQUEUED) ZTREQ="@"
19 I DGPMA="",$D(DGPMP)&($P(DGPMP,U,2)=4)!($P(DGPMP,U,2)=5) D
20 . S YSMOVOK=0
21 E I $D(DGPMA) D
22 . I (($D(DGPMA)&(DGPMP'=""))&($P(DGPMA,U,2)=1)&($P(DGPMA,U,7)'=$P(DGPMP,U,7)))!(($P(DGPMA,U,2)=6))!($P(DGPMA,U,2)=4)!($P(DGPMA,U,2)=5) D
23 . . S YSMOVOK=0
24 QUIT:'YSMOVOK
25 ;
26CHKMOV ;Check movement
27 ;
28 S YSACTS=0 ; Records if Adds, Deletes, or
29 ; Updates occured
30 D CKDFN QUIT:'YSOK ;->
31 N YSMH
32 S YSMH="^TMP(""YSMH"""_","_$J_")"
33 D GETMH^YSCUP003(+YSDFN,YSMH) ; Move MH Entries into ^TMP("YSMH",$J,
34 S YSMHMOV=0
35 N YSPM
36 S YSPM="^TMP(""YSPM"""_","_$J_")"
37 D GETMOVES^YSCUP003(+YSDFN,YSPM) ; Move Latest Inpt Stay info -> ^TMP("YSPM",$J,
38 D STATUS ; Build p(1-2) of YSTatus
39 N YSMH,YSPM
40 S YSMH="^TMP(""YSMH"""_","_$J_")",YSPM="^TMP(""YSPM"""_","_$J_")"
41 D MATCH^YSCUP003(YSMH,YSPM) ; Compare ^TMP("YSPM",$J, to ^TMP("YSMH",$J, data
42 D XTMP^YSCUP004 ; Store ^XTMP data
43 D ACTION ; Create, Edit, or Delete ^YSG("INP",
44 D UPDST^YSCUP004 ; Store latest value of YST in ^XTMP
45 I 'YSACTS D ; If no MH actions, kill ^XTMP data
46 . D CLEAN^YSCUP004
47 . QUIT
48 D NOMH^YSCUP004($G(YSXTMP),1) ; If MH actions, leave 0 node
49 ;
50 QUIT
51 ;
52ACTION ; Perform whatever updating is necessary...
53 QUIT:'$D(YSPM)&('$D(YSMH)) ;->
54 ;
55 ; Active MH Inpatient? (0/1)
56 S YSAMV=+$O(^TMP("YSPM",$J,0)),YSAMV=+$G(^TMP("YSPM",$J,+YSAMV))
57 ;
58 ; MH Inpt entry active now? (0/1)
59 S YSAMH=+$O(^TMP("YSMH",$J,0)),YSAMH=$P($G(^TMP("YSMH",$J,+YSAMH,7)),U,4),YSAMH=(YSAMH>0)
60 ;
61NOMH1 ; If no MH moves, but latest MH Inpt entry from current stay moves...
62 S $P(YST,U,7)="NOMH"
63 I $P(YST,U,3)'>0&($$CURRENT>0) D QUIT ;->
64 . I '$D(ZTQUEUED),'$G(DGQUIET) W !,"No Mental Health wards in current stay... Deleting entry# "
65 . S X=+$O(^TMP("YSMH",$J,0)),YSNO=+$G(^TMP("YSMH",$J,+X,0)) W:YSNO>0&('$D(ZTQUEUED))&('$G(DGQUIET)) +YSNO
66 . I '$D(ZTQUEUED),('$G(DGQUIET)) W "..."
67 . I YSNO>0 D DELETE^YSCUP002(+YSNO)
68 ;
69NOMH2 ; If no MH moves, and latest MH inpt entry NOT from current stay...
70 S $P(YST,U,7)="NOMH2"
71 I $P(YST,U,3)'>0&(+$$CURRENT'>0) D QUIT ;->
72 . S $P(YST,U,7)="NOMH2"
73 . K ^XTMP(YSXTMP)
74 . S YSACTS=0
75 . I '$D(ZTQUEUED),'$G(DGQUIET) W " No MH actions taken..."
76 ;
77DELMH ; Should MH entry be deleted?
78 ; Get Last Movement information...
79 ; ... Movement Type & Movement Number
80 S $P(YST,U,7)="DELMH"
81 S X=+$O(^TMP("YSPM",$J,0)),X=$G(^TMP("YSPM",$J,+X)),YSMT=+$P(X,U,4),YSMOVN=+$P(X,U,5)
82 ; Get Last MH Entry Information...
83 S X=+$O(^TMP("YSMH",$J,0)),X=$G(^TMP("YSMH",$J,+X,7)),YSMHAN=+$P(X,U,3)
84 ; If last movement is a DC, and IEN of last movement is LESS than the
85 ; Admission IEN used to create the last MH Inpatient entry!!!
86 I YSMT=3,YSMHAN>YSMOVN D QUIT ;->
87 . I '$D(ZTQUEUED),'$G(DGQUIET) W !,"No Mental Health wards in current stay... Deleting entry# "
88 . S X=+$O(^TMP("YSMH",$J,0)),YSNO=+$G(^TMP("YSMH",$J,+X,0)) W:(YSNO>0&('$D(ZTQUEUED)))&('$G(DGQUIET)) +YSNO
89 . I '$D(ZTQUEUED),'$G(DGQUIET) W "..."
90 . I YSNO>0 D DELETE^YSCUP002(+YSNO)
91 ;
92MHMOV ; If MH moves, and NO current entry
93 S $P(YST,U,7)="MHMOV"
94 I $P(YST,U,3)>0&(+$$CURRENT'>0) D QUIT ;->
95 .
96 . QUIT:$G(YSFMTMH)']""!($G(YSFMTMH)="0") ;->
97 . I '$D(ZTQUEUED),'$G(DGQUIET) W !,"Creating new Mental Health Inpt file entry..."
98 . D ADD^YSCUP002(+YSFMTMH)
99 . I '$D(ZTQUEUED),'$G(DGQUIET) W $S($G(YSIEN)'>0:" No entry made!",1:" #"_+YSIEN)
100 . QUIT:$G(YSIEN)'>0 ;->
101 . D GETMH^YSCUP003(+YSDFN,"^TMP(""YSMH"","_$J_",") ;Update ^TMP("YSMH",$J, array elements...
102 . S X=+$O(^TMP("YSMH",$J,0)),YSNO=+$G(^TMP("YSMH",$J,+X,0))
103 . I '$D(ZTQUEUED),'$G(DGQUIET) W !,"Updating MH entry ",$S(YSNO>0:"#"_+YSNO,1:""),"..."
104 . D UPDATE^YSCUP001(+$O(^TMP("YSMH",$J,0)),+$O(^TMP("YSPM",$J,0)))
105 ;
106UPDATE ; Update data in last YSMH entry...
107 S $P(YST,U,7)="UPDATE"
108 S X=$$CURRENT I +$P(X,U,2)>0&('$D(ZTQUEUED))&('$G(DGQUIET)) W !,"Updating MH entry# ",+$P(X,U,2),"..."
109 D UPDATE^YSCUP001(+$O(^TMP("YSMH",$J,0)),+$O(^TMP("YSPM",$J,0)))
110 ;
111 QUIT
112CURRENT() ; Is last YSMH entry part of the current stay? (0/Move IEN)
113 ; Returns 0 or Movement IEN of move responsible for MH Inpt creation
114 I +$O(^TMP("YSMH",$J,0))'>0 QUIT 0 ;-> No MH entries exist
115 S YSMH=+$O(^TMP("YSMH",$J,0)),YSNO=+$P($G(^TMP("YSMH",$J,+YSMH,7)),U,3) I YSNO'>0 QUIT 0 ;->
116 S X=$D(^TMP("YSPM",$J,"A",+YSNO)) QUIT:+X'>0 0 ;->
117 S YSMH=+$G(^TMP("YSMH",$J,+YSMH,0)) QUIT:YSMH'>0 0 ;->
118 S X=+$O(^TMP("YSPM",$J,0)),YSC=+$P($G(^TMP("YSPM",$J,+X)),U,4)
119 QUIT +YSNO_U_+YSMH_U_+YSC
120 ;
121STATUS ; MH/Patient Movement Data Status...
122 ; YST is used to track various statuses...
123 ; STATUS^YSCUP000 sets the 1st two pieces...
124 ; MH DATA? ^ MOVEMENT DATA
125 ; MATCH^YSCUP003 sets the third piece. (Ie., Whether there is
126 ; is a match between movements and MH entries.)
127 ;
128 S YST=(YSNMH>0)_U_(YSNM>0)
129 ;
130 QUIT
131 ;
132CKDFN ; DFN check...
133 S YSOK=1
134 S:$G(DFN)>0&($G(YSDFN)'>0) YSDFN=+DFN
135 QUIT:$G(YSDFN)>0 ;->
136 I '$D(ZTQUEUED),'$G(DGQUIET) W !!,$C(7),"The patient DFN is not defined!! Exiting..."
137 H 10
138 S YSOK=0
139 QUIT
140 ;
141EOR ;YSCUP000 - Pt Move Utils: Master Logic ;8/23/94 18:04
Note: See TracBrowser for help on using the repository browser.