source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCCVCST4.m@ 1104

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1SCCVCST4 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
2 ;;5.3;Scheduling;**211**;Aug 13, 1993
3 ;
4RESULT ; Display conversion results message
5 ;
6 N DIR,Y,Z
7 I $D(SCERRMSG)!'$G(SCTOT("OK")) D
8 . I '$O(SCERRMSG("")) S SCERRMSG(1)="UNKNOWN ERROR"
9 . S DIR("A",1)=$S(SCCVEVT=1:"",1:"RE")_"CONVERSION ENCOUNTERED THE FOLLOWING ERROR(S): ",DIR("A",2)=" "
10 . S Z=0 F S Z=$O(SCERRMSG(Z)) Q:'Z S DIR("A",Z+2)=" "_SCERRMSG(Z)
11 E S DIR("A",1)=$S(SCCVEVT=1:"",1:"RE")_"CONVERSION WAS SUCCESSFUL"
12 S DIR(0)="EA",DIR("A")="PRESS RETURN "
13 D ^DIR K DIR
14 Q
15 ;
16NOENT(SCCVTYPN,SCCVDFN,SCDTM) ;No entry was found for date/time/pt
17 ;
18 N DIR,X,Y
19 S DIR(0)="EA"
20 S DIR("A",1)="No valid "_SCCVTYPN_" was found for "
21 S DIR("A",2)=" "_$P($G(^DPT(SCCVDFN,0)),U)_" ("_SCCVDFN_") on "_$$FMTE^XLFDT(SCDTM),DIR("A")="Press RETURN to continue: " D ^DIR K DIR
22 Q
23 ;
24DISPERR(SCERR,SCF) ; Display error
25 N DIR,Y,X,Z,CT
26 I $G(SCERR) S SCERR(SCERR)=""
27 S Z=$O(SCERR(0)) Q:'Z
28 S DIR(0)="EA",DIR("A",1)="INVALID SELECTION: "_$P($T(SCERR+Z),";;",3)
29 S CT=1 F S Z=$O(SCERR(Z)) Q:'Z S CT=CT+1,DIR("A",CT)=$J("",19)_$P($T(SCERR+Z),";;",3)
30 I SCF["SDV",'$D(SCERR(1)) S DIR("A",CT+1)="(Th"_$S(CT>1:"ese errors",1:"is error")_" may apply to one or more of the ADD/EDIT's entries)"
31 S DIR("A")="PRESS RETURN TO CONTINUE "
32 D ^DIR K DIR
33 W !
34 Q
35 ;
36DISP1(SCCVTYPN,SCFILE1,SCCVDA) ; Display selected entry
37 N DIC,DR,DIQ,DA,DIR,Y
38 W !,SCCVTYPN_" #: "_SCCVDA
39 I SCFILE1["SCE" S SCFILE1="^SCE("
40 S DIC=SCFILE1,DIQ(0)="R",DA=SCCVDA
41 D EN^DIQ
42 S DIR(0)="YA",DIR("A")="IS THIS THE CORRECT ENTRY?: ",DIR("B")="NO"
43 S DIR("?")="If you say YES here, this entry will be converted"
44 D ^DIR K DIR
45 W !
46 Q $P(Y,U)
47 ;
48CONV1(SCCVEVT,SCFILE,SCCVDFN,SCDTM,SCCVDA) ;Convert one entry (appt/disp/add-edit/enctr)
49 ; Conversion will include any child encounters
50 N SCF,DATA,SCTOT,SCERRMSG,SCCVERRH,SCSTOPF,SCCS
51 S SCF=SCFILE
52 ;
53 I SCFILE["SCE" D ; Encounter - set file for specific origin
54 . N SCORG,DATA
55 . S DATA=$G(@SCF@(+$G(SCCVDA),0)),SCORG=$P(DATA,U,8)
56 . S SCF=$S(SCORG=1:"^DPT("_$P(DATA,U,2)_",""S"")",SCORG=2:"^SDV",SCORG=3:"^DPT("_$P(DATA,U,2)_",""DIS"")",1:"")
57 . S (SCCVDA,SCDTM)=+DATA
58 . S:SCORG=2 SCCS=+$P(DATA,U,9),SCTOT("A/E")=1
59 . S:SCORG=3 SCCVDA=9999999-SCCVDA
60 ;
61 I SCF["""S""" D G CONVQ ; Appointment
62 . S DATA=$G(@SCF@(SCDTM,0)),SCTOT("OK")=""
63 . I DATA D
64 .. W !,$P("Converting^Reconverting",U,SCCVEVT),"..."
65 .. D ZERO^SCCVEAP(SCCVDFN)
66 .. D EN^SCCVEAP1(SCCVEVT,SCCVDFN,SCDTM,+DATA,"","")
67 . D RESULT
68 ;
69 I SCF["""DIS""" D G CONVQ ; Disposition
70 . S DATA=$G(@SCF@(+$G(SCCVDA),0)),SCTOT("OK")=0
71 . I DATA D
72 .. W !,$P("Converting^Reconverting",U,SCCVEVT),"..."
73 .. D ZERO^SCCVEDI(SCCVDFN)
74 .. D EN^SCCVEDI1(SCCVEVT,SCCVDFN,SCDTM,"")
75 . D RESULT
76 ;
77 I SCF["SDV" D G CONVQ ; Add/edit
78 . I SCF=SCFILE D Q ; Convert whole add/edit
79 .. S DATA=$G(@SCF@(SCDTM,0)),SCTOT("OK")=0
80 .. I DATA D
81 ... W !,$P("Converting^Reconverting",U,SCCVEVT),"..."
82 ... D STOPS^SCCVEAE(SCCVEVT,SCDTM,"","","")
83 .. D RESULT
84 . ;
85 . I SCF'=SCFILE D ; Convert one add/edit clinic stop (chosen by enctr)
86 .. S DATA=$G(@SCF@(SCDTM,"CS",SCCS,0)),SCTOT("OK")=0
87 .. I DATA'="" D
88 ... W !,$P("Converting^Reconverting",U,SCCVEVT),"..."
89 ... D ZERO^SCCVEAE(SCDTM)
90 ... D EN^SCCVEAE1(SCCVEVT,SCDTM,SCCS,"","")
91 .. D RESULT
92CONVQ Q
93 ;
94 ;
95SCERR ; Invalid reasons
96 ;;1;;THE ENTRY REQUESTED COULD NOT BE FOUND
97 ;;2;;DATE OF THE ENTRY MUST BE BEFORE 10/1/96
98 ;;3;;ALREADY HAS A VISIT
99 ;;4;;ENTRY IS A 'CHILD'
100 ;;5;;ENTRY DOES NOT HAVE A VALID DISPOSITION
101 ;;6;;APPOINTMENT STATUS IS NOT VALID
102 ;;7;;APPOINTMENT IS NOT FOR A VALID CLINIC
103 ;;8;;ENTRY WAS NOT PREVIOUSLY CONVERTED
104 ;;9;;ENCOUNTER NOT CHECKED OUT
105 ;
Note: See TracBrowser for help on using the repository browser.