source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCCVEAE3.m@ 789

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

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1SCCVEAE3 ;ALB/RMO,TMP - Add/Edit Conversion cont.; [ 04/05/95 8:46 AM ]
2 ;;5.3;Scheduling;**211**;Aug 13, 1993
3 ;
4SET(SCCVEVT,SCLOG,SCDTM,SCVALDT,SCDA,SCOEP,SCOE,SCCV) ; Set variables, add encounter/visit
5 ; Input -- SCCVEVT Conversion event
6 ; SCLOG Scheduling conversion log IEN
7 ; SCDTM Visit date/time (IEN)
8 ; SCVALDT Valid converted Visit date/time (SCDTM)
9 ; SCDA Clinic stop code sub-file IEN
10 ; SCOEP Parent outpatient encounter IEN [optional]
11 ; Output -- SCOE Outpatient encounter IEN
12 ; SCCV Conversion array:
13 ; SCCV("EVT") Conversion event
14 ; ("LOG") Scheduling conversion log IEN
15 ; ("NEW") Outpatient encounter or visit
16 ; created by conversion flag
17 ; 0 = no new encounter or visit
18 ; 1 = new encounter and visit
19 ; 2 = new visit only
20 ; ("OE",0) Outpatient encounter 0th node
21 ; ("CS",0) Clinic stop code 0th node
22 ; ("CS",1) Clinic stop code 1 node
23 ; ("CS","PR") Clinic stop code 'PR' node
24 ; ("ERR") Code for specific error, if any
25 ; ("VST") Visit file IEN
26 ;
27 N SCCVSIT,SCV0,DA,DR,DE,DQ,DIE,SDVSIT,SCOE0,SCCVT,X
28 S SCCV("EVT")=SCCVEVT
29 S SCCV("LOG")=SCLOG
30 ;
31 ; If estimating, increment the total number of encounters and visits
32 ; that would be created by the conversion
33 ; If converting, create a new encounter and/or visit
34 ;
35 I '$G(^SDV(SCDTM,0)) S SCCV("ERR")=4 G SETQ
36 S SCCVSIT=^SDV(SCDTM,0),SDVSIT("DFN")=$P(SCCVSIT,U,2)
37 I 'SDVSIT("DFN") S SCCV("ERR")=5 G SETQ
38 ;
39 I '$D(^SDV(SCDTM,"CS",SCDA,0)) S SCCV("ERR")=9 G SETQ
40 S SCV0=^SDV(SCDTM,"CS",SCDA,0),SCCV("CS","PR")=$G(^("PR"))
41 ;
42 S SCOE=+$P(SCV0,U,8),SCOE0=$G(^SCE(SCOE,0))
43 ;
44 ; On re-convert, delete previously converted data for parents only
45 I SCCVEVT=2,'$P(SCOE0,U,6) D
46 . ; only delete for reconvert if we created the encounter or completed
47 . ; the conversion by adding the visit
48 . Q:'$$CCREATE^SCCVU(SCOE)
49 . ;
50 . D RECNVT^SCCVEAP3(SCOE,SCOE0,.SCCONS)
51 . S SCOE0=$G(^SCE(SCOE,0)) S:SCOE0="" SCOE=0
52 ;
53 S SCCV("NEW")=$S('SCOE:1,'$P(SCOE0,U,5):2,1:0)
54 ;
55 I 'SCCV("NEW") G SETQ ; Already has an encounter and visit
56 ;
57 I 'SCCVEVT D G SETQ ; Estimate exits here
58 . ; -- don't incrment if child will use parent's visit ien
59 . IF SCCV("NEW")=2,$G(SCOEP),$D(^SCE(SCOEP,0)),$P(^(0),U,3)=$P(SCOE0,U,3),$P(^(0),U,4)=$P(SCOE0,U,4) Q
60 . D INCRTOT^SCCVEGU1(.SCTOT,SCCV("NEW")+6,1)
61 . D EN^SCCVZZ("AE-"_(SCCV("NEW")+6),SCOE,SCDTM,SCDA,$S(SCOEP:SCOEP,$P($G(^SCE(SCOE,0)),U,6):+$P(^(0),U,6),1:0),SDVSIT("DFN"))
62 ;
63 S SDVSIT("DIV")=+$P($G(^SC(+$P(SCV0,U,3),0)),U,15)
64 S:'SDVSIT("DIV") SDVSIT("DIV")=+$P(SCCVSIT,U,3)
65 S SDVSIT("DIV")=$$DIV(SDVSIT("DIV"))
66 I 'SDVSIT("DIV") S SCCV("ERR")=6 G SETQ
67 ;
68 S SDVSIT("CLN")=+SCV0
69 I $P($G(^DIC(40.7,+SCV0,0)),U,2)=900 S SDVSIT("CLN")=+$P($G(^SC(+$P(SCV0,U,3),0)),U,7)
70 I 'SDVSIT("CLN") S SCCV("ERR")=7 G SETQ
71 ;
72 S:$P(SCV0,U,3) SDVSIT("LOC")=$P(SCV0,U,3)
73 S:$P(SCV0,U,4) SDVSIT("ELG")=$P(SCV0,U,4)
74 S:$P(SCV0,U,5) SDVSIT("TYP")=$P(SCV0,U,5)
75 S SDVSIT("ORG")=2,SDVSIT("REF")=SCDA
76 D SETSCCVT^SCCVEAP2(.SCCVT,.SCCONS)
77 ;
78 S:$G(SCOEP) SDVSIT("PAR")=SCOEP
79 ;
80 I SCCV("NEW")=2 D G:'$G(SDVSIT("VST")) SETQ ; -- Has encounter, needs visit
81 . S SCOE=$P(SCV0,U,8),SDVSIT("OE",0)=SCOE0
82 . S SDVSIT("OE")=SCOE
83 . S X=$$VISIT^SCCVEAP2(SCVALDT,.SDVSIT) ; -- Add visit only
84 . S SCOE0=SDVSIT("OE",0)
85 ;
86 I SCCV("NEW")=1 D ; -- Needs both encounter and visit added
87 .S SCOE=$$SDOE^SDVSIT(SCVALDT,.SDVSIT),SCOE0=$G(^SCE(+SCOE,0))
88 .S:SCOE SCTOT(1.02)=$G(SCTOT(1.02))+1
89 ;
90 G SETQ:'SCOE
91 ;
92 I $G(SDVSIT("VST")),'$P(SCOE0,U,5) S SCDATA(.05)=SDVSIT("VST") D UPD^SCCVDBU(409.68,SCOE,.SCDATA) K SCDATA
93 ;
94 ; Update 'CS' node with encounter pointer
95 I SCCV("NEW")=1 S SCDATA(8)=SCOE,SCIENS=SCDA_","_SCDTM D UPD^SCCVDBU(409.51,SCIENS,.SCDATA) K SCDATA
96 ;
97 M SCCV=SDVSIT
98 S SCCV("OE",0)=$G(^SCE(SCOE,0))
99 S SCCV("VST")=$P($G(SCCV("OE",0)),U,5)
100 S SCCV("CS",0)=$G(^SDV(SCDTM,"CS",SCDA,0)),SCCV("CS",1)=$G(^(1))
101 ;
102 IF SCCV("NEW")=1 D CSCAN(SCDTM,.SCCV)
103 ;
104SETQ Q
105 ;
106DIV(DIV) ; -- determine med div
107 I $P($G(^DG(43,1,"GL")),U,2),$D(^DG(40.8,+DIV,0)) G DIVQ ; multi-div?
108 S DIV=+$O(^DG(40.8,0))
109DIVQ Q DIV
110 ;
111CSCAN(SCDTM,SCCV) ; -- update 900 "CS" nodes with same clinic
112 N SCLN,SCS,SCS0,SCNT,SCEXT
113 S SCLN=+$P($G(SCCV("CS",0)),U,3)
114 S SCOE=+$P($G(SCCV("CS",0)),U,8)
115 S SCEXT=$P(SCCV("OE",0),U,9)
116 ;
117 IF 'SCCV900!('SCLN)!('SCOE)!(SCEXT="") G CSCANQ
118 ;
119 S SCNT=0
120 ; -- scan for "CS" nodes that are 900's, same clinic & no encounter
121 S SCS=0 F S SCS=$O(^SDV(SCDTM,"CS",SCS)) Q:'SCS S SCS0=$G(^(SCS,0)) D
122 . IF +SCS0=SCCV900,+$P(SCS0,U,3)=SCLN,'$P(SCS0,U,8) D
123 . . N SCDATA,SCIENS
124 . . S SCDATA(8)=SCOE ; -- set sce ien
125 . . S SCDATA(9)=1 ; -- mark converted
126 . . S SCIENS=SCS_","_SCDTM
127 . . D UPD^SCCVDBU(409.51,SCIENS,.SCDATA)
128 . . S SCEXT=SCEXT_":"_SCS
129 . . S SCNT=SCNT+1
130 ;
131 IF 'SCNT G CSCANQ
132 ;
133 N SCDATA
134 S SCDATA(.09)=SCEXT D UPD^SCCVDBU(409.68,SCOE,.SCDATA)
135 S SCCV("OE",0)=$G(^SCE(SCOE,0))
136 ;
137CSCANQ Q
138 ;
Note: See TracBrowser for help on using the repository browser.