- DGPTLMU2 ;ALM/MTC - Util used for the List Manager Cont; 9-22-92
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;
- 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:"")
- ;
- DGPTLMU2 ;ALM/MTC - Util used for the List Manager Cont; 9-22-92
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +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 ;
