SCCVDSP ; ALB/TMP - SCHED VSTS CONVERT/ARCHIVE - TEMPLATE LISTS ; 25-NOV-97
;;5.3;Scheduling;**211**;Aug 13, 1993
;
BLD(SCCVTYP) ; -- build list of template entries
; SCCVTYP = 'AST or 'CST' for type of template
;
K ^TMP("SCCV."_SCCVTYP,$J),^TMP("SCCV."_SCCVTYP_".DX",$J)
N SCCVFL,SCCVFIL,SCCVTMP,SCCV0,SCCV1,SCCVCT,SCCVDT,SCCVLDT,SCCVGAP,SCCVX
N SCCV1ST,SCCVCAN
S (SCCVCT,VALMCNT)=0,SCCVSCRN=1
S SCCVFIL=$S(SCCVTYP="CST":404.98,1:404.99)
S SCCVCAN=+$P($G(^SD(404.91,1,"CNV")),U,9)
;
; -- find all templates
S SCCVFL="^SD("_SCCVFIL_")"
;
S SCCV1ST=1
S SCCVGAP=" "
S SCCVDT=0,SCCVLDT=+$G(^SD(404.91,1,"CNV"))
;
F S SCCVDT=$O(@SCCVFL@("C",SCCVDT)) Q:'SCCVDT D
. S SCCVTMP=0 F S SCCVTMP=$O(@SCCVFL@("C",SCCVDT,SCCVTMP)) Q:'SCCVTMP S SCCV0=$G(@SCCVFL@(SCCVTMP,0)),SCCV1=$G(^(1)) D
. . ; if cancelled and should be listed ... list last
. . I $P(SCCV0,U,9) S:SCCVCAN SCCVX(SCCVDT,SCCVTMP)="" Q
. . ;
. . ; -- Check for gaps
. . I 'SCCV1ST D ;Chk for date gaps between templates
. . . S SCCVGAP=$S($$FMADD^XLFDT(SCCVLDT,1)=SCCVDT:" ",1:"*")
. . . S SCCVLDT=$P(SCCV0,U,4)
. . ;
. . I SCCV1ST D ;Chk for gaps from selected start dt to 1st date
. . . IF SCCVDT<SCCVLDT S SCCVGAP=" " Q
. . . S SCCV1ST=0
. . . S SCCVGAP=$S(SCCVLDT'=SCCVDT:"*",1:" ")
. . . S SCCVLDT=$P(SCCV0,U,4)
. . ;
. . D ADDLIST(.SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP)
;
; Now add any canceled templates
S SCCVDT=0
F S SCCVDT=$O(SCCVX(SCCVDT)) Q:'SCCVDT D
. S SCCVTMP=0 F S SCCVTMP=$O(SCCVX(SCCVDT,SCCVTMP)) Q:'SCCVTMP D
. . S SCCV0=$G(@SCCVFL@(SCCVTMP,0)),SCCV1=$G(^(1))
. . D ADDLIST(.SCCVCT,SCCV0,SCCV1," ",SCCVTMP)
;
I '$D(^TMP("SCCV."_SCCVTYP,$J)) S VALMCNT=2,SCCVCT=2,^TMP("SCCV."_SCCVTYP,$J,1,0)=" ",^TMP("SCCV."_SCCVTYP,$J,2,0)=" No Templates On File"
Q
;
ADDLIST(SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP) ; add to list
N X,SCCVACT
S SCCVCT=SCCVCT+1,X="" W "."
;
S X=$$SETFLD^VALM1($J(SCCVCT,4),X,"NUMBER")
S X=$$SETFLD^VALM1($J(SCCVGAP_$$FMTE^XLFDT($P(SCCV0,U,3),1)_" - "_$$FMTE^XLFDT($P(SCCV0,U,4),1),27),X,"DTRANGE")
;
I SCCVTYP="CST" D ;Conversion templates only
. S X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.05,$P(SCCV0,U,5)),X,"EVENT")
. S SCCVACT=$S($P(SCCV0,U,5)=3:"",1:$P(SCCV0,U,7))
. S X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.07,SCCVACT),X,"ACTION")
S X=$$SETFLD^VALM1($J(SCCVTMP,5),X,"TEMPLATE")
;
D SET(X)
Q
;
FNL(SCCVTYP) ; -- Clean up template list
; SCCVTYP = 'AST or 'CST' for type of template
;
K ^TMP("SCCV."_SCCVTYP_".DX",$J),^TMP("SCCV."_SCCVTYP,$J)
K SCCVDONE,SCCVDA,SCCVSCRN
D CLEAN^VALM10
Q
;
SET(X) ; -- set arrays for template list
S VALMCNT=VALMCNT+1,^TMP("SCCV."_SCCVTYP,$J,VALMCNT,0)=X
S ^TMP("SCCV."_SCCVTYP,$J,"IDX",VALMCNT,SCCVCT)=""
S ^TMP("SCCV."_SCCVTYP_".DX",$J,SCCVCT)=VALMCNT_"^"_SCCVTMP
Q
;
SELX(SCCVTYP,CANCEL) ; -- Select the entry to process
; SCCVTYP = 'AST or 'CST' for type of template
; CANCEL = Flag ... 1 = don't allow to be selected if canceled
; 0 = allow to be selected even if canceled
;
D EN^VALM2($G(XQORNOD(0)),"S")
S SCCVDA=$P($G(^TMP("SCCV."_SCCVTYP_".DX",$J,+$O(VALMY("")))),U,2)
I $G(CANCEL),$S(SCCVTYP="AST":$P($G(^SD(404.99,+SCCVDA,0)),U,5)=6,1:$P($G(^SD(404.98,+SCCVDA,0)),U,9)) D
.W !,"You cannot select a canceled template!"
.D PAUSE^SCCVU
.K SCCVDA
Q
;
FNLX ; Clean up after select action
K SCCVDA
D CLEAN^VALM10
S VALMBCK="R"
Q
;
HDRX ; -- Hdr for select action
S VALMHDR(1)=" "
S VALMHDR(2)=SCCVTYP_" #: "_$G(SCCVDA)
Q
;
FASTEX ; -- Sets a flag that system should be exited
S VALMBCK="Q"
I $G(VALMEVL) D ;Ask this for all but the last level
.D FULL^VALM1
.N DIR
.S DIR(0)="Y"
.S DIR("A")="Exit option entirely"
.S DIR("B")="NO"
.D ^DIR
.I $D(DIRUT)!(Y) S SCFASTXT=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVDSP 3852 printed Dec 13, 2024@02:38:37 Page 2
SCCVDSP ; ALB/TMP - SCHED VSTS CONVERT/ARCHIVE - TEMPLATE LISTS ; 25-NOV-97
+1 ;;5.3;Scheduling;**211**;Aug 13, 1993
+2 ;
BLD(SCCVTYP) ; -- build list of template entries
+1 ; SCCVTYP = 'AST or 'CST' for type of template
+2 ;
+3 KILL ^TMP("SCCV."_SCCVTYP,$JOB),^TMP("SCCV."_SCCVTYP_".DX",$JOB)
+4 NEW SCCVFL,SCCVFIL,SCCVTMP,SCCV0,SCCV1,SCCVCT,SCCVDT,SCCVLDT,SCCVGAP,SCCVX
+5 NEW SCCV1ST,SCCVCAN
+6 SET (SCCVCT,VALMCNT)=0
SET SCCVSCRN=1
+7 SET SCCVFIL=$SELECT(SCCVTYP="CST":404.98,1:404.99)
+8 SET SCCVCAN=+$PIECE($GET(^SD(404.91,1,"CNV")),U,9)
+9 ;
+10 ; -- find all templates
+11 SET SCCVFL="^SD("_SCCVFIL_")"
+12 ;
+13 SET SCCV1ST=1
+14 SET SCCVGAP=" "
+15 SET SCCVDT=0
SET SCCVLDT=+$GET(^SD(404.91,1,"CNV"))
+16 ;
+17 FOR
SET SCCVDT=$ORDER(@SCCVFL@("C",SCCVDT))
if 'SCCVDT
QUIT
Begin DoDot:1
+18 SET SCCVTMP=0
FOR
SET SCCVTMP=$ORDER(@SCCVFL@("C",SCCVDT,SCCVTMP))
if 'SCCVTMP
QUIT
SET SCCV0=$GET(@SCCVFL@(SCCVTMP,0))
SET SCCV1=$GET(^(1))
Begin DoDot:2
+19 ; if cancelled and should be listed ... list last
+20 IF $PIECE(SCCV0,U,9)
if SCCVCAN
SET SCCVX(SCCVDT,SCCVTMP)=""
QUIT
+21 ;
+22 ; -- Check for gaps
+23 ;Chk for date gaps between templates
IF 'SCCV1ST
Begin DoDot:3
+24 SET SCCVGAP=$SELECT($$FMADD^XLFDT(SCCVLDT,1)=SCCVDT:" ",1:"*")
+25 SET SCCVLDT=$PIECE(SCCV0,U,4)
End DoDot:3
+26 ;
+27 ;Chk for gaps from selected start dt to 1st date
IF SCCV1ST
Begin DoDot:3
+28 IF SCCVDT<SCCVLDT
SET SCCVGAP=" "
QUIT
+29 SET SCCV1ST=0
+30 SET SCCVGAP=$SELECT(SCCVLDT'=SCCVDT:"*",1:" ")
+31 SET SCCVLDT=$PIECE(SCCV0,U,4)
End DoDot:3
+32 ;
+33 DO ADDLIST(.SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP)
End DoDot:2
End DoDot:1
+34 ;
+35 ; Now add any canceled templates
+36 SET SCCVDT=0
+37 FOR
SET SCCVDT=$ORDER(SCCVX(SCCVDT))
if 'SCCVDT
QUIT
Begin DoDot:1
+38 SET SCCVTMP=0
FOR
SET SCCVTMP=$ORDER(SCCVX(SCCVDT,SCCVTMP))
if 'SCCVTMP
QUIT
Begin DoDot:2
+39 SET SCCV0=$GET(@SCCVFL@(SCCVTMP,0))
SET SCCV1=$GET(^(1))
+40 DO ADDLIST(.SCCVCT,SCCV0,SCCV1," ",SCCVTMP)
End DoDot:2
End DoDot:1
+41 ;
+42 IF '$DATA(^TMP("SCCV."_SCCVTYP,$JOB))
SET VALMCNT=2
SET SCCVCT=2
SET ^TMP("SCCV."_SCCVTYP,$JOB,1,0)=" "
SET ^TMP("SCCV."_SCCVTYP,$JOB,2,0)=" No Templates On File"
+43 QUIT
+44 ;
ADDLIST(SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP) ; add to list
+1 NEW X,SCCVACT
+2 SET SCCVCT=SCCVCT+1
SET X=""
WRITE "."
+3 ;
+4 SET X=$$SETFLD^VALM1($JUSTIFY(SCCVCT,4),X,"NUMBER")
+5 SET X=$$SETFLD^VALM1($JUSTIFY(SCCVGAP_$$FMTE^XLFDT($PIECE(SCCV0,U,3),1)_" - "_$$FMTE^XLFDT($PIECE(SCCV0,U,4),1),27),X,"DTRANGE")
+6 ;
+7 ;Conversion templates only
IF SCCVTYP="CST"
Begin DoDot:1
+8 SET X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.05,$PIECE(SCCV0,U,5)),X,"EVENT")
+9 SET SCCVACT=$SELECT($PIECE(SCCV0,U,5)=3:"",1:$PIECE(SCCV0,U,7))
+10 SET X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.07,SCCVACT),X,"ACTION")
End DoDot:1
+11 SET X=$$SETFLD^VALM1($JUSTIFY(SCCVTMP,5),X,"TEMPLATE")
+12 ;
+13 DO SET(X)
+14 QUIT
+15 ;
FNL(SCCVTYP) ; -- Clean up template list
+1 ; SCCVTYP = 'AST or 'CST' for type of template
+2 ;
+3 KILL ^TMP("SCCV."_SCCVTYP_".DX",$JOB),^TMP("SCCV."_SCCVTYP,$JOB)
+4 KILL SCCVDONE,SCCVDA,SCCVSCRN
+5 DO CLEAN^VALM10
+6 QUIT
+7 ;
SET(X) ; -- set arrays for template list
+1 SET VALMCNT=VALMCNT+1
SET ^TMP("SCCV."_SCCVTYP,$JOB,VALMCNT,0)=X
+2 SET ^TMP("SCCV."_SCCVTYP,$JOB,"IDX",VALMCNT,SCCVCT)=""
+3 SET ^TMP("SCCV."_SCCVTYP_".DX",$JOB,SCCVCT)=VALMCNT_"^"_SCCVTMP
+4 QUIT
+5 ;
SELX(SCCVTYP,CANCEL) ; -- Select the entry to process
+1 ; SCCVTYP = 'AST or 'CST' for type of template
+2 ; CANCEL = Flag ... 1 = don't allow to be selected if canceled
+3 ; 0 = allow to be selected even if canceled
+4 ;
+5 DO EN^VALM2($GET(XQORNOD(0)),"S")
+6 SET SCCVDA=$PIECE($GET(^TMP("SCCV."_SCCVTYP_".DX",$JOB,+$ORDER(VALMY("")))),U,2)
+7 IF $GET(CANCEL)
IF $SELECT(SCCVTYP="AST":$PIECE($GET(^SD(404.99,+SCCVDA,0)),U,5)=6,1:$PIECE($GET(^SD(404.98,+SCCVDA,0)),U,9))
Begin DoDot:1
+8 WRITE !,"You cannot select a canceled template!"
+9 DO PAUSE^SCCVU
+10 KILL SCCVDA
End DoDot:1
+11 QUIT
+12 ;
FNLX ; Clean up after select action
+1 KILL SCCVDA
+2 DO CLEAN^VALM10
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
HDRX ; -- Hdr for select action
+1 SET VALMHDR(1)=" "
+2 SET VALMHDR(2)=SCCVTYP_" #: "_$GET(SCCVDA)
+3 QUIT
+4 ;
FASTEX ; -- Sets a flag that system should be exited
+1 SET VALMBCK="Q"
+2 ;Ask this for all but the last level
IF $GET(VALMEVL)
Begin DoDot:1
+3 DO FULL^VALM1
+4 NEW DIR
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Exit option entirely"
+7 SET DIR("B")="NO"
+8 DO ^DIR
+9 IF $DATA(DIRUT)!(Y)
SET SCFASTXT=1
End DoDot:1
+10 QUIT
+11 ;
