source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCUP002.m@ 1791

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1YSCUP002 ;DALISC/LJA - Pt Move Utils: ADD, DELETE ;8/31/94 11:45
2 ;;5.01;MENTAL HEALTH;**2,11,20,29**;Dec 30, 1994
3 ;;
4 ;
5DELETE(MHIEN) ; Delete ^YSG("INP" entry...
6 QUIT:'$D(^YSG("INP",+MHIEN)) ;->
7 ;
8 S YSACTS=1
9 ;
10 N MH0,MH7,TIEN,WIEN
11 ;
12 ; Set nodes, and record ^XTMP data...
13 S MH0=$G(^YSG("INP",+MHIEN,0))
14 S ^XTMP(YSXTMP,"PRE0-DEL",+MHIEN)=MH0
15 S MH7=$G(^YSG("INP",+MHIEN,7))
16 S ^XTMP(YSXTMP,"PRE7-DEL",+MHIEN)=MH7
17 ;
18 ; Clean up XRefs...
19 ;
20 ; .01 File Entry Date
21 S X=$E($P(MH0,U),1,30) K:X]"" ^YSG("INP","B",X,+MHIEN)
22 ;
23 ; 1 Patient
24 I YSNMH=1 D ;About to delete the ONLY MH Inpt entry...
25 . K ^YSG("INP","C",+$P(MH0,U,2),+MHIEN)
26 . S YSNMH=0
27 ;
28 ; AWC, CP xref
29 S WIEN=+MH7,TIEN=+$P(MH7,U,4)
30 K ^YSG("INP","AWC",+WIEN,+TIEN,+YSDFN)
31 K ^YSG("INP","CP",+YSDFN)
32 ;
33 ; Update AOUT xref
34 I $P(MH7,U,2)]"" K ^YSG("INP","AOUT",9999999-$P(MH7,U,2),+MHIEN)
35 ;
36 ; Delete AST xref...
37 S YSFEDT=+$P(MH0,U),YSFEDT=$S(YSFEDT?7N.E:+YSFEDT\1,1:DT)
38 S X1=+YSFEDT,X2=1 D C^%DTC S YSFEDT=X_".24"
39 S X1=+(YSFEDT\1),X2=-6 D C^%DTC S YSBEDT=X\1
40 I YSBEDT?7N.E D
41 . S YSLP="^YSG(""INP"",""AST"")"
42 . F S YSLP=$Q(@YSLP) QUIT:YSLP']""!(YSLP'["AST")!(+$P(YSLP,",",3)<YSBEDT) D
43 . . QUIT:+$P(YSLP,",",6)'=MHIEN ;->
44 . . K @YSLP
45 . . I '$D(ZTQUEUED),'$G(DGQUIET) W "."
46 ;
47 ; Now, delete entry
48 S DA=+MHIEN,DIK="^YSG(""INP"","
49 D ^DIK
50 ;
51 QUIT
52 ;
53ADD(MOVNO) ; Add ^YSG("INP" entry from MOVE data...
54 S YSIEN=0
55 S MOVE=$G(^TMP("YSPM",$J,+$G(MOVNO)))
56 QUIT:$G(MOVE)']"" ;->
57 ;
58 S YSACTS=1
59 ;
60 N DA,DIC,DIE,DR
61 S YSX=1 F I=2,3,5,6 I $P(MOVE,U,I)']"" S YSX=0
62 I 'YSX D QUIT ;->
63 . I '$D(ZTQUEUED),'$G(DGQUIET) W !!,"Movement data not complete... No Admission made..."
64 ;
65 I '$O(^TMP("YSPM",$J,"M",0)) D QUIT ;->
66 . I '$D(ZTQUEUED),'$G(DGQUIET) W !!,"No action taken..."
67 ; OK data. Make YSG("INP" entry...
68 ; Use ^DGPM's Date/Time for .01 value.
69 S X=+$O(^TMP("YSPM",$J,"M",0)),X=$P(^TMP("YSPM",$J,"M",+X),U,3) ;Use Admission DT
70 I X'?7N.E S X=+$P(MOVE,U,6) ;If not available, use move's DT
71 K DD
72 S DIC="^YSG(""INP"",",DIC(0)="L",DLAYGO=618.4
73 D FILE^DICN
74 QUIT:+Y<0 ;->
75 S YSIEN=+Y
76 ;
77 ; Now, fill in fields...
78 S DA=+YSIEN,DIE="^YSG(""INP"","
79 S DR="1////"_+YSDFN ; Patient
80 I $P(MOVE,U,2)>0 S DR=DR_";20////"_$P(MOVE,U,2) ; Ward
81 I $P(MOVE,U,3)>0 D ; Team
82 . S DR=DR_";3////"_$P(MOVE,U,3)
83 . S DR=DR_";23////"_$P(MOVE,U,3)
84 ;
85 ; Last Admission YSMP( entry... (See STORE^YSCUP003)
86 S YSLADM=$S($P($G(YSLADM),U,5)>0:+$P(YSLADM,U,5),$P(MOVE,U,5)>0:+$P(MOVE,U,5),1:"")
87 I YSLADM S DR=DR_";22///"_+YSLADM_"~" ; Admit pointer
88 I $P(MOVE,U,6)?7N.E S DR=DR_";2////"_$P(MOVE,U,6) ; Unit Entry Date
89 D ^DIE
90 ;
91 ; Now, update ^XTMP...
92 S YSX=$G(^YSG("INP",+YSIEN,0))
93 S:YSX]"" ^XTMP(YSXTMP,"POST0-ADD",+YSIEN)=YSX
94 S YSX=$G(^YSG("INP",+YSIEN,7))
95 S:YSX]"" ^XTMP(YSXTMP,"POST7-ADD",+YSIEN)=YSX
96 QUIT
97 ;
98EOR ;YSCUP002 - Pt Move Utils: ADD, DELETE ;8/31/94 11:45
Note: See TracBrowser for help on using the repository browser.