source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCCVDSP.m@ 719

Last change on this file since 719 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1SCCVDSP ; ALB/TMP - SCHED VSTS CONVERT/ARCHIVE - TEMPLATE LISTS ; 25-NOV-97
2 ;;5.3;Scheduling;**211**;Aug 13, 1993
3 ;
4BLD(SCCVTYP) ; -- build list of template entries
5 ; SCCVTYP = 'AST or 'CST' for type of template
6 ;
7 K ^TMP("SCCV."_SCCVTYP,$J),^TMP("SCCV."_SCCVTYP_".DX",$J)
8 N SCCVFL,SCCVFIL,SCCVTMP,SCCV0,SCCV1,SCCVCT,SCCVDT,SCCVLDT,SCCVGAP,SCCVX
9 N SCCV1ST,SCCVCAN
10 S (SCCVCT,VALMCNT)=0,SCCVSCRN=1
11 S SCCVFIL=$S(SCCVTYP="CST":404.98,1:404.99)
12 S SCCVCAN=+$P($G(^SD(404.91,1,"CNV")),U,9)
13 ;
14 ; -- find all templates
15 S SCCVFL="^SD("_SCCVFIL_")"
16 ;
17 S SCCV1ST=1
18 S SCCVGAP=" "
19 S SCCVDT=0,SCCVLDT=+$G(^SD(404.91,1,"CNV"))
20 ;
21 F S SCCVDT=$O(@SCCVFL@("C",SCCVDT)) Q:'SCCVDT D
22 . S SCCVTMP=0 F S SCCVTMP=$O(@SCCVFL@("C",SCCVDT,SCCVTMP)) Q:'SCCVTMP S SCCV0=$G(@SCCVFL@(SCCVTMP,0)),SCCV1=$G(^(1)) D
23 . . ; if cancelled and should be listed ... list last
24 . . I $P(SCCV0,U,9) S:SCCVCAN SCCVX(SCCVDT,SCCVTMP)="" Q
25 . . ;
26 . . ; -- Check for gaps
27 . . I 'SCCV1ST D ;Chk for date gaps between templates
28 . . . S SCCVGAP=$S($$FMADD^XLFDT(SCCVLDT,1)=SCCVDT:" ",1:"*")
29 . . . S SCCVLDT=$P(SCCV0,U,4)
30 . . ;
31 . . I SCCV1ST D ;Chk for gaps from selected start dt to 1st date
32 . . . IF SCCVDT<SCCVLDT S SCCVGAP=" " Q
33 . . . S SCCV1ST=0
34 . . . S SCCVGAP=$S(SCCVLDT'=SCCVDT:"*",1:" ")
35 . . . S SCCVLDT=$P(SCCV0,U,4)
36 . . ;
37 . . D ADDLIST(.SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP)
38 ;
39 ; Now add any canceled templates
40 S SCCVDT=0
41 F S SCCVDT=$O(SCCVX(SCCVDT)) Q:'SCCVDT D
42 . S SCCVTMP=0 F S SCCVTMP=$O(SCCVX(SCCVDT,SCCVTMP)) Q:'SCCVTMP D
43 . . S SCCV0=$G(@SCCVFL@(SCCVTMP,0)),SCCV1=$G(^(1))
44 . . D ADDLIST(.SCCVCT,SCCV0,SCCV1," ",SCCVTMP)
45 ;
46 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"
47 Q
48 ;
49ADDLIST(SCCVCT,SCCV0,SCCV1,SCCVGAP,SCCVTMP) ; add to list
50 N X,SCCVACT
51 S SCCVCT=SCCVCT+1,X="" W "."
52 ;
53 S X=$$SETFLD^VALM1($J(SCCVCT,4),X,"NUMBER")
54 S X=$$SETFLD^VALM1($J(SCCVGAP_$$FMTE^XLFDT($P(SCCV0,U,3),1)_" - "_$$FMTE^XLFDT($P(SCCV0,U,4),1),27),X,"DTRANGE")
55 ;
56 I SCCVTYP="CST" D ;Conversion templates only
57 . S X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.05,$P(SCCV0,U,5)),X,"EVENT")
58 . S SCCVACT=$S($P(SCCV0,U,5)=3:"",1:$P(SCCV0,U,7))
59 . S X=$$SETFLD^VALM1($$EXPAND^SCCVDSP2(404.98,.07,SCCVACT),X,"ACTION")
60 S X=$$SETFLD^VALM1($J(SCCVTMP,5),X,"TEMPLATE")
61 ;
62 D SET(X)
63 Q
64 ;
65FNL(SCCVTYP) ; -- Clean up template list
66 ; SCCVTYP = 'AST or 'CST' for type of template
67 ;
68 K ^TMP("SCCV."_SCCVTYP_".DX",$J),^TMP("SCCV."_SCCVTYP,$J)
69 K SCCVDONE,SCCVDA,SCCVSCRN
70 D CLEAN^VALM10
71 Q
72 ;
73SET(X) ; -- set arrays for template list
74 S VALMCNT=VALMCNT+1,^TMP("SCCV."_SCCVTYP,$J,VALMCNT,0)=X
75 S ^TMP("SCCV."_SCCVTYP,$J,"IDX",VALMCNT,SCCVCT)=""
76 S ^TMP("SCCV."_SCCVTYP_".DX",$J,SCCVCT)=VALMCNT_"^"_SCCVTMP
77 Q
78 ;
79SELX(SCCVTYP,CANCEL) ; -- Select the entry to process
80 ; SCCVTYP = 'AST or 'CST' for type of template
81 ; CANCEL = Flag ... 1 = don't allow to be selected if canceled
82 ; 0 = allow to be selected even if canceled
83 ;
84 D EN^VALM2($G(XQORNOD(0)),"S")
85 S SCCVDA=$P($G(^TMP("SCCV."_SCCVTYP_".DX",$J,+$O(VALMY("")))),U,2)
86 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
87 .W !,"You cannot select a canceled template!"
88 .D PAUSE^SCCVU
89 .K SCCVDA
90 Q
91 ;
92FNLX ; Clean up after select action
93 K SCCVDA
94 D CLEAN^VALM10
95 S VALMBCK="R"
96 Q
97 ;
98HDRX ; -- Hdr for select action
99 S VALMHDR(1)=" "
100 S VALMHDR(2)=SCCVTYP_" #: "_$G(SCCVDA)
101 Q
102 ;
103FASTEX ; -- Sets a flag that system should be exited
104 S VALMBCK="Q"
105 I $G(VALMEVL) D ;Ask this for all but the last level
106 .D FULL^VALM1
107 .N DIR
108 .S DIR(0)="Y"
109 .S DIR("A")="Exit option entirely"
110 .S DIR("B")="NO"
111 .D ^DIR
112 .I $D(DIRUT)!(Y) S SCFASTXT=1
113 Q
114 ;
Note: See TracBrowser for help on using the repository browser.