source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCUP003.m@ 738

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1YSCUP003 ;DALISC/LJA - Pt Move Utils: MATCH, GETMH, GETMOVES ;8/23/94 16:09 [ 08/28/94 12:57 PM ]
2 ;;5.01;MENTAL HEALTH;**2,11,20,29**;Dec 30, 1994
3 ;;
4 ;
5MATCH(ARR,ARR1) ; Call to see if MH data matches Movements data
6 ; YST -- req
7 QUIT:$G(YST)']"" ;->
8 ;
9 ; ARR,ARR1 array data MUST be created by GETMH and GETMOVES
10 ; ARR = MH array (YSMH) ARR1 = Movements array (YSPM)
11 ;
12 ; Admission IEN from last Movement set
13 S YSXEC="S YSMV=$O("_$P(ARR1,")")_",""M"",0))" X YSXEC
14 ;
15 ; Admission IEN from last MH entry
16 S YSXEC="S YSMH=$O("_$P(ARR,")")_",""M"",0))" X YSXEC
17 ;
18 ; YSMHMOV set by GETMOVES,STORE...
19 S YST=YST_U_$G(YSMHMOV)_U_(YSMV>0&(YSMH>0)&(YSMV=YSMH))
20 ;
21 ; Add 5th piece... Any MH wards in ^UTIL data?
22 S YS5=0
23 S LP="^UTILITY(""DGPM"","_$J,END=LP_",",LP=LP_")"
24 F S LP=$Q(@LP) QUIT:LP'[END D
25 . S NODE=@LP,WIEN=+$P(NODE,U,6)
26 . S:$D(^YSG("CEN",+WIEN)) YS5=1
27 S $P(YST,U,5)=YS5
28 ;
29 ; Add 6th piece... Any MH Inpt entries
30 S YST=YST_U_($D(^YSG("INP","C",+YSDFN))>0)
31 QUIT
32 ;
33GETMH(YSDFN,ARR) ; Get all MH entries into 'ARRAY'...
34 ; ARR,YSDFN -- req --> YSNMH + ARRay + YSOK
35 ; ARR Format: YSDATA... Not, YSDATA(
36 S YSOK=0
37 N DFN S DFN=+YSDFN
38 ;
39 I $G(YSDFN)'>0!($G(ARR)']"") QUIT ;-> ... leaving Y=0
40 I ARR'[")" D
41 . S ARR=$E(ARR,1,($L(ARR)-1))_")"
42 K @ARR
43 S YSLMHA=0 ; Admission IEN of last MH Inpt Entry...
44 S YSNMH=0 ;Number of MH entries
45 S YSIEN=0
46 F S YSIEN=$O(^YSG("INP","C",+YSDFN,YSIEN)) QUIT:YSIEN'>0 D
47 . S YS0=$G(^YSG("INP",+YSIEN,0)) QUIT:YS0']"" ;->
48 . S YS7=$G(^YSG("INP",+YSIEN,7)) QUIT:YS7']"" ;->
49 . S YSMOVES=$P(YS7,U,3) QUIT:YSMOVES'>0 ;->
50 . S:$P(YSMOVES,"~",2)=+YSMOVES YSMOVES=+YSMOVES
51 . ; If second piece = 1st piece, it's not a "true" discharge/transfer
52 . S YSNMH=YSNMH+1
53 . S YSOK=1
54 . S YSX=$P(ARR,")")_","_(999-YSNMH)_",0)",@YSX=+YSIEN_"~"_YS0
55 . S YSX=$P(ARR,")")_","_(999-YSNMH)_",7)",@YSX=YS7
56 . S YSLMHA=YSMOVES_U_(999-YSNMH)_U_+YSIEN
57 . QUIT:$P(YSMOVES,"~",2)'>0 ;->
58 S YSX=$P(ARR,")")_","_"""M"""_","_+YSLMHA_")"
59 S @YSX=$P(YSLMHA,U,2,3)
60 QUIT
61 ;
62GETMOVES(YSDFN,ARR) ; Get all existing patient movements into 'ARRAY'...
63 ; ARR,YSDFN -- req --> YSNM + ARRay + YSOK
64 ; ARR Format: YSDATA... Not, YSDATA(
65 ;
66 ; Set YSLMOMH: <L>ast <M>ovement <O>ff <MH> ward...
67 ; If no MH entries found, YSLMOMH => ""
68 ; If MH movement found, YSLMOMH => 0
69 ; If movement off MH ward found, YSLMOMH => # ~ Movement data
70 ; (# = subscript of ^TMP("YSPM",$J,#); Movement data = ^TMP("YSPM",$J,#))
71 S YSLMOMH=""
72 ;
73 ; Set YSFMTMH: <F>irst <M>ovement <T>o <MH> ward...
74 ; If no MH entries found, YSFMTMH => ""
75 ; If MH movement found, YSFMTMH => 0
76 ; If movement off MH ward found, YSFMTMH => # ~ Movement data
77 ; (# = subscript of ^TMP("YSPM",$J,#); Movement data = ^TMP("YSPM",$J,#))
78 S YSFMTMH=""
79 ;
80 S YSMHMOV=0
81 ;
82 N DFN S DFN=+YSDFN
83 S YSOK=0
84 I $G(YSDFN)'>0!($G(ARR)']"") QUIT ;-> ... leaving Y=0
85 K @ARR
86 S YSNM=0 ;Number of movements found...
87 ;
88 ; Get last movement - as starting point
89 S VAIP("D")="LAST"
90 D IN5^VADPT
91 I VAIP(13)<1 QUIT ;-> ... leaving Y=0
92 S YSOK=1
93 D STORE(VAIP(13),+VAIP(13,1),+VAIP(13,2),+VAIP(13,4))
94 S YSLAST=+VAIP(13)
95 ;
96 ; Now, loop thru movements, saving into @ARR...
97 F QUIT:YSLAST'>0!(YSNM>25) D ;Loop until no more movements found...
98 . ; OR movements are > 25...
99 . K VAIP S VAIP("E")=YSLAST
100 . D IN5^VADPT
101 . S YSLAST=VAIP(16) QUIT:YSLAST'>0 ;->
102 . D STORE(+VAIP(16),+VAIP(16,1),+VAIP(16,2),+VAIP(16,4))
103 . I '$D(ZTQUEUED),'$G(DGQUIET) W "."
104 K VAIP
105 ;
106 ; Save 'housekeeping' variables...
107 QUIT
108 ;
109STORE(NO,DT,MT,WN) ; Store movement data into @ARR
110 ; ARR,YSNM -- req
111 ;NO = Movement IEN
112 ;DT = Date/time of movement
113 ;MT = Movement type (1=Admit, 2=Transfer, 3=Discharge)
114 ;WN = Ward IEN
115 ;
116 ; Is movement for a MH ward? If so, set YSMHMOV flag...
117 S:$G(^YSG("CEN",+WN,0))>0 YSMHMOV=1
118 ;
119 QUIT:$G(NO)<1!($G(DT)'?7N.E)!($G(MT)'?1N)!($G(WN)<1) ;->
120 S YSNM=YSNM+1 ;Movement counter
121 S X=$P(ARR,")")_","_(999-YSNM)_")",Y=($G(^YSG("CEN",+WN,0))>0)_U_WN_U_$P($G(^YSG("CEN",+WN,0)),U,9)_U_MT_U_NO_U_DT S @X=Y
122 ;
123 ; On admissions, clean YSM?("M",#) replace with newer admission...
124 I MT=1 D
125 . S X=$P(ARR,")")_","_"""M"""_","_+NO_")" KILL @X ; Kill any YSM?("M",#
126 . S X=$P(ARR,")")_","_"""M"""_","_+NO_")",@X=(999-YSNM)_U_DT ; Make new
127 ; entry...
128 ;
129 ; Set special YSPM-related variables...
130 I ARR["YSPM" D
131 . I $P(Y,U,4)=2 S YSLTRSF=Y ;Save last TRANSFER in YSLTRSF
132 . I $P(Y,U,4)=1 S YSLADM=Y ;Save last ADMISSION in YSLADM
133 . I +Y>0,$P(Y,U,4)'=3 S YSLMOMH=0 ;Movement is onto a MH ward...
134 . I +Y>0,$P(Y,U,4)=3 S YSLMOMH=(999-YSNM)_"~"_Y ; DC from MH ward
135 . I +Y'>0&(YSLMOMH="0") D ;Movement off MH ward found...
136 . . S YSLMOMH=(999-YSNM)_"~"_Y
137 . I +Y>0&(YSFMTMH="") S YSFMTMH=(999-YSNM)_"~"_Y ;1st move to MH
138 . S ^TMP("YSPM",$J,"A",+$P(Y,U,5))=(999-YSNM) ;Movement IEN xref
139 ;
140 QUIT
141 ;
142EOR ;YSCUP003 - Pt Move Utils: MATCH, GETMH, GETMOVES ;8/23/94 16:09
Note: See TracBrowser for help on using the repository browser.