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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1DGPTLMU2 ;ALM/MTC - Util used for the List Manager Cont; 9-22-92
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4EN ;-- entry point
5 D EN^VALM("DGPT A/P MAIN SELECT")
6 Q
7 ;
8TMPBYE ;-- exit code called from list template
9 K ^TMP("ARCPTF",$J,"AP LIST")
10 D CLEAR^VALM1
11 Q
12 ;
13TMPINT ;-- list manager init point
14 K ^TMP("ARCPTF",$J,"AP LIST")
15 S VALMCNT=$$TMPBLD()
16 Q
17 ;
18TMPEXIT ;-- This fuction will be used to rebuild the the list
19 D TMPINT
20 S VALMBCK="R"
21 Q
22 ;
23TMPBLD() ;-- This function will take the entries in from file 45.62
24 ; and build the display and index array.
25 ; OUTPUT - total number of entries
26 ;
27 ; Format of display string:
28 ; < date range> <status>
29 N NUMREC,REC,DGX,DGY
30 S NUMREC=0
31 ;-- get a/p entry
32 S DGX="" F S DGX=$O(^DGP(45.62,"B",DGX)) Q:DGX']"" D
33 . S DGY=$O(^DGP(45.62,"B",DGX,0)),NUMREC=NUMREC+1,X=""
34 . S X=$$BLDDIS(DGY)
35 . S X=$$SETSTR^VALM1(NUMREC,X,6,2)
36 . S ^TMP("ARCPTF",$J,"AP LIST",NUMREC,0)=X
37 . S ^TMP("ARCPTF",$J,"AP LIST","IDX",NUMREC,NUMREC)=""
38 . S ^TMP("ARCPTF",$J,"AP LIST","REC",NUMREC,DGY)=""
39TMPQ Q NUMREC
40 ;
41TMPDEL ;-- tag entries to delete entry in file 45.62.
42 N DGX
43 D SEL^VALM2 I '$D(VALMY) G TMPDELQ
44 W !,"Deleting PTF Archive/Purge History entry." H 1
45 S DGX=$O(^TMP("ARCPTF",$J,"AP LIST","REC",+$O(VALMY(0)),0))
46 S DIK="^DIBT(",DA=$P(^DGP(45.62,DGX,0),U,8) D ^DIK K DA,DIK
47 S DIK="^DGP(45.62,",DA=DGX D ^DIK K DA,DIK
48TMPDELQ Q
49 ;
50TMPADD ;-- build new entry in 45.62.
51 D CRTEMP^DGPTAPSL
52 Q
53 ;
54TMPED ;-- edit PTF A/P Template
55 N DGX,DGTMP
56 D SEL^VALM2 I '$D(VALMY) G TMPEDQ
57 S DGTMP=$O(^TMP("ARCPTF",$J,"AP LIST","REC",+$O(VALMY(0)),0))
58 ;-- if data is purged quit
59 I $P($G(^DGP(45.62,+DGTMP,0)),U,7) W !,*7,">>> Data Already Purged...Cannot Edit Template." G TMPEDQ
60 D EN^VALM("DGPT A/P EDIT TEMPLATE")
61TMPEDQ Q
62 ;
63BLDDIS(DGTMP) ; -- This function will build the entry for the display
64 ; array used for the List Manager.
65 ; INPUT : DGTMP
66 ; OUTPUT: - <Date Range> <Status>
67 N X
68 S X="",X=$$SETSTR^VALM1($$FTIME^VALM1($P(^DGP(45.62,DGTMP,0),U,10))_" thru "_$$FTIME^VALM1($P(^DGP(45.62,DGTMP,0),U,11)),X,8,30)
69 S X=$$SETSTR^VALM1($J($P(^DGP(45.62,DGTMP,0),U,9),10),X,45,10)
70 S Y=$$STATUS(DGTMP)
71 S X=$$SETSTR^VALM1($S(Y="P":"PURGED",Y="A":"ARCHIVED",1:"ACTIVE"),X,65,10)
72 Q $$LOWER^VALM1(X)
73 ;
74STATUS(REC) ;-- This function will return the currect status of the PTF
75 ; A/P template. If the record has been Archived & Purged the 'P' will
76 ; be returned if just Archived then 'A' else ""
77 ;
78 ; INPUT : REC - IFN of the record to check
79 ; OUTPUT : "A" - Archived, "P" - Purged, or ""
80 N X
81 S X=$G(^DGP(45.62,REC,0)) G:X']"" STATQ
82STATQ Q $S($P(X,U,7):"P",$P(X,U,4):"A",1:"")
83 ;
Note: See TracBrowser for help on using the repository browser.