| [613] | 1 | DGPTLMU2 ;ALM/MTC - Util used for the List Manager Cont; 9-22-92
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;-- entry point
|
|---|
| 5 | D EN^VALM("DGPT A/P MAIN SELECT")
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | TMPBYE ;-- exit code called from list template
|
|---|
| 9 | K ^TMP("ARCPTF",$J,"AP LIST")
|
|---|
| 10 | D CLEAR^VALM1
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | TMPINT ;-- list manager init point
|
|---|
| 14 | K ^TMP("ARCPTF",$J,"AP LIST")
|
|---|
| 15 | S VALMCNT=$$TMPBLD()
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | TMPEXIT ;-- This fuction will be used to rebuild the the list
|
|---|
| 19 | D TMPINT
|
|---|
| 20 | S VALMBCK="R"
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | TMPBLD() ;-- 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)=""
|
|---|
| 39 | TMPQ Q NUMREC
|
|---|
| 40 | ;
|
|---|
| 41 | TMPDEL ;-- 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
|
|---|
| 48 | TMPDELQ Q
|
|---|
| 49 | ;
|
|---|
| 50 | TMPADD ;-- build new entry in 45.62.
|
|---|
| 51 | D CRTEMP^DGPTAPSL
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | TMPED ;-- 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")
|
|---|
| 61 | TMPEDQ Q
|
|---|
| 62 | ;
|
|---|
| 63 | BLDDIS(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 | ;
|
|---|
| 74 | STATUS(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
|
|---|
| 82 | STATQ Q $S($P(X,U,7):"P",$P(X,U,4):"A",1:"")
|
|---|
| 83 | ;
|
|---|
