source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTLMU1.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: 4.4 KB
RevLine 
[613]1DGPTLMU1 ;ALM/MTC - Utilities used for the List Manager; 9-17-92
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4 ;
5EXINT ;-- init routine to call List Manager
6 N X
7 K ^TMP("ARCPTF",$J,"LIST")
8 S X=$P($G(^DGP(45.62,DGTMP,0)),U)
9 S:X]"" VALMCNT=$$EXPTF(X)
10 ;-- if no entries then delete PTF A/P Template
11 I X]"",'VALMCNT D
12 . W !,">>> No entries found... Deleting PTF A/P Template" H 1
13 . S DIK="^DIBT(",DA=$P(^DGP(45.62,DGTMP,0),U,8) D ^DIK K DA,DIK
14 . S DIK="^DGP(45.62,",DA=DGTMP D ^DIK K DA,DIK
15 . S VALMQUIT=""
16EXINTQ Q
17 ;
18EXQ ;-- exit function call from List Manager
19 I $D(^TMP("ARCPTF",$J,"LIST","DEL")),$$MAKPER D UPST(DGTMP)
20 K ^TMP("ARCPTF",$J,"LIST")
21 D CLEAR^VALM1
22 Q
23 ;
24EXHDR ;-- header function for Editing List.
25 N X,Y
26 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))_"."
27 S VALMHDR(2)="Total Number of PTF records Selected: "_VALMCNT
28 S Y=$$STATUS^DGPTLMU2(DGTMP)
29 S VALMHDR(3)="Status: "_$S(Y="P":"PURGED",Y="A":"ARCHIVED",1:"ACTIVE")
30 Q
31 ;
32EXPTF(FNAME) ;-- This function will take the entries in the search
33 ; template FNAME and expand them for display using the List Manager.
34 ; The global that will contain the display items is:
35 ; ^TMP("ARCPTF",$J,"LIST")
36 ; INPUT : FNAME - PTF Archive/Purge File entry
37 ; OUTPUT: Total Number of entries
38 ;
39 ; Format of display string:
40 ; <ptf #> <patient name> <admission date> <discharge date>
41 N NUMREC,REC,DGX,DGY,X,AREC
42 S NUMREC=0
43 ;-- get a/p entry
44 S DGX=$O(^DGP(45.62,"B",FNAME,0)) I 'DGX G EXPTFQ
45 S REC=$P(^DGP(45.62,DGX,0),U,8) G:'$D(^DIBT(REC)) EXPTFQ
46 S AREC=$P(^DGP(45.62,DGX,0),U,9)
47 S DGX=0 F S DGX=$O(^DIBT(REC,1,DGX)) Q:'DGX D
48 .;-- if records does not exist then clean-up search template
49 . I '$D(^DGPT(DGX)) K ^DIBT(REC,1,DGX) Q
50 . S NUMREC=NUMREC+1,X=""
51 . S X=$$SETSTR^VALM1("*",X,6,1)
52 . S X=$$SETSTR^VALM1(DGX,X,8,6)
53 . S X=$$SETSTR^VALM1($P(^DPT(+^DGPT(DGX,0),0),U),X,15,20)
54 . S X=$$SETSTR^VALM1($$FTIME^VALM1($P(^DGPT(DGX,0),U,2)),X,37,18)
55 . S DGY=+$G(^DGPT(DGX,70))
56 . S X=$$SETSTR^VALM1($S(DGY:$$FTIME^VALM1(DGY),1:"<UNKNOWN>"),X,56,18)
57 . S ^TMP("ARCPTF",$J,"LIST",NUMREC,0)=$$LOWER^VALM1(X)
58 . S ^TMP("ARCPTF",$J,"LIST","IDX",NUMREC,DGX)=""
59 . S ^TMP("ARCPTF",$J,"LIST","REC",DGX,NUMREC)=""
60 . D FLDCTRL^VALM10(NUMREC)
61 I NUMREC'=AREC S DA=REC,DIE="^DGP(45.62,",DR=".09///^S X=NUMREC" D ^DIE K DIE,DR,DA
62EXPTFQ Q NUMREC
63 ;
64DELEX ;-- tag entries to delete in the search template.
65 N DGI,DGJ,Y,X
66 D SEL^DGPTLMU3
67 ;-- mark entries as deleted from search teplate
68 S DGI=0 F S DGI=$O(VALMY(DGI)) Q:'DGI I $D(^TMP("ARCPTF",$J,"LIST","REC",DGI)) D
69 . S ^TMP("ARCPTF",$J,"LIST","DEL",DGI)=""
70 . S DGJ=$O(^TMP("ARCPTF",$J,"LIST","REC",DGI,0))
71 . D SAVE^VALM10(DGJ),KILL^VALM10(DGJ)
72 . S X=^TMP("ARCPTF",$J,"LIST",DGJ,0)
73 . S X=$$SETSTR^VALM1(" ",X,6,1),^TMP("ARCPTF",$J,"LIST",DGJ,0)=X
74 . D WRITE^VALM10(DGJ)
75 S VALMBCK=$S(VALMCC:"",1:"R")
76 K VALMY
77 Q
78 ;
79ADDEX ;-- if an entry has been un-selected for a/p this function will
80 ; re-activate for the a/p process.
81 N DGI,DGJ
82 D SEL^DGPTLMU3
83 ;-- unmark entries as deleted from search teplate
84 S DGI=0 F S DGI=$O(VALMY(DGI)) Q:'DGI I $D(^TMP("ARCPTF",$J,"LIST","REC",DGI)) D
85 . K ^TMP("ARCPTF",$J,"LIST","DEL",DGI)
86 . S DGJ=$O(^TMP("ARCPTF",$J,"LIST","REC",DGI,0))
87 . D RESTORE^VALM10(DGJ)
88 . S X=^TMP("ARCPTF",$J,"LIST",DGJ,0)
89 . S X=$$SETSTR^VALM1("*",X,6,1),^TMP("ARCPTF",$J,"LIST",DGJ,0)=X
90 . D FLDCTRL^VALM10(DGJ)
91 . D WRITE^VALM10(DGJ)
92 S VALMBCK=$S(VALMCC:"",1:"R")
93 K VALMY
94 Q
95 ;
96MAKPER() ;-- This function will prompt the user if all changes to the
97 ; search template should be made permanent.
98 ; INPUT : - None
99 ; OUTPUT : 1 - Yes, 0 - No
100 ;
101 N Y
102 S DIR(0)="Y",DIR("A")="Should I make all changes permanent ",DIR("B")="NO"
103 D ^DIR
104 K DIR
105 Q Y
106 ;
107UPST(REC) ;-- This function will update the search template if entries are
108 ; contained in the ^TMP("ATCPTF",$J,"LIST","DEL") global. Lastly,
109 ; the total number of entries will be updated in the PTF A/P
110 ; History file (#45.62)
111 ; INPUT : REC - Entry in file 45.62
112 N DELREC,I,SRTREC
113 I '$D(^TMP("ARCPTF",$J,"LIST","DEL")) G UPSTQ
114 W !,">>> Updating search template." H 1
115 S DELREC=0,SRTREC=$P(^DGP(45.62,REC,0),U,8)
116 S I=0 F S I=$O(^TMP("ARCPTF",$J,"LIST","DEL",I)) Q:'I D
117 . S DELREC=DELREC+1
118 . K ^DIBT(SRTREC,1,I)
119 I DELREC=VALMCNT D DELENTRY^DGPTAPSL($P(^DGP(45.62,REC,0),U)) G UPSTQ
120 I DELREC S DA=REC,DIE="^DGP(45.62,",DR=".09///^S X=VALMCNT-DELREC" D ^DIE K DIE,DR,DA
121UPSTQ Q
122 ;
Note: See TracBrowser for help on using the repository browser.