source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNUTL1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1SPNUTL1 ;HISC/DAD-REGISTRY/FIM DELETE ;11/7/95 12:10
2 ;;2.0;Spinal Cord Dysfunction;**14,15,20**;01/02/1997
3EN1 ; *** Delete SCD Registry records
4 S SPNDIC="^SPNL(154,",SPNFILE=154
5 S SPNDIC("W")="W ?36,$$SSN^SPNUTL1(+Y)"
6 S SPNNAME="Registry"
7 D DELETE
8 K SPNEXIT,DA,DR,SPNNAM,DIC,DIR,^TMP($J)
9 Q
10 ;
11EN2 ; *** Delete FIM records
12 S SPNDIC="^SPNL(154.1,",SPNFILE=154.1
13 S SPNDIC("W")="W:$X>36 ! W ?36,$$SSN^SPNUTL1(+Y),?48,$E($$FIMTYPE^SPNUTL1(+Y),1,18),?68,$$FIMDATE^SPNUTL1(+Y)"
14 S SPNNAME="Outcomes"
15 D DELETE
16 K DIC
17 Q
18 ;
19DELETE ; *** Delete a record
20 S (SPNEXIT,SPNCOUNT)=0
21 K ^TMP($J,"SPNUTL1")
22 F D Q:SPNEXIT
23 . K DIC S DIC=SPNDIC,DIC(0)="AEMQZ"
24 . S DIC("A")="Select "_SPNNAME_" Record to Delete: "
25 . S DIC("W")=SPNDIC("W")
26 . W ! D ^DIC S SPND0=+Y,SPNDFN=+$P($G(Y(0)),U)
27 . I SPND0'>0 S SPNEXIT=1 Q
28 . I SPNFILE="154" I $D(^SPNL(154.1,"B",SPNDFN)) D REMOUT Q
29 . K DIR S DIR(0)="YOA",DIR("B")="No"
30 . S DIR("A")="OK to delete this record: "
31 . S DIR("?",1)="Enter Y(es) to delete this record."
32 . S DIR("?",2)="Enter N(o) to leave this record as is."
33 . S DIR("?",3)="Enter ^ to exit this option."
34 . S DIR("?")="Enter Y(es), N(o), or ^."
35 . W ! D ^DIR S SPNLDEL=Y
36 . I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S SPNEXIT=1 Q
37 . I SPNLDEL'>0 Q
38 . S SPNCOUNT=SPNCOUNT+1
39 . S X=$E($P($G(^DPT(SPNDFN,0)),U,1),1)_$E($P($G(^DPT(SPNDFN,0)),U,9),6,9)
40 . I SPNFILE=154.1 D
41 .. S X=X_$J("",10-$L(X))_$E($$FIMTYPE(SPND0),1,18)
42 .. S X=X_$J("",36-$L(X))_$$FIMDATE(SPND0)
43 .. Q
44 . S ^TMP($J,"SPNUTL1",SPNCOUNT)=X
45 . S DIK=SPNDIC,DA=SPND0
46 . D ^DIK D SEND S SPNEXIT=1
47 . Q:SPNEXIT=1
48 . I SPNFILE=154 D
49 .. S DIK="^SPNL(154.9,",DA=SPND0
50 .. D ^DIK
51 .. D SEND S SPNEXIT=1
52 .. Q
53 . Q
54 Q:SPNEXIT
55SEND ;
56 I SPNCOUNT D
57 . S SPNMLGRP="SPNL SCD COORDINATOR"
58 . W !!,"Sending deletion notification to the "
59 . W SPNMLGRP," mail group...",!
60 . D KILL^XM
61 . S X="The following patient"_$S(SPNCOUNT>1:"s were",1:" was")
62 . S X=X_" deleted from the"
63 . S ^TMP($J,"SPNUTL1",.1)=X
64 . S X=SPNNAME_" file on "_$$FMTE^XLFDT(DT)
65 . S X=X_" by "_$$GET1^DIQ(200,DUZ,.01)
66 . S ^TMP($J,"SPNUTL1",.2)=X
67 . S ^TMP($J,"SPNUTL1",.3)=""
68 . S XMSUB=SPNNAME_" File Deletion Notification"
69 . S XMTEXT="^TMP($J,""SPNUTL1"","
70 . S XMY("G."_SPNMLGRP_"@"_$G(^XMB("NETNAME")))=""
71 . S (XMDUZ,XMDUN)="<SCD Registry Package>"
72 . D ^XMD
73 . Q
74 ;
75 D KILL^XM
76 K D0,DA,DFN,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,SPNCOUNT
77 K SPND0,SPNDFN,SPNDIC,SPNEXIT,SPNFILE,SPNMLGRP,SPNNAME,X,Y
78 K ^TMP($J,"SPNUTL1")
79 Q
80 ;
81SSN(D0) ; *** SSN Identifier
82 N DFN S DFN=+$P($G(^SPNL(SPNFILE,D0,0)),U)
83 Q $$GET1^DIQ(2,DFN,.09)
84 ;
85FIMDATE(D0) ; *** FIM Date Identifier
86 Q $$GET1^DIQ(154.1,D0,.04)
87 ;
88FIMTYPE(D0) ; *** FIM Type Identifier
89 Q $$GET1^DIQ(154.1,D0,.02)
90 Q
91REMOUT ;tag to delete all outcomes on file when the user is deleting the
92 ;ien in 154. Cleans up 154.1
93 Q:'$D(^SPNL(154.1,"B",SPNDFN))
94 W !!,"This patient has Outcome records on file and they must be removed before"
95 W !,"we remove the patient from the REGISTRY file."
96 W !?15,"The removal cannot be reversed!" W !?15,"Do you want to continue?"
97 S %=1 D YN^DICN Q:%=2
98 Q:%'=1
99 S SPNCOUNT=1
100 S SPNFILE=154.1
101 S SPNNAME="Registry & Outcomes"
102 S SPNOUT=0 F S SPNOUT=$O(^SPNL(154.1,"B",SPNDFN,SPNOUT)) Q:(SPNOUT="")!('+SPNOUT) D
103 . I SPNCOUNT=1 S X=$E($P($G(^DPT(SPNDFN,0)),U,1),1)_$E($P($G(^DPT(SPNDFN,0)),U,9),6,9),X=X_$J("",10-$L(X))_"Registry entry",^TMP($J,"SPNUTL1",SPNCOUNT)=X
104 . S X="",SPNCOUNT=SPNCOUNT+1
105 . S SPNCOUNT=SPNCOUNT+1
106 . S X=$E($P($G(^DPT(SPNDFN,0)),U,1),1)_$E($P($G(^DPT(SPNDFN,0)),U,9),6,9)
107 . S X=X_$J("",10-$L(X))_$E($$FIMTYPE(SPNOUT),1,18)
108 . S X=X_$J("",36-$L(X))_$$FIMDATE(SPNOUT)
109 . S ^TMP($J,"SPNUTL1",SPNCOUNT)=X
110 . S DIK="^SPNL(154.1,",DA=SPNOUT
111 . D ^DIK
112 S DIK="^SPNL(154,",DA=SPNDFN
113 D ^DIK
114 D SEND
115 S SPNEXIT=1
116 Q
Note: See TracBrowser for help on using the repository browser.