source: FOIAVistA/tag/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCUP004.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1YSCUP004 ;DALISC/LJA - Pt Move Utils: XTMP Logic ;9/16/94 10:55
2 ;;5.01;MENTAL HEALTH;**2,11**;Dec 30, 1994
3 ;;
4 ;
5REFMH ; ^TMP("YSMH",$J, data created after initial ^XTMP storage. Refresh...
6 ; Store YSMH global data...
7 I $O(^TMP("YSMH",$J,0)) D
8 . S %X="^TMP(""YSMH"","_$J_","
9 . S %Y="^XTMP("""_YSXTMP_""",""YSMH"","
10 . D %XY^%RCR
11 QUIT
12 ;
13XTMP ; Create XTMP global entry.
14 ; (Call after all vars defined, but before any actions...)
15 ;
16 QUIT:$G(YSDFN)'>0 ;->
17 ;
18 ; Get 1st subscript for XTMP data (ie., YSXTMP) ...
19 D STRIPVAR
20 S YSLR="""YSDGPM"_+YSDFN_"~0"""
21 S (X,YSEND)="^XTMP(""YSDGPM"_+YSDFN_"~",YSLP=X_""")"
22 F S (X,YSLP)=$Q(@YSLP) QUIT:YSLP']"" X YSTRIP QUIT:Y'[YSEND S YSLR=$P(YSLP,"(",2,999)
23 S X=+$P(YSLR,"~",2)+1,Y=$L(X),YSNO=$E("0000",1,4-Y)_+X
24 S YSXTMP="YSDGPM"_+YSDFN_"~"_YSNO
25 ;
26 ; Create ^XTMP(YSXTMP,0) node...
27 S X1=DT,X2=1 D C^%DTC S YSPURDT=X
28 D NOW^%DTC S YSNOW=%
29 S ^XTMP(YSXTMP,0)=YSPURDT_U_DT_U_"MH A/D/T Movement Utility (called by ^YSCUP)"_U_$G(DUZ)_U_$P($G(XQY0),U)_U_$P($G(XQY0),U,2)_U_YSNOW
30 ;
31 ; Store ^UTILITY movement data...
32 I $D(^UTILITY("DGPM",$J)) D
33 . S %X="^UTILITY(""DGPM"","_$J_","
34 . S %Y="^XTMP("""_YSXTMP_""",""DGPM"","
35 . D %XY^%RCR
36 ;
37 ; Store YSMH global data...
38 I $O(^TMP("YSMH",$J,0)) D
39 . S %X="^TMP(""YSMH"","_$J_","
40 . S %Y="^XTMP("""_YSXTMP_""",""YSMH"","
41 . D %XY^%RCR
42 ;
43 ; Store YSPM global data...
44 I $O(^TMP("YSPM",$J,0)) D
45 . S %X="^TMP(""YSPM"","_$J_","
46 . S %Y="^XTMP("""_YSXTMP_""",""YSPM"","
47 . D %XY^%RCR
48 ;
49 ; Store miscellaneous other local variables
50 S ^XTMP(YSXTMP,"VAR")=$G(YSMH)_U_$G(YSMHMOV)_U_$G(YSMOVES)_U_$G(YSMV)_U_$G(YSNM)_U_$G(YSNMH)
51 S ^XTMP(YSXTMP,"LTRSF")=$G(YSLTRSF) ;Last Transfer movement
52 S ^XTMP(YSXTMP,"LADM")=$G(YSLADM) ; Last Admit movement
53 S ^XTMP(YSXTMP,"YSLMOMH")=$G(YSLMOMH) ;Last movement off MH ward
54 S ^XTMP(YSXTMP,"YSFMTMH")=$G(YSFMTMH) ;First move to MH ward
55 ;
56 QUIT
57 ;
58CLEAN ; Clean up unneeded entries in the ^XTMP entry...
59 QUIT:'$D(^XTMP($G(YSXTMP))) ;->
60 ;
61 K ^XTMP(YSXTMP,"STATUS")
62 ;
63 QUIT
64 ;
65UPDST ; p(7) of YST set in UPDATE^YSCUP000. Store newest value in ^XTMP...
66 S ^XTMP(YSXTMP,"STATUS")=$G(YST)
67 QUIT
68 ;
69SHOWPT ; Show all ^XTMP data for one patient
70 ; Undocumented, unsupported call...
71 ;
72 N DA,DIC,Y,YSDFN,YSEND,YSLAST,YSLP,YSTRIP
73 S YSLAST=""
74 D STRIPVAR
75 ;
76 W !
77 F S YSOK=0 D QUIT:'YSOK W !! ;->
78 . K DA,DIC,Y
79 . S DIC=2,DIC(0)="AEMQ",DIC("A")="Select PATIENT: "
80 . D ^DIC
81 . QUIT:+Y'>0 ;->
82 . S YSOK=1
83 . S YSDFN=+Y
84 . S YSLP="^XTMP(""YSDGPM"_+YSDFN,YSEND=YSLP_"~",YSLP=YSLP_""")"
85 . F S (X,YSLP)=$Q(@YSLP) X YSTRIP QUIT:Y'[YSEND S YSY=Y D
86 . . I $P($P(YSY,"(",2),",")'=YSLAST,YSLAST]"" D
87 . . . R !,X:DTIME I X[U S YSOK=0 QUIT ;->
88 . . W !,YSY," = ",@YSY
89 . . S YSLAST=$P($P(YSY,"(",2),",")
90 QUIT
91 ;
92DELDATA ; Delete ALL ^XTMP("YSDGPM"... data!!!
93 N DIR,X,Y,YSLP
94 D STRIPVAR
95 ;
96 ; Does any MH ^XTMP data exist?
97 S X="^XTMP(""YSDGPM"")",(X,YSLP)=$Q(@X) X YSTRIP I Y'["YSDGPM" D QUIT ;->
98 . W !!,"No ^XTMP(""YSDGPM""... data exists!!"
99 . H 2
100 ;
101 ; Explain...
102 W @IOF,!,?25,"^XTMP(""YSDGPM"" Data Deletion",!,$$REPEAT^XLFSTR("=",IOM),!!
103 W !,"The YS PATIENT MOVEMENTS Mental Health protocol creates ^XTMP(""YSDGPM"""
104 W !,"data for every movement involving a Mental Health patient. This data"
105 W !,"is used for audit purposes. It can be deleted at any time without "
106 W !,"deleterious effects on the Mental Health package.",!!
107 ;
108 ; OK to delete it?
109 S DIR(0)="YO",DIR("A")="OK to delete ^XTMP(""YSDGPM"", data"
110 D ^DIR
111 I +Y'=1 D QUIT ;->
112 . W !!,"No action taken..."
113 . H 2
114 ;
115 ; OK to delete. Do it...
116 K @YSLP
117 F S (X,YSLP)=$Q(@YSLP) QUIT:X']"" X YSTRIP QUIT:Y'["YSDGPM" KILL @YSLP W "."
118 W !!,"All data deleted..." H 2
119 QUIT
120 ;
121NOMH(YSXTMP,YSVDT) ; Kill all but 0 node & set Vapor date to T+YSVDT...
122 N X1,X2,YS0,YSDT,YSX
123 QUIT:'$D(^XTMP($G(YSXTMP))) ;->
124 ;
125 ; Set Vaporization Date Variable...
126 S YSVDT=$S($G(YSVDT)>0:+YSVDT,1:2)
127 ;
128 ; Get actual vaporization date...
129 S (X1,YS0)=$G(^XTMP(YSXTMP,0)) QUIT:YS0']"" ;->
130 S YSDT=+YS0 QUIT:YSDT'?7N ;->
131 S X2=+YSVDT
132 D C^%DTC
133 S YSDT=+X\1 QUIT:+YSDT'?7N ;->
134 ;
135 ; All OK. Kill data and reset 0 node...
136 K ^XTMP(YSXTMP)
137 S $P(YS0,U,1)=YSDT
138 S ^XTMP(YSXTMP,0)=YS0
139 QUIT
140 ;
141STRIPVAR ; Xecutable to strip extended reference from global.
142 ; MSM returns ^[VAH,JDV]DPT(... if translated...
143 ; Places Xecutable code in STRIPVAR - Works on X...
144 ; ^[VAH,JDV]DPT(1,0) --> ^DPT(1,0)
145 ;
146 K YSTRIP
147 S YSTRIP="S Y=""[""_$P($P(X,""["",2),""]"")_""]"",Y=$P(X,Y)_$P(X,Y,2)"
148 QUIT
149 ;
150EOR ;YSCUP004 - Pt Move Utils: XTMP Logic ;9/16/94 10:55
Note: See TracBrowser for help on using the repository browser.