source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCCVEAP4.m@ 1259

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1SCCVEAP4 ;ALB/RMO,TMP - Appointment Conversion cont.; [ 04/05/95 10:19 AM ]
2 ;;5.3;Scheduling;**211**;Aug 13, 1993
3 ;
4CREDIT(SCOE,SCDTM,SCCV,SCCVEVT) ; Add/delete visit for credit stop
5 ; (for add encounter and visit - ^SDVSIT does it)
6 ;Input:
7 ; SCOE Parent encounter ien
8 ; SCDTM Appointment date/time
9 ; SCCV Conversion array
10 ; SCCVEVT Conversion event (0/1/2)
11 N SCCRST,SCOE00,SCOEC,SCHIST,SCOESV,SCCVX,SCVSIT,SCQ,SCX,X
12 ; Credit stop code may need a visit, too
13 ; Find 'child' clinic stop code encounter, if there
14 S (SCHIST,SCOEC,SCQ,SCX)=0,SCOE00=""
15 F S SCOEC=$O(^SCE("APAR",SCOE,SCOEC)) Q:'SCOEC D Q:SCQ
16 . S SCOE00=$G(^SCE(SCOEC,0))
17 . I $P(SCOE00,U,8)=4 S SCHIST=+$P($G(^SCE(SCOEC,"CNV")),U,3),SCQ=1 Q
18 . I 'SCX,$P(SCOE00,U,8)=2,$P(SCOE00,U,9),+$G(^SDV($$SDVIEN^SCCVU(+$P(SCOE00,U,2),SCDTM),"CS",+$P(SCOE00,U,9),0))=$P(SCCV("CL1",0),U,18) S SCX=SCOEC
19 ;
20 I SCOE,'SCOEC G CREDITQ ;Appt enc exists, so credit enc should have
21 ; existed if valid at time of appt enc creation
22 I 'SCOEC D
23 . I SCX S SCOEC=SCX Q
24 . S SCHIST=1
25 ;
26 I $P($G(^SCE(+SCOEC,0)),U,5) G CREDITQ ; Already has visit
27 ;
28 I SCHIST,$P(SCCV("CL1",0),U,17)="Y" G CREDITQ ; non-count clinic
29 ;
30 S SCCRST=$S('SCHIST:$P(SCOE00,U,3),1:$P($G(SCCV("CL1",0)),U,18))
31 ;
32 G:'SCCRST CREDITQ ; no credit stop code assigned to this appt
33 IF SCHIST,SCCRST=$P(SCCV("CL1",0),U,7) G CREDITQ ; credit stop code same as stop code for this clinic
34 ;
35 I SCHIST S SCQ=0 D G:SCQ CREDITQ
36 . S X=$P($G(^DIC(40.7,SCCRST,0)),U,3)
37 . I $S('X:0,1:(SCDTM\1)'<X) S SCQ=1 ; stop code was inactive
38 ;
39 I 'SCCVEVT D Q ;estimate exits here
40 .N ZZZ
41 .S ZZZ=$S(SCOEC:SCOEC,1:0)
42 .D INCRTOT^SCCVEGU1(.SCTOT,8-SCHIST,1),INCRTOT^SCCVEGU1(.SCTOT,4,1),EN^SCCVZZ("CREDIT-"_(8-SCHIST),ZZZ,SCDTM,$P($G(SCCV("PT",0)),U),SCOE),EN^SCCVZZ("CREDIT-4",ZZZ,SCDTM,$P($G(SCCV("PT",0)),U),SCOE)
43 ;
44 I SCCVEVT=2,SCOEC,$P(SCOE00,U,5) D
45 . D RECNVT^SCCVEAP3(SCOEC,SCOE00,.SCCONS) ;Re-converting - delete old visit/enctr
46 . I '$D(^SCE(SCOEC,0)) S SCHIST=1
47 ;
48 ;If historical, we need to add both the encounter and the visit
49 I SCHIST D G CREDITQ
50 . N SCOEX,SCCVT
51 . S SCVSIT("DFN")=$P(SCCV("OE",0),U,2)
52 . S SCVSIT("CLN")=SCCRST
53 . S SCVSIT("DIV")=$P(SCCV("OE",0),U,11)
54 . S SCVSIT("ELG")=$P(SCCV("OE",0),U,13)
55 . S SCVSIT("LOC")=$P(SCCV("PT",0),U)
56 . S SCVSIT("TYP")=$P(SCCV("OE",0),U,10)
57 . S SCVSIT("PAR")=SCOE
58 . S SCVSIT("ORG")=4,SCVSIT("REF")=0
59 . D SETSCCVT^SCCVEAP2(.SCCVT,.SCCONS)
60 . S SCOEX=$$SDOE^SDVSIT(SCDTM,.SCVSIT,"",SCVSIT("PAR"))
61 . ;
62 . I SCOEX D
63 .. N SCCVX
64 .. S SCTOT(1.02)=$G(SCTOT(1.02))+1
65 .. S SCCVX("HIST")=1,SCCVX("NEW")=1
66 .. D ENC^SCCVEAP1(SCOEX,.SCCVX)
67 . ;
68 . I 'SCOEX!'$G(SCVSIT("VST")) D ;Encounter or visit not created
69 .. D CREATERR^SCCVLOG1(SCVSIT("DFN"),SCDTM,+SCOEX,4,SCVSIT("LOC"),SCCRST,$G(SCLOG))
70 .. S:SCOEX ^XTMP("SCCV-ERR-"_+SCLOG,"NO-VIS",SCOEX)=""
71 .. S SCTOT(2.06)=$G(SCTOT(2.06))+1
72 ;
73 ;Add visit only if encounter, but no visit exists
74 G:$P($G(^SCE(SCOEC,0)),U,5) CREDITQ
75 ;
76 M SCVSIT=SCCV
77 S SCVSIT("OE")=SCOEC
78 S SCVSIT("OE",0)=$G(^SCE(SCOEC,0))
79 S SCVSIT("CSC")=SCCRST,SCVSIT("PAR")=SCOE,SCVSIT("ORG")=4
80 S SCVSIT("VST")=$$VISIT^SCCVEAP2(SCDTM,.SCVSIT) ; create visit
81 ;
82 I 'SCVSIT("VST") D ;No visit
83 . D CREATERR^SCCVLOG1(+$P($G(SCVSIT("OE",0)),U,2),SCDTM,+SCOEC,4,$P($G(SCCV("PT",0)),U),SCCRST,$G(SCLOG))
84 . S ^XTMP("SCCV-ERR-"_+SCLOG,"NO-VIS",SCOEC)=""
85 . S SCTOT(2.06)=$G(SCTOT(2.06))+1
86 ;
87 I SCVSIT("VST") S SCCVX("VST")=SCCV("VST") D ENC^SCCVEAP1(SCOEC,.SCCVX)
88 ;
89CREDITQ Q
90 ;
Note: See TracBrowser for help on using the repository browser.