source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTAPP1.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1DGPTAPP1 ;MTC/ALB - PTF Purge/Archive - Purge Continued ; 21 DEC 1992
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4 ;
5PURGE(TMP) ;-- Purge entry point. This function will loop thru the
6 ; PTF records found in the A/P template pointed to by TMP.
7 ; Starting with the PTF Release file, PTF Close Out file, Census
8 ; Work file and finally the PTF record in file #45.
9 ;
10 ; INPUT : TMP - Entry in PTF A/P History File (Sort Template Pointer)
11 ;
12 N PTF,REC
13 S REC=$P($G(^DGP(45.62,+TMP,0)),U,8) Q:'REC
14 S PTF=0 F S PTF=$O(^DIBT(REC,1,PTF)) Q:'PTF D
15 . D REL(PTF),CLOSE(PTF),CENSUS(PTF),DELPTF(PTF),UPDATE(PTF)
16 Q
17 ;
18REL(PTF) ;-- This function will delete the entries in the PTF
19 ; Release File (#45.83) Associated with the record PTF.
20 ;
21 ; INPUT : PTF - PTF record to delete
22 ;
23 N I
24 G:'$D(^DGP(45.83,"C",PTF)) RELQ
25 S I=0 F S I=$O(^DGP(45.83,"C",PTF,I)) Q:'I D
26 . S DA(1)=I,DA=PTF,DIK="^DGP(45.83,"_DA(1)_",""P""," D ^DIK
27RELQ K DA,DIK
28 Q
29 ;
30CLOSE(PTF) ;-- This function will delete the entries in the PTF Close
31 ; Out file (#45.84), associated with the record PTF.
32 ;
33 ; INPUT : PTF - PTF record to delete
34 ;
35 G:'$D(^DGP(45.84,PTF)) CLOSEQ
36 S DA=PTF,DIK="^DGP(45.84," D ^DIK
37CLOSEQ K DA,DIK
38 Q
39 ;
40CENSUS(PTF) ;-- This function will delete the entries in the PTF Close
41 ; Out file (#45.84), associated with the record PTF.
42 ;
43 ; INPUT : PTF - PTF record to delete
44 ;
45 G:'$D(^DG(45.85,"PTF",PTF)) CENSUSQ
46 S DA=$O(^DG(45.85,"PTF",PTF,0)),DIK="^DG(45.85," D ^DIK
47CENSUSQ K DA,DIK
48 Q
49 ;
50DELPTF(PTF) ;-- This function will delete the entries in the PTF
51 ; file (#45), associated with the record PTF.
52 ;
53 ; INPUT : PTF - PTF record to delete
54 ;
55 G:'$D(^DGPT(PTF)) DELPTFQ
56 S DA=PTF,DIK="^DGPT(" D ^DIK
57DELPTFQ K DA,DIK
58 Q
59 ;
60UPDATE(PTF) ; This function will update the entry in the Patient Movement
61 ; file (#405) cooresponding to the PTF record. The PTF record entry
62 ; in field 16 will be deleted and the PTF PURGED STATUS field 26
63 ; will be set to 1. This field will be used to prevent re-creation
64 ; of the PTF record from a past admission.
65 ;
66 S DA=0 F S DA=$O(^DGPM("APTF",PTF,DA)) Q:'DA D
67 . S DIE="^DGPM(",DR=".16///@;.26////1" D ^DIE
68 K DA,DIE,DR
69 Q
70 ;
71WARNING() ; This function will display a warning to the user before the
72 ; purge of the data will occur. A '1' will be returned if the purge
73 ; should continue.
74 ; OUTPUT : 1 - DO NOT CONTINUE
75 ; 0 - OK
76 N FLAG
77 S FLAG=0
78 W !,*7,"This option will permently purge data from the Data Base."
79 W !,"Are you sure that you want to continue ?",!
80 Q FLAG
81 ;
Note: See TracBrowser for help on using the repository browser.