VistA-WorldVistAEHR/r/REGISTRATION-DGQE-DG-DPT-GR.../DGPTLMU2.m

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:"")
;