Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCCVDSP

SCCVDSP.m

Go to the documentation of this file.
  1. SCCVDSP ; ALB/TMP - SCHED VSTS CONVERT/ARCHIVE - TEMPLATE LISTS ; 25-NOV-97
  1. ;;5.3;Scheduling;**211**;Aug 13, 1993
  1. ;
  1. BLD(SCCVTYP) ; -- build list of template entries
  1. ; SCCVTYP = 'AST or 'CST' for type of template
  1. ;
  1. K ^TMP("SCCV."_SCCVTYP,$J),^TMP("SCCV."_SCCVTYP_".DX",$J)
  1. N SCCVFL,SCCVFIL,SCCVTMP,SCCV0,SCCV1,SCCVCT,SCCVDT,SCCVLDT,SCCVGAP,SCCVX
  1. N SCCV1ST,SCCVCAN
  1. S (SCCVCT,VALMCNT)=0,SCCVSCRN=1
  1. S SCCVFIL=$S(SCCVTYP="CST":404.98,1:404.99)
  1. S SCCVCAN=+$P($G(^SD(404.91,1,"CNV")),U,9)
  1. ;
  1. ; -- find all templates
  1. S SCCVFL="^SD("_SCCVFIL_")"
  1. ;
  1. S SCCV1ST=1
  1. S SCCVGAP=" "
  1. S SCCVDT=0,SCCVLDT=+$G(^SD(404.91,1,"CNV"))
  1. ;
  1. F S SCCVDT=$O(@SCCVFL@("C",SCCVDT)) Q:'SCCVDT D
  1. . S SCCVTMP=0 F S SCCVTMP=$O(@SCCVFL@("C",SCCVDT,SCCVTMP)) Q:'SCCVTMP S SCCV0=$G(@SCCVFL@(SCCVTMP,0)),SCCV1=$G(^(1)) D
  1. . . ; if cancelled and should be listed ... list last
  1. . . I $P(SCCV0,U,9) S:SCCVCAN SCCVX(SCCVDT,SCCVTMP)="" Q
  1. . . ;
  1. . . ; -- Check for gaps
  1. . . I 'SCCV1ST D ;Chk for date gaps between templates
  1. . . . S SCCVGAP=$S($$FMADD^XLFDT(SCCVLDT,1)=SCCVDT:" ",1:"*")
  1. . . . S SCCVLDT=$P(SCCV0,U,4)
  1. . . ;
  1. . . I SCCV1ST D ;Chk for gaps from selected start dt to 1st date
  1. . . . IF SCCVDT<SCCVLDT S SCCVGAP=" " Q
  1. . . . S SCCV1ST=0
  1. . . . S SCCVGAP=$S(SCCVLDT'=SCCVDT:"*",1:" ")
  1. . . . S SCCVLDT=$P(SCCV0,U,4)
  1. . . ;
  1. . . D ADDLIST(.SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP)
  1. ;
  1. ; Now add any canceled templates
  1. S SCCVDT=0
  1. F S SCCVDT=$O(SCCVX(SCCVDT)) Q:'SCCVDT D
  1. . S SCCVTMP=0 F S SCCVTMP=$O(SCCVX(SCCVDT,SCCVTMP)) Q:'SCCVTMP D
  1. . . S SCCV0=$G(@SCCVFL@(SCCVTMP,0)),SCCV1=$G(^(1))
  1. . . D ADDLIST(.SCCVCT,SCCV0,SCCV1," ",SCCVTMP)
  1. ;
  1. 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"
  1. Q
  1. ;
  1. ADDLIST(SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP) ; add to list
  1. N X,SCCVACT
  1. S SCCVCT=SCCVCT+1,X="" W "."
  1. ;
  1. S X=$$SETFLD^VALM1($J(SCCVCT,4),X,"NUMBER")
  1. S X=$$SETFLD^VALM1($J(SCCVGAP_$$FMTE^XLFDT($P(SCCV0,U,3),1)_" - "_$$FMTE^XLFDT($P(SCCV0,U,4),1),27),X,"DTRANGE")
  1. ;
  1. I SCCVTYP="CST" D ;Conversion templates only
  1. . S X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.05,$P(SCCV0,U,5)),X,"EVENT")
  1. . S SCCVACT=$S($P(SCCV0,U,5)=3:"",1:$P(SCCV0,U,7))
  1. . S X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.07,SCCVACT),X,"ACTION")
  1. S X=$$SETFLD^VALM1($J(SCCVTMP,5),X,"TEMPLATE")
  1. ;
  1. D SET(X)
  1. Q
  1. ;
  1. FNL(SCCVTYP) ; -- Clean up template list
  1. ; SCCVTYP = 'AST or 'CST' for type of template
  1. ;
  1. K ^TMP("SCCV."_SCCVTYP_".DX",$J),^TMP("SCCV."_SCCVTYP,$J)
  1. K SCCVDONE,SCCVDA,SCCVSCRN
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. SET(X) ; -- set arrays for template list
  1. S VALMCNT=VALMCNT+1,^TMP("SCCV."_SCCVTYP,$J,VALMCNT,0)=X
  1. S ^TMP("SCCV."_SCCVTYP,$J,"IDX",VALMCNT,SCCVCT)=""
  1. S ^TMP("SCCV."_SCCVTYP_".DX",$J,SCCVCT)=VALMCNT_"^"_SCCVTMP
  1. Q
  1. ;
  1. SELX(SCCVTYP,CANCEL) ; -- Select the entry to process
  1. ; SCCVTYP = 'AST or 'CST' for type of template
  1. ; CANCEL = Flag ... 1 = don't allow to be selected if canceled
  1. ; 0 = allow to be selected even if canceled
  1. ;
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. S SCCVDA=$P($G(^TMP("SCCV."_SCCVTYP_".DX",$J,+$O(VALMY("")))),U,2)
  1. 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
  1. .W !,"You cannot select a canceled template!"
  1. .D PAUSE^SCCVU
  1. .K SCCVDA
  1. Q
  1. ;
  1. FNLX ; Clean up after select action
  1. K SCCVDA
  1. D CLEAN^VALM10
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. HDRX ; -- Hdr for select action
  1. S VALMHDR(1)=" "
  1. S VALMHDR(2)=SCCVTYP_" #: "_$G(SCCVDA)
  1. Q
  1. ;
  1. FASTEX ; -- Sets a flag that system should be exited
  1. S VALMBCK="Q"
  1. I $G(VALMEVL) D ;Ask this for all but the last level
  1. .D FULL^VALM1
  1. .N DIR
  1. .S DIR(0)="Y"
  1. .S DIR("A")="Exit option entirely"
  1. .S DIR("B")="NO"
  1. .D ^DIR
  1. .I $D(DIRUT)!(Y) S SCFASTXT=1
  1. Q
  1. ;