| 1 | YSCUP002 ;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 | ;
|
|---|
| 5 | DELETE(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 | ;
|
|---|
| 53 | ADD(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 | ;
|
|---|
| 98 | EOR ;YSCUP002 - Pt Move Utils: ADD, DELETE ;8/31/94 11:45
|
|---|
