Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTAPP1

DGPTAPP1.m

Go to the documentation of this file. 
  1. DGPTAPP1 ;MTC/ALB - PTF Purge/Archive - Purge Continued ; 21 DEC 1992
  1.  ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;
  1. PURGE(TMP) ;-- Purge entry point. This function will loop thru the
  1.  ; PTF records found in the A/P template pointed to by TMP.
  1.  ; Starting with the PTF Release file, PTF Close Out file, Census
  1.  ; Work file and finally the PTF record in file #45.
  1.  ;
  1.  ; INPUT :  TMP - Entry in PTF A/P History File (Sort Template Pointer)
  1.  ;
  1.  N PTF,REC
  1.  S REC=$P($G(^DGP(45.62,+TMP,0)),U,8) Q:'REC
  1.  S PTF=0 F  S PTF=$O(^DIBT(REC,1,PTF)) Q:'PTF  D
  1.  . D REL(PTF),CLOSE(PTF),CENSUS(PTF),DELPTF(PTF),UPDATE(PTF)
  1.  Q
  1.  ;
  1. REL(PTF) ;-- This function will delete the entries in the PTF
  1.  ; Release File (#45.83) Associated with the record PTF.
  1.  ;
  1.  ; INPUT : PTF - PTF record to delete
  1.  ;
  1.  N I
  1.  G:'$D(^DGP(45.83,"C",PTF)) RELQ
  1.  S I=0 F  S I=$O(^DGP(45.83,"C",PTF,I)) Q:'I  D
  1.  . S DA(1)=I,DA=PTF,DIK="^DGP(45.83,"_DA(1)_",""P""," D ^DIK
  1. RELQ K DA,DIK
  1.  Q
  1.  ;
  1. CLOSE(PTF) ;-- This function will delete the entries in the PTF Close
  1.  ; Out file (#45.84), associated with the record PTF.
  1.  ;
  1.  ; INPUT : PTF - PTF record to delete
  1.  ;
  1.  G:'$D(^DGP(45.84,PTF)) CLOSEQ
  1.  S DA=PTF,DIK="^DGP(45.84," D ^DIK
  1. CLOSEQ K DA,DIK
  1.  Q
  1.  ;
  1. CENSUS(PTF) ;-- This function will delete the entries in the PTF Close
  1.  ; Out file (#45.84), associated with the record PTF.
  1.  ;
  1.  ; INPUT : PTF - PTF record to delete
  1.  ;
  1.  G:'$D(^DG(45.85,"PTF",PTF)) CENSUSQ
  1.  S DA=$O(^DG(45.85,"PTF",PTF,0)),DIK="^DG(45.85," D ^DIK
  1. CENSUSQ K DA,DIK
  1.  Q
  1.  ;
  1. DELPTF(PTF) ;-- This function will delete the entries in the PTF 
  1.  ; file (#45), associated with the record PTF.
  1.  ;
  1.  ; INPUT : PTF - PTF record to delete
  1.  ;
  1.  G:'$D(^DGPT(PTF)) DELPTFQ
  1.  S DA=PTF,DIK="^DGPT(" D ^DIK
  1. DELPTFQ K DA,DIK
  1.  Q
  1.  ;
  1. UPDATE(PTF) ; This function will update the entry in the Patient Movement
  1.  ; file (#405) cooresponding to the PTF record. The PTF record entry
  1.  ; in field 16 will be deleted and the PTF PURGED STATUS field 26
  1.  ; will be set to 1. This field will be used to prevent re-creation
  1.  ; of the PTF record from a past admission.
  1.  ;
  1.  S DA=0 F  S DA=$O(^DGPM("APTF",PTF,DA)) Q:'DA  D
  1.  . S DIE="^DGPM(",DR=".16///@;.26////1" D ^DIE
  1.  K DA,DIE,DR
  1.  Q
  1.  ;
  1. WARNING() ; This function will display a warning to the user before the
  1.  ; purge of the data will occur. A '1' will be returned if the purge
  1.  ; should continue.
  1.  ;  OUTPUT : 1 - DO NOT CONTINUE
  1.  ;           0 - OK
  1.  N FLAG
  1.  S FLAG=0
  1.  W !,*7,"This option will permently purge data from the Data Base."
  1.  W !,"Are you sure that you want to continue ?",!
  1.  Q FLAG
  1.  ;