84 lines
2.6 KiB
Mathematica
84 lines
2.6 KiB
Mathematica
|
DGPTLMU2 ;ALM/MTC - Util used for the List Manager Cont; 9-22-92
|
||
|
|
;;5.3;Registration;;Aug 13, 1993
|
||
|
|
;
|
||
|
|
EN ;-- entry point
|
||
|
|
D EN^VALM("DGPT A/P MAIN SELECT")
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TMPBYE ;-- exit code called from list template
|
||
|
|
K ^TMP("ARCPTF",$J,"AP LIST")
|
||
|
|
D CLEAR^VALM1
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TMPINT ;-- list manager init point
|
||
|
|
K ^TMP("ARCPTF",$J,"AP LIST")
|
||
|
|
S VALMCNT=$$TMPBLD()
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TMPEXIT ;-- This fuction will be used to rebuild the the list
|
||
|
|
D TMPINT
|
||
|
|
S VALMBCK="R"
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TMPBLD() ;-- This function will take the entries in from file 45.62
|
||
|
|
; and build the display and index array.
|
||
|
|
; OUTPUT - total number of entries
|
||
|
|
;
|
||
|
|
; Format of display string:
|
||
|
|
; < date range> <status>
|
||
|
|
N NUMREC,REC,DGX,DGY
|
||
|
|
S NUMREC=0
|
||
|
|
;-- get a/p entry
|
||
|
|
S DGX="" F S DGX=$O(^DGP(45.62,"B",DGX)) Q:DGX']"" D
|
||
|
|
. S DGY=$O(^DGP(45.62,"B",DGX,0)),NUMREC=NUMREC+1,X=""
|
||
|
|
. S X=$$BLDDIS(DGY)
|
||
|
|
. S X=$$SETSTR^VALM1(NUMREC,X,6,2)
|
||
|
|
. S ^TMP("ARCPTF",$J,"AP LIST",NUMREC,0)=X
|
||
|
|
. S ^TMP("ARCPTF",$J,"AP LIST","IDX",NUMREC,NUMREC)=""
|
||
|
|
. S ^TMP("ARCPTF",$J,"AP LIST","REC",NUMREC,DGY)=""
|
||
|
|
TMPQ Q NUMREC
|
||
|
|
;
|
||
|
|
TMPDEL ;-- tag entries to delete entry in file 45.62.
|
||
|
|
N DGX
|
||
|
|
D SEL^VALM2 I '$D(VALMY) G TMPDELQ
|
||
|
|
W !,"Deleting PTF Archive/Purge History entry." H 1
|
||
|
|
S DGX=$O(^TMP("ARCPTF",$J,"AP LIST","REC",+$O(VALMY(0)),0))
|
||
|
|
S DIK="^DIBT(",DA=$P(^DGP(45.62,DGX,0),U,8) D ^DIK K DA,DIK
|
||
|
|
S DIK="^DGP(45.62,",DA=DGX D ^DIK K DA,DIK
|
||
|
|
TMPDELQ Q
|
||
|
|
;
|
||
|
|
TMPADD ;-- build new entry in 45.62.
|
||
|
|
D CRTEMP^DGPTAPSL
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TMPED ;-- edit PTF A/P Template
|
||
|
|
N DGX,DGTMP
|
||
|
|
D SEL^VALM2 I '$D(VALMY) G TMPEDQ
|
||
|
|
S DGTMP=$O(^TMP("ARCPTF",$J,"AP LIST","REC",+$O(VALMY(0)),0))
|
||
|
|
;-- if data is purged quit
|
||
|
|
I $P($G(^DGP(45.62,+DGTMP,0)),U,7) W !,*7,">>> Data Already Purged...Cannot Edit Template." G TMPEDQ
|
||
|
|
D EN^VALM("DGPT A/P EDIT TEMPLATE")
|
||
|
|
TMPEDQ Q
|
||
|
|
;
|
||
|
|
BLDDIS(DGTMP) ; -- This function will build the entry for the display
|
||
|
|
; array used for the List Manager.
|
||
|
|
; INPUT : DGTMP
|
||
|
|
; OUTPUT: - <Date Range> <Status>
|
||
|
|
N X
|
||
|
|
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)
|
||
|
|
S X=$$SETSTR^VALM1($J($P(^DGP(45.62,DGTMP,0),U,9),10),X,45,10)
|
||
|
|
S Y=$$STATUS(DGTMP)
|
||
|
|
S X=$$SETSTR^VALM1($S(Y="P":"PURGED",Y="A":"ARCHIVED",1:"ACTIVE"),X,65,10)
|
||
|
|
Q $$LOWER^VALM1(X)
|
||
|
|
;
|
||
|
|
STATUS(REC) ;-- This function will return the currect status of the PTF
|
||
|
|
; A/P template. If the record has been Archived & Purged the 'P' will
|
||
|
|
; be returned if just Archived then 'A' else ""
|
||
|
|
;
|
||
|
|
; INPUT : REC - IFN of the record to check
|
||
|
|
; OUTPUT : "A" - Archived, "P" - Purged, or ""
|
||
|
|
N X
|
||
|
|
S X=$G(^DGP(45.62,REC,0)) G:X']"" STATQ
|
||
|
|
STATQ Q $S($P(X,U,7):"P",$P(X,U,4):"A",1:"")
|
||
|
|
;
|