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

DGPTLMU1.m

Go to the documentation of this file.
  1. DGPTLMU1 ;ALM/MTC - Utilities used for the List Manager; 9-17-92
  1. ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
  1. ;
  1. ;
  1. EXINT ;-- init routine to call List Manager
  1. N X
  1. K ^TMP("ARCPTF",$J,"LIST")
  1. S X=$P($G(^DGP(45.62,DGTMP,0)),U)
  1. S:X]"" VALMCNT=$$EXPTF(X)
  1. ;-- if no entries then delete PTF A/P Template
  1. I X]"",'VALMCNT D
  1. . W !,">>> No entries found... Deleting PTF A/P Template" H 1
  1. . S DIK="^DIBT(",DA=$P(^DGP(45.62,DGTMP,0),U,8) D ^DIK K DA,DIK
  1. . S DIK="^DGP(45.62,",DA=DGTMP D ^DIK K DA,DIK
  1. . S VALMQUIT=""
  1. EXINTQ Q
  1. ;
  1. EXQ ;-- exit function call from List Manager
  1. I $D(^TMP("ARCPTF",$J,"LIST","DEL")),$$MAKPER D UPST(DGTMP)
  1. K ^TMP("ARCPTF",$J,"LIST")
  1. D CLEAR^VALM1
  1. Q
  1. ;
  1. EXHDR ;-- header function for Editing List.
  1. N X,Y
  1. S VALMHDR(1)="PTF Records Selected from "_$$FTIME^VALM1($P(^DGP(45.62,DGTMP,0),U,10))_" thru "_$$FTIME^VALM1($P(^DGP(45.62,DGTMP,0),U,11))_"."
  1. S VALMHDR(2)="Total Number of PTF records Selected: "_VALMCNT
  1. S Y=$$STATUS^DGPTLMU2(DGTMP)
  1. S VALMHDR(3)="Status: "_$S(Y="P":"PURGED",Y="A":"ARCHIVED",1:"ACTIVE")
  1. Q
  1. ;
  1. EXPTF(FNAME) ;-- This function will take the entries in the search
  1. ; template FNAME and expand them for display using the List Manager.
  1. ; The global that will contain the display items is:
  1. ; ^TMP("ARCPTF",$J,"LIST")
  1. ; INPUT : FNAME - PTF Archive/Purge File entry
  1. ; OUTPUT: Total Number of entries
  1. ;
  1. ; Format of display string:
  1. ; <ptf #> <patient name> <admission date> <discharge date>
  1. N NUMREC,REC,DGX,DGY,X,AREC
  1. S NUMREC=0
  1. ;-- get a/p entry
  1. S DGX=$O(^DGP(45.62,"B",FNAME,0)) I 'DGX G EXPTFQ
  1. S REC=$P(^DGP(45.62,DGX,0),U,8) G:'$D(^DIBT(REC)) EXPTFQ
  1. S AREC=$P(^DGP(45.62,DGX,0),U,9)
  1. S DGX=0 F S DGX=$O(^DIBT(REC,1,DGX)) Q:'DGX D
  1. .;-- if records does not exist then clean-up search template
  1. . I '$D(^DGPT(DGX)) K ^DIBT(REC,1,DGX) Q
  1. . S NUMREC=NUMREC+1,X=""
  1. . S X=$$SETSTR^VALM1("*",X,6,1)
  1. . S X=$$SETSTR^VALM1(DGX,X,8,6)
  1. . S X=$$SETSTR^VALM1($P(^DPT(+^DGPT(DGX,0),0),U),X,15,20)
  1. . S X=$$SETSTR^VALM1($$FTIME^VALM1($P(^DGPT(DGX,0),U,2)),X,37,18)
  1. . S DGY=+$G(^DGPT(DGX,70))
  1. . S X=$$SETSTR^VALM1($S(DGY:$$FTIME^VALM1(DGY),1:"<UNKNOWN>"),X,56,18)
  1. . S ^TMP("ARCPTF",$J,"LIST",NUMREC,0)=$$LOWER^VALM1(X)
  1. . S ^TMP("ARCPTF",$J,"LIST","IDX",NUMREC,DGX)=""
  1. . S ^TMP("ARCPTF",$J,"LIST","REC",DGX,NUMREC)=""
  1. . D FLDCTRL^VALM10(NUMREC)
  1. I NUMREC'=AREC S DA=REC,DIE="^DGP(45.62,",DR=".09///^S X=NUMREC" D ^DIE K DIE,DR,DA
  1. EXPTFQ Q NUMREC
  1. ;
  1. DELEX ;-- tag entries to delete in the search template.
  1. N DGI,DGJ,Y,X
  1. D SEL^DGPTLMU3
  1. ;-- mark entries as deleted from search teplate
  1. S DGI=0 F S DGI=$O(VALMY(DGI)) Q:'DGI I $D(^TMP("ARCPTF",$J,"LIST","REC",DGI)) D
  1. . S ^TMP("ARCPTF",$J,"LIST","DEL",DGI)=""
  1. . S DGJ=$O(^TMP("ARCPTF",$J,"LIST","REC",DGI,0))
  1. . D SAVE^VALM10(DGJ),KILL^VALM10(DGJ)
  1. . S X=^TMP("ARCPTF",$J,"LIST",DGJ,0)
  1. . S X=$$SETSTR^VALM1(" ",X,6,1),^TMP("ARCPTF",$J,"LIST",DGJ,0)=X
  1. . D WRITE^VALM10(DGJ)
  1. S VALMBCK=$S(VALMCC:"",1:"R")
  1. K VALMY
  1. Q
  1. ;
  1. ADDEX ;-- if an entry has been un-selected for a/p this function will
  1. ; re-activate for the a/p process.
  1. N DGI,DGJ
  1. D SEL^DGPTLMU3
  1. ;-- unmark entries as deleted from search teplate
  1. S DGI=0 F S DGI=$O(VALMY(DGI)) Q:'DGI I $D(^TMP("ARCPTF",$J,"LIST","REC",DGI)) D
  1. . K ^TMP("ARCPTF",$J,"LIST","DEL",DGI)
  1. . S DGJ=$O(^TMP("ARCPTF",$J,"LIST","REC",DGI,0))
  1. . D RESTORE^VALM10(DGJ)
  1. . S X=^TMP("ARCPTF",$J,"LIST",DGJ,0)
  1. . S X=$$SETSTR^VALM1("*",X,6,1),^TMP("ARCPTF",$J,"LIST",DGJ,0)=X
  1. . D FLDCTRL^VALM10(DGJ)
  1. . D WRITE^VALM10(DGJ)
  1. S VALMBCK=$S(VALMCC:"",1:"R")
  1. K VALMY
  1. Q
  1. ;
  1. MAKPER() ;-- This function will prompt the user if all changes to the
  1. ; search template should be made permanent.
  1. ; INPUT : - None
  1. ; OUTPUT : 1 - Yes, 0 - No
  1. ;
  1. N Y
  1. S DIR(0)="Y",DIR("A")="Should I make all changes permanent ",DIR("B")="NO"
  1. D ^DIR
  1. K DIR
  1. Q Y
  1. ;
  1. UPST(REC) ;-- This function will update the search template if entries are
  1. ; contained in the ^TMP("ATCPTF",$J,"LIST","DEL") global. Lastly,
  1. ; the total number of entries will be updated in the PTF A/P
  1. ; History file (#45.62)
  1. ; INPUT : REC - Entry in file 45.62
  1. N DELREC,I,SRTREC
  1. I '$D(^TMP("ARCPTF",$J,"LIST","DEL")) G UPSTQ
  1. W !,">>> Updating search template." H 1
  1. S DELREC=0,SRTREC=$P(^DGP(45.62,REC,0),U,8)
  1. S I=0 F S I=$O(^TMP("ARCPTF",$J,"LIST","DEL",I)) Q:'I D
  1. . S DELREC=DELREC+1
  1. . K ^DIBT(SRTREC,1,I)
  1. I DELREC=VALMCNT D DELENTRY^DGPTAPSL($P(^DGP(45.62,REC,0),U)) G UPSTQ
  1. I DELREC S DA=REC,DIE="^DGP(45.62,",DR=".09///^S X=VALMCNT-DELREC" D ^DIE K DIE,DR,DA
  1. UPSTQ Q
  1. ;