| [613] | 1 | YSCUP003 ;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 | ;
|
|---|
| 5 | MATCH(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 | ;
|
|---|
| 33 | GETMH(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 | ;
|
|---|
| 62 | GETMOVES(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 | ;
|
|---|
| 109 | STORE(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 | ;
|
|---|
| 142 | EOR ;YSCUP003 - Pt Move Utils: MATCH, GETMH, GETMOVES ;8/23/94 16:09
|
|---|
