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:"")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTLMU2 2703 printed Nov 22, 2024@18:02:48 Page 2
DGPTLMU2 ;ALM/MTC - Util used for the List Manager Cont; 9-22-92
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
EN ;-- entry point
+1 DO EN^VALM("DGPT A/P MAIN SELECT")
+2 QUIT
+3 ;
TMPBYE ;-- exit code called from list template
+1 KILL ^TMP("ARCPTF",$JOB,"AP LIST")
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
TMPINT ;-- list manager init point
+1 KILL ^TMP("ARCPTF",$JOB,"AP LIST")
+2 SET VALMCNT=$$TMPBLD()
+3 QUIT
+4 ;
TMPEXIT ;-- This fuction will be used to rebuild the the list
+1 DO TMPINT
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
TMPBLD() ;-- This function will take the entries in from file 45.62
+1 ; and build the display and index array.
+2 ; OUTPUT - total number of entries
+3 ;
+4 ; Format of display string:
+5 ; < date range> <status>
+6 NEW NUMREC,REC,DGX,DGY
+7 SET NUMREC=0
+8 ;-- get a/p entry
+9 SET DGX=""
FOR
SET DGX=$ORDER(^DGP(45.62,"B",DGX))
if DGX']""
QUIT
Begin DoDot:1
+10 SET DGY=$ORDER(^DGP(45.62,"B",DGX,0))
SET NUMREC=NUMREC+1
SET X=""
+11 SET X=$$BLDDIS(DGY)
+12 SET X=$$SETSTR^VALM1(NUMREC,X,6,2)
+13 SET ^TMP("ARCPTF",$JOB,"AP LIST",NUMREC,0)=X
+14 SET ^TMP("ARCPTF",$JOB,"AP LIST","IDX",NUMREC,NUMREC)=""
+15 SET ^TMP("ARCPTF",$JOB,"AP LIST","REC",NUMREC,DGY)=""
End DoDot:1
TMPQ QUIT NUMREC
+1 ;
TMPDEL ;-- tag entries to delete entry in file 45.62.
+1 NEW DGX
+2 DO SEL^VALM2
IF '$DATA(VALMY)
GOTO TMPDELQ
+3 WRITE !,"Deleting PTF Archive/Purge History entry."
HANG 1
+4 SET DGX=$ORDER(^TMP("ARCPTF",$JOB,"AP LIST","REC",+$ORDER(VALMY(0)),0))
+5 SET DIK="^DIBT("
SET DA=$PIECE(^DGP(45.62,DGX,0),U,8)
DO ^DIK
KILL DA,DIK
+6 SET DIK="^DGP(45.62,"
SET DA=DGX
DO ^DIK
KILL DA,DIK
TMPDELQ QUIT
+1 ;
TMPADD ;-- build new entry in 45.62.
+1 DO CRTEMP^DGPTAPSL
+2 QUIT
+3 ;
TMPED ;-- edit PTF A/P Template
+1 NEW DGX,DGTMP
+2 DO SEL^VALM2
IF '$DATA(VALMY)
GOTO TMPEDQ
+3 SET DGTMP=$ORDER(^TMP("ARCPTF",$JOB,"AP LIST","REC",+$ORDER(VALMY(0)),0))
+4 ;-- if data is purged quit
+5 IF $PIECE($GET(^DGP(45.62,+DGTMP,0)),U,7)
WRITE !,*7,">>> Data Already Purged...Cannot Edit Template."
GOTO TMPEDQ
+6 DO EN^VALM("DGPT A/P EDIT TEMPLATE")
TMPEDQ QUIT
+1 ;
BLDDIS(DGTMP) ; -- This function will build the entry for the display
+1 ; array used for the List Manager.
+2 ; INPUT : DGTMP
+3 ; OUTPUT: - <Date Range> <Status>
+4 NEW X
+5 SET X=""
SET X=$$SETSTR^VALM1($$FTIME^VALM1($PIECE(^DGP(45.62,DGTMP,0),U,10))_" thru "_$$FTIME^VALM1($PIECE(^DGP(45.62,DGTMP,0),U,11)),X,8,30)
+6 SET X=$$SETSTR^VALM1($JUSTIFY($PIECE(^DGP(45.62,DGTMP,0),U,9),10),X,45,10)
+7 SET Y=$$STATUS(DGTMP)
+8 SET X=$$SETSTR^VALM1($SELECT(Y="P":"PURGED",Y="A":"ARCHIVED",1:"ACTIVE"),X,65,10)
+9 QUIT $$LOWER^VALM1(X)
+10 ;
STATUS(REC) ;-- This function will return the currect status of the PTF
+1 ; A/P template. If the record has been Archived & Purged the 'P' will
+2 ; be returned if just Archived then 'A' else ""
+3 ;
+4 ; INPUT : REC - IFN of the record to check
+5 ; OUTPUT : "A" - Archived, "P" - Purged, or ""
+6 NEW X
+7 SET X=$GET(^DGP(45.62,REC,0))
if X']""
GOTO STATQ
STATQ QUIT $SELECT($PIECE(X,U,7):"P",$PIECE(X,U,4):"A",1:"")
+1 ;
